Module renderer

DESCRIPTION

@@ -27,6 +27,7 @@ Suggests:
     plotly
 Imports:
     dplyr,
+    esquisse,
     htmlwidgets,
     purrr,
     stringr,
@@ -44,3 +45,4 @@ Imports:
     tidyr,
     shinybusy
 VignetteBuilder: knitr
+Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+export(app_server)
 export(app_ui)
 export(chartsNav)
+export(chartsRenderModule)
+export(chartsRenderModuleUI)
 export(chartsRenderStatic)
 export(chartsRenderStaticUI)
 export(chartsRenderWidget)
@@ -13,9 +16,9 @@ export(evaluateStandard)
 export(filterTab)
 export(filterTabUI)
 export(generateMappingList)
-export(getChartFunctions)
 export(homeTab)
 export(homeTabUI)
+export(makeChartConfig)
 export(mappingColumn)
 export(mappingColumnUI)
 export(mappingDomain)
@@ -31,12 +34,15 @@ export(settingsData)
 export(settingsDataUI)
 export(settingsMapping)
 export(settingsMappingUI)
+import(clisymbols)
 import(dplyr)
+import(esquisse)
+import(magrittr)
 import(shiny)
+import(tools)
+import(yaml)
 importFrom(DT,DTOutput)
 importFrom(DT,renderDT)
-importFrom(esquisse,filterDF)
-importFrom(esquisse,filterDF_UI)
 importFrom(haven,read_sas)
 importFrom(magrittr,"%>%")
 importFrom(purrr,keep)

R/app_server.R

@@ -0,0 +1,65 @@
+#' Server for the default safetyGraphics shiny app
+#'
+#' This function returns a server function suitable for use in shiny::runApp()
+#' 
+#' @param input app input 
+#' @param output app output
+#' @param session app session
+#' @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}. 
+#' @param domainData named list of data.frames to be loaded in to the app.
+#' @param chartsList list of charts to include in the app
+#' 
+#' @export
+app_server <- function(input, output, session, meta, mapping, domainData, charts){
+    server <- function(input, output, session) {
+        #Initialize modules
+
+
+        #TODO: add mapping to function call. 
+        current_mapping<-callModule(mappingTab, "mapping", meta, domainData)
+
+        id_col <- reactive({
+            dm<-current_mapping()%>%filter(domain=="dm")   
+            id<-dm %>%filter(text_key=="id_col")%>%pull(current)
+            return(id)
+        })
+
+        filtered_data<-callModule(
+            filterTab, 
+            "filter", 
+            domainData=domainData, 
+            filterDomain="dm", 
+            id_col=id_col
+        )
+
+        callModule(settingsData, "dataSettings", domains = domainData, filtered=filtered_data)
+        callModule(settingsMapping, "metaSettings", metaIn=meta, mapping=current_mapping)
+        callModule(settingsCharts, "chartSettings",charts = charts)
+        callModule(homeTab, "home")
+
+        #Initialize Chart UI - Adds subtabs to chart menu - this initializes initializes chart UIs
+        charts %>% map(chartsNav)
+
+        #Initialize Chart Servers
+        validDomains <- tolower(names(mapping))
+        charts %>% map(
+            ~callModule(
+                module=chartsTab,
+                id=.x$name,
+                chart=.x,
+                data=filtered_data,
+                mapping=current_mapping    
+            )
+        )
+
+        #participant count in header
+        shinyjs::html("header-count", paste(dim(domainData[["dm"]])[1]))
+        shinyjs::html("header-total", paste(dim(domainData[["dm"]])[1]))
+        observe({
+            req(filtered_data)
+            shinyjs::html("header-count", paste0(dim(filtered_data()[["dm"]])[1]))
+        })
+    }
+    return(server)
+}
+

R/app_startup.R

@@ -0,0 +1,50 @@
+#' Startup code for shiny app
+#' 
+#' Prepare inputs for safetyGraphics app - run before app is initialized. See ?safetyGraphicsApp for parameter definitions
+#'
+#' @return List of elements for used to initialize the shiny app with the following parameters
+#'  \itemize{
+#'  \item{"meta"}{ List of configuration metadata }
+#'  \item{"charts"}{ List of charts }
+#'  \item{"domainData"}{ List of domain level data sets }
+#'  \item{"mapping"}{ Initial Data Mapping  }
+#'  \item{"standards"}{ List of domain level data standards }
+#' }
+#' 
+app_startup<-function(domainData=NULL, meta=NULL, charts=NULL, mapping=NULL, chartSettingsPaths=NULL){
+    # Process charts metadata
+    if(is.null(charts)){
+        if(is.null(chartSettingsPaths)){
+            charts <- makeChartConfig()
+        }else{
+            charts <- makeChartConfig(chartSettingsPaths)
+        }
+    }
+
+    # get the data standards
+    standards <- names(domainData) %>% lapply(function(domain){
+        return(detectStandard(domain=domain, data = domainData[[domain]], meta=meta))
+    })
+    names(standards)<-names(domainData)
+
+    # attempt to generate a mapping if none is provided by the user
+    if(is.null(mapping)){
+        mapping_list <- standards %>% lapply(function(standard){
+            return(standard[["mapping"]])
+        })
+        mapping<-bind_rows(mapping_list, .id = "domain")
+    }
+
+    config<-list(
+        meta=meta,
+        charts=charts,
+        domainData=domainData,
+        mapping=mapping,
+        standards=standards
+    ) 
+
+    # Check config
+    # TODO write some checks to make sure the config is valid. 
+
+    return(config)
+}

R/app_ui.R

@@ -8,39 +8,45 @@
 #' @export
 
 app_ui <- function(meta, domainData, mapping, standards){
-    ui<-tagList(
-      useShinyjs(),
-      #add_busy_spinner(spin = "fading-circle", position = "bottom-left", timeout=3000),
-       tags$head(
-        tags$style(HTML(readLines( paste(.libPaths(),'safetygraphics','safetyGraphics_app', 'www','index.css', sep="/")))),
-        tags$link(
-          rel = "stylesheet",
-          type = "text/css",
-          href = "https://use.fontawesome.com/releases/v5.8.1/css/all.css"
-        )
-      ),
-      navbarPage(
-        "safetyGraphics",
-        id="nav_id",
-        tabPanel("Home", icon=icon("home"),homeTabUI("home")),
-        navbarMenu('Data',icon=icon("database"),
-          tabPanel("Preview", icon=icon("table"), settingsDataUI("dataSettings", domains=domainData)),
-          tabPanel("Mapping", icon=icon("map"), mappingTabUI("mapping", meta, domainData, mapping, standards)),
-          tabPanel("Filtering", icon=icon("filter"), filterTabUI("filter","dm"))
-        ),
-        navbarMenu('Charts', icon=icon("chart-bar")),
-        tabPanel("Reports", icon=icon("file-alt")),
-        navbarMenu('',icon=icon("cog"),
-          tabPanel(title = "Metadata", settingsMappingUI("metaSettings")),
-          tabPanel(title = "Charts", settingsChartsUI("chartSettings"))
-        ),
-        tags$script(
-          HTML(
+    #read css from pacakge
+    app_css <-  HTML(readLines( paste(.libPaths(),'safetyGraphics','safetyGraphics_app', 'www','index.css', sep="/")))
+
+    #script to append population badge nav bar
+    participant_badge<-tags$script(
+        HTML(
             "var header = $('.navbar> .container-fluid');
             header.append('<div id=\"population-header\" class=\"badge\" title=\"Selected Participants\" ><span id=\"header-count\"></span>/<span id=\"header-total\"></span></div>');"
-          )
-        )        
-      )
+        )
+    )
+
+    #app UI using calls to modules
+    ui<-tagList(
+        useShinyjs(),
+        tags$head(
+            tags$style(app_css),
+            tags$link(
+                rel = "stylesheet",
+                type = "text/css",
+                href = "https://use.fontawesome.com/releases/v5.8.1/css/all.css"
+            )
+        ),
+        navbarPage(
+            "safetyGraphics",
+            id="safetyGraphicsApp",
+            tabPanel("Home", icon=icon("home"),homeTabUI("home")),
+            navbarMenu('Data',icon=icon("database"),
+                tabPanel("Preview", icon=icon("table"), settingsDataUI("dataSettings")),
+                tabPanel("Mapping", icon=icon("map"), mappingTabUI("mapping", meta, domainData, mapping, standards)),
+                tabPanel("Filtering", icon=icon("filter"), filterTabUI("filter","dm"))
+            ),
+            navbarMenu('Charts', icon=icon("chart-bar")),
+            tabPanel("Reports", icon=icon("file-alt")),
+            navbarMenu('',icon=icon("cog"),
+                tabPanel(title = "Metadata", settingsMappingUI("metaSettings")),
+                tabPanel(title = "Charts", settingsChartsUI("chartSettings"))
+            ),
+            participant_badge
+        )
     )
     return(ui)
 }

R/makeChartConfig.R

@@ -0,0 +1,97 @@
+#' Make Chart Config
+#' 
+#' Converts YAML chart configuration files to an R list and binds workflow functions. See the vignette about creating custom charts for more details.
+#' 
+#' @param dirs path to one or more directories containing yaml files (relative to working directory)
+#' @param sourceFiles boolean indicating whether to source all R files found in dirs.
+#'
+#' @import magrittr
+#' @import tools
+#' @import yaml
+#' @import clisymbols
+#' 
+#' @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:
+#' \itemize{
+#'  \item{"name"}{ Name of the chart. Also the name of the element in the list - e.g. charts$aeExplorer$name is "aeExplorer"}
+#'  \item{"label"}{ short description of the chart }
+#'  \item{"type"}{ type of chart; options are: 'htmlwidget', 'module', 'plot', 'table', 'html' or 'plotly'.}
+#'  \item{"domain"}{ data domain. Should correspond to a domain in `meta` or be set to "multiple" }
+#'  \item{"package"}{ primary package (if any). Other packages can be loaded directly in workflow functions. }
+#'  \item{"path"}{ Path to YAML file}
+#'  \item{"workflow"}{ List of functions names used to render chart. See vignette for details. }
+#'  \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. }
+#' }
+#' @export
+
+makeChartConfig <- function(dirs, sourceFiles=TRUE){
+    # Use the charts settings saved in safetycharts if no path is provided. 
+    if(missing(dirs) || is.null(dirs)){
+        #dirs<-paste(.libPaths(),'safetycharts','chartSettings', sep="/")
+        dirs<-paste(.libPaths(),'safetycharts','config', sep="/")
+    }
+
+    if(sourceFiles){
+        r_files<-list.files(
+            dirs, 
+            pattern = "\\.R$", 
+            ignore.case=TRUE, 
+            full.names=TRUE, 
+            recursive=TRUE
+        )  
+        sapply(r_files, source)
+    }
+
+    yaml_files<-list.files(
+        dirs,
+        pattern = "yaml", 
+        recursive = TRUE,
+        full.names = TRUE
+    )
+
+    charts<-lapply(yaml_files, function(path){
+        chart <- read_yaml(path)
+        chart$path <- path
+        chart$name <- path %>% file_path_sans_ext %>% basename
+        return(chart)
+    })
+
+    names(charts) <- yaml_files %>% file_path_sans_ext %>% basename
+
+    message("Found ", length(yaml_files), " config files: ",paste(names(charts),collapse=", "))
+
+    # Bind workflow functions to chart object
+    all_functions <- as.character(lsf.str(".GlobalEnv"))
+    message("Global Functions: ",all_functions)
+    charts <- lapply(charts, 
+        function(chart){
+            if(hasName(chart, "package")){
+                package_functions <- as.character(lsf.str(paste0("package:",chart$package)))
+                all_functions<-c(all_functions,package_functions)
+            }
+
+            #search functions that include the charts name or the workflow function names
+            chart_function_names <- c()
+            for(query in c(chart$name, unlist(chart$workflow)) ){
+                matches<-all_functions[str_detect(query, all_functions)]
+                chart_function_names <- c(chart_function_names, matches)
+            }
+
+            chart$functions <- lapply(chart_function_names, match.fun)
+            names(chart$functions) <- chart_function_names
+
+            # check that functions exist for specified workflows
+            workflow_found <- sum(unlist(chart$workflow) %in% chart_function_names)
+            workflow_total <- length(unlist(chart$workflow)[names(unlist(chart$workflow))!="widget"])
+            message<-paste0(chart$name,": Found ", workflow_found, " of ",workflow_total, " workflow functions, and ", length(chart$functions)-workflow_found ," other functions.")
+            if(workflow_found == workflow_total){ 
+                message(symbol$tick," ",message)
+            }else{
+                message(symbol$cross," ", message)
+            }
+
+            return(chart)
+        }
+    )
+
+    return(charts) 
+}