Skip to content

Commit 81741eb

Browse files
jwildfirejwildfire
authored
Merge pull request #440 from SafetyGraphics/module-renderer
Module renderer
2 parents 97e6bc4 + 1b12c36 commit 81741eb

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

43 files changed

+669
-489
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ Suggests:
2727
plotly
2828
Imports:
2929
dplyr,
30+
esquisse,
3031
htmlwidgets,
3132
purrr,
3233
stringr,
@@ -44,3 +45,4 @@ Imports:
4445
tidyr,
4546
shinybusy
4647
VignetteBuilder: knitr
48+
Roxygen: list(markdown = TRUE)

‎NAMESPACE‎

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,10 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
export(app_server)
34
export(app_ui)
45
export(chartsNav)
6+
export(chartsRenderModule)
7+
export(chartsRenderModuleUI)
58
export(chartsRenderStatic)
69
export(chartsRenderStaticUI)
710
export(chartsRenderWidget)
@@ -13,9 +16,9 @@ export(evaluateStandard)
1316
export(filterTab)
1417
export(filterTabUI)
1518
export(generateMappingList)
16-
export(getChartFunctions)
1719
export(homeTab)
1820
export(homeTabUI)
21+
export(makeChartConfig)
1922
export(mappingColumn)
2023
export(mappingColumnUI)
2124
export(mappingDomain)
@@ -31,12 +34,15 @@ export(settingsData)
3134
export(settingsDataUI)
3235
export(settingsMapping)
3336
export(settingsMappingUI)
37+
import(clisymbols)
3438
import(dplyr)
39+
import(esquisse)
40+
import(magrittr)
3541
import(shiny)
42+
import(tools)
43+
import(yaml)
3644
importFrom(DT,DTOutput)
3745
importFrom(DT,renderDT)
38-
importFrom(esquisse,filterDF)
39-
importFrom(esquisse,filterDF_UI)
4046
importFrom(haven,read_sas)
4147
importFrom(magrittr,"%>%")
4248
importFrom(purrr,keep)

‎R/app_server.R‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
#' Server for the default safetyGraphics shiny app
2+
#'
3+
#' This function returns a server function suitable for use in shiny::runApp()
4+
#'
5+
#' @param input app input
6+
#' @param output app output
7+
#' @param session app session
8+
#' @param meta data frame containing the metadata for use in the app. See the preloaded file (\code{?safetyGraphics::meta}) for more data specifications and details. Defaults to \code{safetyGraphics::meta}.
9+
#' @param domainData named list of data.frames to be loaded in to the app.
10+
#' @param chartsList list of charts to include in the app
11+
#'
12+
#' @export
13+
app_server <- function(input, output, session, meta, mapping, domainData, charts){
14+
server <- function(input, output, session) {
15+
#Initialize modules
16+
17+
18+
#TODO: add mapping to function call.
19+
current_mapping<-callModule(mappingTab, "mapping", meta, domainData)
20+
21+
id_col <- reactive({
22+
dm<-current_mapping()%>%filter(domain=="dm")
23+
id<-dm %>%filter(text_key=="id_col")%>%pull(current)
24+
return(id)
25+
})
26+
27+
filtered_data<-callModule(
28+
filterTab,
29+
"filter",
30+
domainData=domainData,
31+
filterDomain="dm",
32+
id_col=id_col
33+
)
34+
35+
callModule(settingsData, "dataSettings", domains = domainData, filtered=filtered_data)
36+
callModule(settingsMapping, "metaSettings", metaIn=meta, mapping=current_mapping)
37+
callModule(settingsCharts, "chartSettings",charts = charts)
38+
callModule(homeTab, "home")
39+
40+
#Initialize Chart UI - Adds subtabs to chart menu - this initializes initializes chart UIs
41+
charts %>% map(chartsNav)
42+
43+
#Initialize Chart Servers
44+
validDomains <- tolower(names(mapping))
45+
charts %>% map(
46+
~callModule(
47+
module=chartsTab,
48+
id=.x$name,
49+
chart=.x,
50+
data=filtered_data,
51+
mapping=current_mapping
52+
)
53+
)
54+
55+
#participant count in header
56+
shinyjs::html("header-count", paste(dim(domainData[["dm"]])[1]))
57+
shinyjs::html("header-total", paste(dim(domainData[["dm"]])[1]))
58+
observe({
59+
req(filtered_data)
60+
shinyjs::html("header-count", paste0(dim(filtered_data()[["dm"]])[1]))
61+
})
62+
}
63+
return(server)
64+
}
65+

‎R/app_startup.R‎

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
#' Startup code for shiny app
2+
#'
3+
#' Prepare inputs for safetyGraphics app - run before app is initialized. See ?safetyGraphicsApp for parameter definitions
4+
#'
5+
#' @return List of elements for used to initialize the shiny app with the following parameters
6+
#' \itemize{
7+
#' \item{"meta"}{ List of configuration metadata }
8+
#' \item{"charts"}{ List of charts }
9+
#' \item{"domainData"}{ List of domain level data sets }
10+
#' \item{"mapping"}{ Initial Data Mapping }
11+
#' \item{"standards"}{ List of domain level data standards }
12+
#' }
13+
#'
14+
app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, chartSettingsPaths=NULL){
15+
# Process charts metadata
16+
if(is.null(charts)){
17+
if(is.null(chartSettingsPaths)){
18+
charts <- makeChartConfig()
19+
}else{
20+
charts <- makeChartConfig(chartSettingsPaths)
21+
}
22+
}
23+
24+
# get the data standards
25+
standards <- names(domainData) %>% lapply(function(domain){
26+
return(detectStandard(domain=domain, data = domainData[[domain]], meta=meta))
27+
})
28+
names(standards)<-names(domainData)
29+
30+
# attempt to generate a mapping if none is provided by the user
31+
if(is.null(mapping)){
32+
mapping_list <- standards %>% lapply(function(standard){
33+
return(standard[["mapping"]])
34+
})
35+
mapping<-bind_rows(mapping_list, .id = "domain")
36+
}
37+
38+
config<-list(
39+
meta=meta,
40+
charts=charts,
41+
domainData=domainData,
42+
mapping=mapping,
43+
standards=standards
44+
)
45+
46+
# Check config
47+
# TODO write some checks to make sure the config is valid.
48+
49+
return(config)
50+
}

‎R/app_ui.R‎

Lines changed: 37 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -8,39 +8,45 @@
88
#' @export
99

1010
app_ui <- function(meta, domainData, mapping, standards){
11-
ui<-tagList(
12-
useShinyjs(),
13-
#add_busy_spinner(spin = "fading-circle", position = "bottom-left", timeout=3000),
14-
tags$head(
15-
tags$style(HTML(readLines( paste(.libPaths(),'safetygraphics','safetyGraphics_app', 'www','index.css', sep="/")))),
16-
tags$link(
17-
rel = "stylesheet",
18-
type = "text/css",
19-
href = "https://use.fontawesome.com/releases/v5.8.1/css/all.css"
20-
)
21-
),
22-
navbarPage(
23-
"safetyGraphics",
24-
id="nav_id",
25-
tabPanel("Home", icon=icon("home"),homeTabUI("home")),
26-
navbarMenu('Data',icon=icon("database"),
27-
tabPanel("Preview", icon=icon("table"), settingsDataUI("dataSettings", domains=domainData)),
28-
tabPanel("Mapping", icon=icon("map"), mappingTabUI("mapping", meta, domainData, mapping, standards)),
29-
tabPanel("Filtering", icon=icon("filter"), filterTabUI("filter","dm"))
30-
),
31-
navbarMenu('Charts', icon=icon("chart-bar")),
32-
tabPanel("Reports", icon=icon("file-alt")),
33-
navbarMenu('',icon=icon("cog"),
34-
tabPanel(title = "Metadata", settingsMappingUI("metaSettings")),
35-
tabPanel(title = "Charts", settingsChartsUI("chartSettings"))
36-
),
37-
tags$script(
38-
HTML(
11+
#read css from pacakge
12+
app_css <- HTML(readLines( paste(.libPaths(),'safetyGraphics','safetyGraphics_app', 'www','index.css', sep="/")))
13+
14+
#script to append population badge nav bar
15+
participant_badge<-tags$script(
16+
HTML(
3917
"var header = $('.navbar> .container-fluid');
4018
header.append('<div id=\"population-header\" class=\"badge\" title=\"Selected Participants\" ><span id=\"header-count\"></span>/<span id=\"header-total\"></span></div>');"
41-
)
42-
)
43-
)
19+
)
20+
)
21+
22+
#app UI using calls to modules
23+
ui<-tagList(
24+
useShinyjs(),
25+
tags$head(
26+
tags$style(app_css),
27+
tags$link(
28+
rel = "stylesheet",
29+
type = "text/css",
30+
href = "https://use.fontawesome.com/releases/v5.8.1/css/all.css"
31+
)
32+
),
33+
navbarPage(
34+
"safetyGraphics",
35+
id="safetyGraphicsApp",
36+
tabPanel("Home", icon=icon("home"),homeTabUI("home")),
37+
navbarMenu('Data',icon=icon("database"),
38+
tabPanel("Preview", icon=icon("table"), settingsDataUI("dataSettings")),
39+
tabPanel("Mapping", icon=icon("map"), mappingTabUI("mapping", meta, domainData, mapping, standards)),
40+
tabPanel("Filtering", icon=icon("filter"), filterTabUI("filter","dm"))
41+
),
42+
navbarMenu('Charts', icon=icon("chart-bar")),
43+
tabPanel("Reports", icon=icon("file-alt")),
44+
navbarMenu('',icon=icon("cog"),
45+
tabPanel(title = "Metadata", settingsMappingUI("metaSettings")),
46+
tabPanel(title = "Charts", settingsChartsUI("chartSettings"))
47+
),
48+
participant_badge
49+
)
4450
)
4551
return(ui)
4652
}

‎R/getChartFunctions.R‎

Lines changed: 0 additions & 44 deletions
This file was deleted.

‎R/makeChartConfig.R‎

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
#' Make Chart Config
2+
#'
3+
#' Converts YAML chart configuration files to an R list and binds workflow functions. See the vignette about creating custom charts for more details.
4+
#'
5+
#' @param dirs path to one or more directories containing yaml files (relative to working directory)
6+
#' @param sourceFiles boolean indicating whether to source all R files found in dirs.
7+
#'
8+
#' @import magrittr
9+
#' @import tools
10+
#' @import yaml
11+
#' @import clisymbols
12+
#'
13+
#' @return returns a named list of charts derived from YAML files. Each element of the list contains information about a single chart, and has the following parameters:
14+
#' \itemize{
15+
#' \item{"name"}{ Name of the chart. Also the name of the element in the list - e.g. charts$aeExplorer$name is "aeExplorer"}
16+
#' \item{"label"}{ short description of the chart }
17+
#' \item{"type"}{ type of chart; options are: 'htmlwidget', 'module', 'plot', 'table', 'html' or 'plotly'.}
18+
#' \item{"domain"}{ data domain. Should correspond to a domain in `meta` or be set to "multiple" }
19+
#' \item{"package"}{ primary package (if any). Other packages can be loaded directly in workflow functions. }
20+
#' \item{"path"}{ Path to YAML file}
21+
#' \item{"workflow"}{ List of functions names used to render chart. See vignette for details. }
22+
#' \item{"functions"}{ List of functions for use in chart renderering. These functions must be located in the global environment or `package` field of the YAML config. Function names must include either the `name` or `workflow` fields of the YAML config. }
23+
#' }
24+
#' @export
25+
26+
makeChartConfig <- function(dirs, sourceFiles=TRUE){
27+
# Use the charts settings saved in safetycharts if no path is provided.
28+
if(missing(dirs) || is.null(dirs)){
29+
#dirs<-paste(.libPaths(),'safetycharts','chartSettings', sep="/")
30+
dirs<-paste(.libPaths(),'safetycharts','config', sep="/")
31+
}
32+
33+
if(sourceFiles){
34+
r_files<-list.files(
35+
dirs,
36+
pattern = "\\.R$",
37+
ignore.case=TRUE,
38+
full.names=TRUE,
39+
recursive=TRUE
40+
)
41+
sapply(r_files, source)
42+
}
43+
44+
yaml_files<-list.files(
45+
dirs,
46+
pattern = "yaml",
47+
recursive = TRUE,
48+
full.names = TRUE
49+
)
50+
51+
charts<-lapply(yaml_files, function(path){
52+
chart <- read_yaml(path)
53+
chart$path <- path
54+
chart$name <- path %>% file_path_sans_ext %>% basename
55+
return(chart)
56+
})
57+
58+
names(charts) <- yaml_files %>% file_path_sans_ext %>% basename
59+
60+
message("Found ", length(yaml_files), " config files: ",paste(names(charts),collapse=", "))
61+
62+
# Bind workflow functions to chart object
63+
all_functions <- as.character(lsf.str(".GlobalEnv"))
64+
message("Global Functions: ",all_functions)
65+
charts <- lapply(charts,
66+
function(chart){
67+
if(hasName(chart, "package")){
68+
package_functions <- as.character(lsf.str(paste0("package:",chart$package)))
69+
all_functions<-c(all_functions,package_functions)
70+
}
71+
72+
#search functions that include the charts name or the workflow function names
73+
chart_function_names <- c()
74+
for(query in c(chart$name, unlist(chart$workflow)) ){
75+
matches<-all_functions[str_detect(query, all_functions)]
76+
chart_function_names <- c(chart_function_names, matches)
77+
}
78+
79+
chart$functions <- lapply(chart_function_names, match.fun)
80+
names(chart$functions) <- chart_function_names
81+
82+
# check that functions exist for specified workflows
83+
workflow_found <- sum(unlist(chart$workflow) %in% chart_function_names)
84+
workflow_total <- length(unlist(chart$workflow)[names(unlist(chart$workflow))!="widget"])
85+
message<-paste0(chart$name,": Found ", workflow_found, " of ",workflow_total, " workflow functions, and ", length(chart$functions)-workflow_found ," other functions.")
86+
if(workflow_found == workflow_total){
87+
message(symbol$tick," ",message)
88+
}else{
89+
message(symbol$cross," ", message)
90+
}
91+
92+
return(chart)
93+
}
94+
)
95+
96+
return(charts)
97+
}

0 commit comments

Comments
 (0)