From e49a48a273175c75c3d6b368255069ee15b68d65 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 29 Oct 2020 10:14:36 -0400 Subject: [PATCH 01/15] add first basic yaml settings. #432 --- inst/charts/charts.yaml | 35 +++++++++++++++++++++++++++++++++++ inst/mappings/aes.yaml | 1 + 2 files changed, 36 insertions(+) create mode 100644 inst/charts/charts.yaml create mode 100644 inst/mappings/aes.yaml diff --git a/inst/charts/charts.yaml b/inst/charts/charts.yaml new file mode 100644 index 00000000..588daed1 --- /dev/null +++ b/inst/charts/charts.yaml @@ -0,0 +1,35 @@ +- chart: eDISH + domain: labs + package: safetyexploreR + label: Hepatic Safety Explorer + type: htmlwidget +- chart: safetyHistogram + domain: labs + package: safetyexploreR + label: Histogram + type: htmlwidget +- chart: safetyOutlierExplorer + domain: labs + package: safetyexploreR + label: Outlier Explorer + type: htmlwidget +- chart: safetyShiftPlot + domain: labs + package: safetyexploreR + label: Shift Plot + type: htmlwidget +- chart: safetyResultsOverTime + domain: labs + package: safetyexploreR + label: Results Over Time + type: htmlwidget +- chart: aeExplorer + domain: multiple + package: safetyexploreR + label: Safety Explorer + type: htmlwidget +- chart: aeTimelines + domain: aes + package: safetyexploreR + label: Safety Timelines + type: htmlwidget diff --git a/inst/mappings/aes.yaml b/inst/mappings/aes.yaml new file mode 100644 index 00000000..9a5ac690 --- /dev/null +++ b/inst/mappings/aes.yaml @@ -0,0 +1 @@ +- text_key: id_col\n col_key: id_col\n field_key: .na.character\n type: column\n label: ID column\n description: Unique subject identifier variable name.\n multiple: no\n standard_adam: USUBJID\n standard_sdtm: USUBJID\n- text_key: seq_col\n col_key: seq_col\n field_key: .na.character\n type: column\n label: Sequence column\n description: Event sequence number variable name\n multiple: no\n standard_adam: ASEQ\n standard_sdtm: AESEQ\n- text_key: stdy_col\n col_key: stdy_col\n field_key: .na.character\n type: column\n label: AE Start day column\n description: Event start day variable name\n multiple: no\n standard_adam: ASTDY\n standard_sdtm: AESTDY\n- text_key: endy_col\n col_key: endy_col\n field_key: .na.character\n type: column\n label: AE End day column\n description: Event end day variable name\n multiple: no\n standard_adam: AENDY\n standard_sdtm: AEENDY\n- text_key: term_col\n col_key: term_col\n field_key: .na.character\n type: column\n label: Preferred Term Column\n description: verbatim adverse event text variable name\n multiple: no\n standard_adam: AETERM\n standard_sdtm: AETERM\n- text_key: bodsys_col\n col_key: bodsys_col\n field_key: .na.character\n type: column\n label: AE Body System\n description: AE Body System\n multiple: no\n standard_adam: AEBODSYS\n standard_sdtm: AEBODSYS\n- text_key: detail_col\n col_key: detail_col\n field_key: .na.character\n type: column\n label: Details\n description: Details\n multiple: yes\n standard_adam: .na.character\n standard_sdtm: .na.character\n- text_key: filter_cols\n col_key: filter_cols\n field_key: .na.character\n type: column\n label: Filters\n description: Filters\n multiple: yes\n standard_adam: .na.character\n standard_sdtm: .na.character\n \ No newline at end of file From 3a9545b9db139a2503f11d444c7ffa261d120b16 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 29 Oct 2020 11:02:20 -0400 Subject: [PATCH 02/15] move app_server out of runapp --- R/app_server.R | 57 +++++++++++++++++++++++++++++++++++++++++++ R/mod_chartsTab.R | 8 +++--- R/safetyGraphicsApp.R | 55 ++--------------------------------------- 3 files changed, 63 insertions(+), 57 deletions(-) create mode 100644 R/app_server.R diff --git a/R/app_server.R b/R/app_server.R new file mode 100644 index 00000000..59b91fd9 --- /dev/null +++ b/R/app_server.R @@ -0,0 +1,57 @@ + +app_server <- function(input, output, session, meta, mapping, domainData, chartsList){ + server <- function(input, output, session) { + #Initialize modules + #TODO: + 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 = chartsList) + callModule(homeTab, "home") + + #Initialize Chart UI - Adds subtabs to chart menu and initializes chart UIs + chartsList %>% map(~chartsNav(chart=.x$chart, label=.x$label, type=.x$type, package=.x$package)) + + #Initialize Chart Servers + validDomains <- tolower(names(mapping)) + chartsList %>% map( + ~callModule( + chartsTab, + .x$chart, + chart=.x$chart, + chartFunction=.x$chartFunction, + initFunction=.x$initFunction, + type=.x$type, + package=.x$package, + domain=.x$domain, + 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) +} + diff --git a/R/mod_chartsTab.R b/R/mod_chartsTab.R index cc0d7333..59ce833c 100644 --- a/R/mod_chartsTab.R +++ b/R/mod_chartsTab.R @@ -8,14 +8,14 @@ chartsTabUI <- function(id, chart, package, label=chart, type){ chartID <- ifelse(missing(package), chart, paste0(package,"-",chart)) h2(paste("Chart:",label)) if(tolower(type=="module")){ - #render the module UI - #call the module server + #render the module UI + }else if(tolower(type=="htmlwidget")){ #render the widget chartsRenderWidgetUI(id=ns(chartID),chart=chart,package=package) }else{ - #create the static or plotly chart - chartsRenderStaticUI(id=ns(chartID), type=type) + #create the static or plotly chart + chartsRenderStaticUI(id=ns(chartID), type=type) } } diff --git a/R/safetyGraphicsApp.R b/R/safetyGraphicsApp.R index 99246706..398599d0 100644 --- a/R/safetyGraphicsApp.R +++ b/R/safetyGraphicsApp.R @@ -60,61 +60,10 @@ safetyGraphicsApp <- function( #convert charts data frame to a list and bind functions chartsList <- setNames(transpose(charts), charts$chart) chartsList <- getChartFunctions(chartsList, chartSettingPaths) - + app <- shinyApp( ui = app_ui(meta, domainData, mapping, standards), - server = function(input, output) { - #Initialize modules - 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 = chartsList) - callModule(homeTab, "home") - - #Initialize Chart UI - Adds subtabs to chart menu and initializes chart UIs - chartsList %>% map(~chartsNav(chart=.x$chart, label=.x$label, type=.x$type, package=.x$package)) - - #Initialize Chart Servers - validDomains <- tolower(names(mapping)) - chartsList %>% map( - ~callModule( - chartsTab, - .x$chart, - chart=.x$chart, - chartFunction=.x$chartFunction, - initFunction=.x$initFunction, - type=.x$type, - package=.x$package, - domain=.x$domain, - 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])) - }) - } + server = app_server(input, output, session, meta, mapping, domainData, chartsList) ) runApp(app, launch.browser = TRUE) } From a41874922af2b1ab8e4792349d5d5649127bebbe Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 6 Nov 2020 12:24:49 -0500 Subject: [PATCH 03/15] use YAML for chart config. fix #432 --- NAMESPACE | 7 ++ R/app_server.R | 38 +++--- R/app_startup.R | 52 +++++++++ R/app_ui.R | 68 ++++++----- R/makeChartConfig.R | 82 +++++++++++++ R/mod_chartsNav.R | 10 +- R/mod_chartsRenderWidget.R | 10 +- R/mod_chartsTab.R | 109 +++++++++--------- R/safetyGraphicsApp.R | 42 +------ inst/charts/charts.yaml | 35 ------ inst/config/charts/aeExplorer.yaml | 7 ++ inst/config/charts/aeTimelines.yaml | 6 + .../charts/functions}/aeExplorer_init.R | 1 - inst/config/charts/functions/mod_labdist.R | 59 ++++++++++ .../charts/functions/safety_histogram_chart.R | 59 ++++++++++ inst/config/charts/functions/tendril_chart.R | 4 + inst/config/charts/functions/tendril_init.R | 46 ++++++++ .../config/charts/functions/tplyr_aes_chart.R | 37 ++++++ .../charts/functions/tplyr_demog_chart.R | 16 +++ .../charts/functions/tplyr_shift_chart.R | 20 ++++ inst/config/charts/hepexplorer.yaml | 6 + inst/config/charts/safetyHistogram.yaml | 6 + inst/config/charts/safetyOutlierExplorer.yaml | 6 + inst/config/charts/safetyResultsOverTime.yaml | 6 + inst/config/charts/safetyShiftPlot.yaml | 6 + inst/config/charts/tendril.yaml | 7 ++ inst/config/charts/tplyr_demog.yaml | 6 + inst/config/charts/tplyr_shift.yaml | 6 + inst/{ => config}/mappings/aes.yaml | 0 man/app_server.Rd | 24 ++++ man/app_startup.Rd | 21 ++++ man/chartsNav.Rd | 2 +- man/chartsRenderStatic.Rd | 2 +- man/chartsRenderStaticUI.Rd | 2 +- man/chartsTab.Rd | 28 +---- man/chartsTabUI.Rd | 2 +- man/generateMappingList.Rd | 4 +- man/makeChartConfig.Rd | 29 +++++ man/safetyGraphicsApp.Rd | 11 +- .../module_examples/chartsRenderStatic/app.R | 1 + .../module_examples/chartsRenderWidget/app.R | 26 ++--- .../testthat/module_examples/chartsTab/app.R | 106 +++++++++-------- 42 files changed, 737 insertions(+), 278 deletions(-) create mode 100644 R/app_startup.R create mode 100644 R/makeChartConfig.R delete mode 100644 inst/charts/charts.yaml create mode 100644 inst/config/charts/aeExplorer.yaml create mode 100644 inst/config/charts/aeTimelines.yaml rename inst/{chartSettings => config/charts/functions}/aeExplorer_init.R (98%) create mode 100644 inst/config/charts/functions/mod_labdist.R create mode 100644 inst/config/charts/functions/safety_histogram_chart.R create mode 100644 inst/config/charts/functions/tendril_chart.R create mode 100644 inst/config/charts/functions/tendril_init.R create mode 100644 inst/config/charts/functions/tplyr_aes_chart.R create mode 100644 inst/config/charts/functions/tplyr_demog_chart.R create mode 100644 inst/config/charts/functions/tplyr_shift_chart.R create mode 100644 inst/config/charts/hepexplorer.yaml create mode 100644 inst/config/charts/safetyHistogram.yaml create mode 100644 inst/config/charts/safetyOutlierExplorer.yaml create mode 100644 inst/config/charts/safetyResultsOverTime.yaml create mode 100644 inst/config/charts/safetyShiftPlot.yaml create mode 100644 inst/config/charts/tendril.yaml create mode 100644 inst/config/charts/tplyr_demog.yaml create mode 100644 inst/config/charts/tplyr_shift.yaml rename inst/{ => config}/mappings/aes.yaml (100%) create mode 100644 man/app_server.Rd create mode 100644 man/app_startup.Rd create mode 100644 man/makeChartConfig.Rd diff --git a/NAMESPACE b/NAMESPACE index ef59e71f..a21af598 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(app_server) export(app_ui) export(chartsNav) export(chartsRenderStatic) @@ -16,6 +17,7 @@ export(generateMappingList) export(getChartFunctions) export(homeTab) export(homeTabUI) +export(makeChartConfig) export(mappingColumn) export(mappingColumnUI) export(mappingDomain) @@ -31,8 +33,13 @@ export(settingsData) export(settingsDataUI) export(settingsMapping) export(settingsMappingUI) +import(DT) +import(clisymbols) import(dplyr) +import(magrittr) import(shiny) +import(tools) +import(yaml) importFrom(DT,DTOutput) importFrom(DT,renderDT) importFrom(esquisse,filterDF) diff --git a/R/app_server.R b/R/app_server.R index 59b91fd9..5bf833b5 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -1,8 +1,21 @@ - -app_server <- function(input, output, session, meta, mapping, domainData, chartsList){ +#' 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: + + + #TODO: add mapping to function call. current_mapping<-callModule(mappingTab, "mapping", meta, domainData) id_col <- reactive({ @@ -21,24 +34,19 @@ app_server <- function(input, output, session, meta, mapping, domainData, charts callModule(settingsData, "dataSettings", domains = domainData, filtered=filtered_data) callModule(settingsMapping, "metaSettings", metaIn=meta, mapping=current_mapping) - callModule(settingsCharts, "chartSettings",charts = chartsList) + callModule(settingsCharts, "chartSettings",charts = charts) callModule(homeTab, "home") - #Initialize Chart UI - Adds subtabs to chart menu and initializes chart UIs - chartsList %>% map(~chartsNav(chart=.x$chart, label=.x$label, type=.x$type, package=.x$package)) + #Initialize Chart UI - Adds subtabs to chart menu - this initializes initializes chart UIs + charts %>% map(~chartsNav(name=.x$name, label=.x$label, type=.x$type, package=.x$package)) #Initialize Chart Servers validDomains <- tolower(names(mapping)) - chartsList %>% map( + charts %>% map( ~callModule( - chartsTab, - .x$chart, - chart=.x$chart, - chartFunction=.x$chartFunction, - initFunction=.x$initFunction, - type=.x$type, - package=.x$package, - domain=.x$domain, + module=chartsTab, + id=.x$name, + chart=.x, data=filtered_data, mapping=current_mapping ) diff --git a/R/app_startup.R b/R/app_startup.R new file mode 100644 index 00000000..4c453a72 --- /dev/null +++ b/R/app_startup.R @@ -0,0 +1,52 @@ +#' 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, meta, charts, mapping, chartSettingsPaths){ + + # Process charts metadata + if(is.null(charts)){ + if(is.null(chartSettingsPaths)){ + charts <- makeChartConfig(chartSettingsPaths) + }else{ + charts <- makeChartConfig() + } + + } + + # 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) +} \ No newline at end of file diff --git a/R/app_ui.R b/R/app_ui.R index 3d44908e..d26bc5e5 100644 --- a/R/app_ui.R +++ b/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('
/
');" - ) - ) - ) + ) + ) + + #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", 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")) + ), + participant_badge + ) ) return(ui) } diff --git a/R/makeChartConfig.R b/R/makeChartConfig.R new file mode 100644 index 00000000..2d1b6354 --- /dev/null +++ b/R/makeChartConfig.R @@ -0,0 +1,82 @@ +#' 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. } +#' } +#' @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(),'safetygraphics','config','charts', 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 <- lsf.str(pos=1) + charts <- lapply(charts, function(chart){ + function_names <- all_functions[grep(chart$name,all_functions)] + chart$functions <- lapply(function_names, match.fun) + names(chart$functions) <- function_names + + # check that functions exist for specified workflows + workflow_found <- sum(unlist(chart$workflow) %in% 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) +} diff --git a/R/mod_chartsNav.R b/R/mod_chartsNav.R index fd9fe4ee..95ca82db 100644 --- a/R/mod_chartsNav.R +++ b/R/mod_chartsNav.R @@ -5,18 +5,18 @@ #' @export #' -chartsNav <- function(chart, label, package, type){ +chartsNav <- function(name, label, type, package){ #chart$chartFunction <- NULL #chart$initFunction <- NULL appendTab( - inputId = "nav_id", + inputId = "safetyGraphicsApp", menuName = "Charts", tab = tabPanel( title = label, - value = chart, + value = name, chartsTabUI( - chart, - chart=chart, + id=name, + name=name, package=package, label=label, type=type diff --git a/R/mod_chartsRenderWidget.R b/R/mod_chartsRenderWidget.R index 1ecdab31..eaa02cd2 100644 --- a/R/mod_chartsRenderWidget.R +++ b/R/mod_chartsRenderWidget.R @@ -8,8 +8,7 @@ #' @export chartsRenderWidgetUI <- function(id, chart, package){ - - # shiny output binding for a widget named 'foo' + # shiny output binding for a widget widgetOutput <- function(outputId, width = "100%", height = "400px") { htmlwidgets::shinyWidgetOutput(outputId, chart, width, height, package=package) } @@ -40,8 +39,7 @@ chartsRenderWidget <- function( settingsToJSON=TRUE ){ ns <- session$ns - - + message("chartRenderWidget() starting for ", chart) # shiny output binding widgetOutput <- function(outputId, width = "100%", height = "400px") { htmlwidgets::shinyWidgetOutput(outputId, chart, width, height, package=package) @@ -54,6 +52,7 @@ chartsRenderWidget <- function( } widgetParams <- reactive({ + print("Getting widget params") widgetParams<-params() if(settingsToJSON){ widgetParams$settings <- jsonlite::toJSON( @@ -68,11 +67,12 @@ chartsRenderWidget <- function( # shiny render function for the widget output[["widgetChart"]] <- renderWidget({ + message("Rendering Widget") htmlwidgets::createWidget( name = chart, widgetParams(), package = package, sizingPolicy = htmlwidgets::sizingPolicy(viewer.suppress=TRUE, browser.external = TRUE), - ) + ) }) } diff --git a/R/mod_chartsTab.R b/R/mod_chartsTab.R index 59ce833c..e25e66a5 100644 --- a/R/mod_chartsTab.R +++ b/R/mod_chartsTab.R @@ -3,20 +3,19 @@ #' #' @export -chartsTabUI <- function(id, chart, package, label=chart, type){ - ns <- NS(id) - chartID <- ifelse(missing(package), chart, paste0(package,"-",chart)) - h2(paste("Chart:",label)) - if(tolower(type=="module")){ - #render the module UI +chartsTabUI <- function(id, name, package, label=id, type){ + ns <- NS(id) + h2(paste("Chart:",label)) + if(tolower(type=="module")){ + #render the module UI - }else if(tolower(type=="htmlwidget")){ - #render the widget - chartsRenderWidgetUI(id=ns(chartID),chart=chart,package=package) - }else{ - #create the static or plotly chart - chartsRenderStaticUI(id=ns(chartID), type=type) - } + }else if(tolower(type=="htmlwidget")){ + #render the widget + chartsRenderWidgetUI(id=ns("wrap"),chart=name, package=package) + }else{ + #create the static or plotly chart + chartsRenderStaticUI(id=ns("wrap"), type=type) + } } #' @title home tab - server @@ -25,58 +24,64 @@ chartsTabUI <- function(id, chart, package, label=chart, type){ #' @param input Input objects from module namespace #' @param output Output objects from module namespace #' @param session An environment that can be used to access information and functionality relating to the session -#' @param type type of chart. Must be 'htmlwidget', 'module', 'plot', 'table', 'html' or 'plotly'. See ?mod_chartRenderer* functions for more details about each chart type. -#' @param package package containing the widget. -#' @param chart chart name. Should generally match the name of the function/widget/module to be intiated. See specific renderer modules for more details. -#' @param chartFunction function to generate static chart. -#' @param initFunction function called before the chart is generated. The function should take `data` and `settings` as inputs and return `params` which should be a list which is then provided to the widget. If domain is specified, only domain-level information is passed to the init function, otherwise named lists containing information for all domains is provided. The mapping is parsed as a list using `generateMappingList()` before being passed to the init function. By default, init returns an unmodified list of data and settings - possibly subset to the specified domain (e.g. list(data=data, settings=settings)) -#' @param domain data domain. Should correspond to a domain in `meta` or be set to "multiple", in which case, named lists for `data` and `mappings` containing all domain data are used. +#' @param chart list containing a safetyGraphics chart object. see custom chart vignette for details. #' @param data named list of current data sets [reactive]. #' @param mapping tibble capturing the current data mappings [reactive]. #' #' @export -chartsTab <- function(input, output, session, chart, type, package, chartFunction, initFunction, domain, data, mapping){ - ns <- session$ns - chartID <- ifelse(missing(package), chart, paste0(package,"-",chart)) - +#chartsTab <- function(input, output, session, chart, type, package, chartFunction, initFunction, domain, data, mapping){ +chartsTab <- function(input, output, session, chart, data, mapping){ + + ns <- session$ns + message("chartsTab() starting for ",chart$name) + params <- reactive({ - #convert settings from data frame to list and subset to specified domain (if any) - settingsList <- safetyGraphics::generateMappingList(mapping(), domain=domain) - + settingsList <- safetyGraphics::generateMappingList(mapping(), domain=chart$domain) + #subset data to specific domain (if specified) - if(domain=="multiple"){ + if(chart$domain=="multiple"){ domainData <- data() }else{ - domainData<- data()[[domain]] + domainData<- data()[[chart$domain]] } + params <- list(data=domainData, settings=settingsList) #customize initial the parameters if desired - otherwise pass through domain level data and mapping) - params <- initFunction(data=domainData, settings=settingsList) - + if(hasName(chart,"functions")){ + if(hasName(chart$workflow,"init")){ + message(chart$name, " has an init.") + print(chart$functions[chart$workflow$init]) + params <- do.call(chart$functions[[chart$workflow$init]], params) + print(params) + } + } return(params) }) - - if(tolower(type=="module")){ - #render the module UI - #call the module server - }else if(tolower(type=="htmlwidget")){ - callModule( - chartsRenderWidget, - chartID, - chart=chart, - package=package, - params=params - ) - }else{ - #create the static or plotly chart - callModule( - chartsRenderStatic, - chartID, - chartFunction=chartFunction, - params=params, - type=type - ) - } + + if(tolower(chart$type=="module")){ + #render the module UI + #call the module server + }else if(tolower(chart$type=="htmlwidget")){ + message("chartsTab() is initializing a widget at ", ns("wrap")) + message("chart is ", chart$name, "; package is ", chart$package) + callModule( + module=chartsRenderWidget, + id="wrap", + chart=chart$name, + package=chart$package, + params=params + ) + }else{ + #create the static or plotly chart + chartFunction <- chart$functions[[chart$workflow$main]] + callModule( + module=chartsRenderStatic, + id="wrap", + chartFunction=chartFunction, + params=params, + type=chart$type + ) + } } \ No newline at end of file diff --git a/R/safetyGraphicsApp.R b/R/safetyGraphicsApp.R index 398599d0..b9481ace 100644 --- a/R/safetyGraphicsApp.R +++ b/R/safetyGraphicsApp.R @@ -1,11 +1,10 @@ #' Run the interactive safety graphics app #' -#' @param maxFileSize maximum file size in MB allowed for file upload #' @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 charts data.frame of charts to be used in the app #' @param mapping data.frame specifying the initial values for each data mapping. If no mapping is provided, the app will attempt to generate one via \code{detectStandard()} -#' @param settingsPath path where customization functions are saved relative to your working directory. All charts can have itialization (e.g. [chart]Init.R) and static charts can have charting functions (e.g. [chart]Chart.R). All R files in this folder are sourced and files with the correct naming convention are linked to the chart. See the Custom Charts vignette for more details. +#' @param chartSettingsPaths path(s) where customization functions are saved relative to your working directory. All charts can have itialization (e.g. [chart]Init.R) and static charts can have charting functions (e.g. [chart]Chart.R). All R files in this folder are sourced and files with the correct naming convention are linked to the chart. See the Custom Charts vignette for more details. #' #' @import shiny #' @importFrom shinyjs useShinyjs html @@ -19,51 +18,22 @@ #' @export safetyGraphicsApp <- function( - maxFileSize = NULL, - meta = safetyGraphics::meta, domainData=list( labs=safetyGraphics::labs, aes=safetyGraphics::aes, dm=safetyGraphics::dm ), - charts=safetyGraphics::charts, + meta = safetyGraphics::meta, + charts=NULL, mapping=NULL, chartSettingsPaths = NULL ){ - #increase maximum file upload limit - if(!is.null(maxFileSize)){ - options(shiny.maxRequestSize=(maxFileSize*1024^2)) - } - - # load files from default location in the package (for default charts) - defaultPath <- paste(.libPaths(),'safetygraphics','chartSettings', sep="/") - if(!is.null(chartSettingsPaths)){ - chartSettingsPaths <- paste(getwd(),chartSettingsPaths,sep="/") - } - chartSettingPaths <- c(defaultPath, 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") - } - - #convert charts data frame to a list and bind functions - chartsList <- setNames(transpose(charts), charts$chart) - chartsList <- getChartFunctions(chartsList, chartSettingPaths) + config <- app_startup(domainData, meta, charts, mapping, chartSettingsPaths) app <- shinyApp( - ui = app_ui(meta, domainData, mapping, standards), - server = app_server(input, output, session, meta, mapping, domainData, chartsList) + ui = app_ui(config$meta, config$domainData, config$mapping, config$standards), + server = app_server(input, output, session, config$meta, config$mapping, config$domainData, config$charts) ) runApp(app, launch.browser = TRUE) } diff --git a/inst/charts/charts.yaml b/inst/charts/charts.yaml deleted file mode 100644 index 588daed1..00000000 --- a/inst/charts/charts.yaml +++ /dev/null @@ -1,35 +0,0 @@ -- chart: eDISH - domain: labs - package: safetyexploreR - label: Hepatic Safety Explorer - type: htmlwidget -- chart: safetyHistogram - domain: labs - package: safetyexploreR - label: Histogram - type: htmlwidget -- chart: safetyOutlierExplorer - domain: labs - package: safetyexploreR - label: Outlier Explorer - type: htmlwidget -- chart: safetyShiftPlot - domain: labs - package: safetyexploreR - label: Shift Plot - type: htmlwidget -- chart: safetyResultsOverTime - domain: labs - package: safetyexploreR - label: Results Over Time - type: htmlwidget -- chart: aeExplorer - domain: multiple - package: safetyexploreR - label: Safety Explorer - type: htmlwidget -- chart: aeTimelines - domain: aes - package: safetyexploreR - label: Safety Timelines - type: htmlwidget diff --git a/inst/config/charts/aeExplorer.yaml b/inst/config/charts/aeExplorer.yaml new file mode 100644 index 00000000..5f52cfed --- /dev/null +++ b/inst/config/charts/aeExplorer.yaml @@ -0,0 +1,7 @@ +label: Safety Explorer +type: htmlwidget +domain: multiple +package: safetyCharts +workflow: + init: aeExplorer_init + widget: aeExplorer diff --git a/inst/config/charts/aeTimelines.yaml b/inst/config/charts/aeTimelines.yaml new file mode 100644 index 00000000..bdb9086f --- /dev/null +++ b/inst/config/charts/aeTimelines.yaml @@ -0,0 +1,6 @@ +label: Safety Timelines +type: htmlwidget +domain: aes +package: safetyCharts +workflow: + widget: aeTimelines diff --git a/inst/chartSettings/aeExplorer_init.R b/inst/config/charts/functions/aeExplorer_init.R similarity index 98% rename from inst/chartSettings/aeExplorer_init.R rename to inst/config/charts/functions/aeExplorer_init.R index c14c4249..8b503fd5 100644 --- a/inst/chartSettings/aeExplorer_init.R +++ b/inst/config/charts/functions/aeExplorer_init.R @@ -32,6 +32,5 @@ aeExplorer_init<- function(data, settings){ values = c("", NA, NULL) ) ) - View(settings) return(list(data=anly,settings=settings)) } \ No newline at end of file diff --git a/inst/config/charts/functions/mod_labdist.R b/inst/config/charts/functions/mod_labdist.R new file mode 100644 index 00000000..ecc75740 --- /dev/null +++ b/inst/config/charts/functions/mod_labdist.R @@ -0,0 +1,59 @@ +##################################################################### +# Step 1 - Write custom chart module code +##################################################################### +mod_labdist_UI <- function(id) { + ns <- NS(id) + tagList( + checkboxInput(ns("show_points"), "Show points?", value=FALSE), + checkboxInput(ns("show_outliers"), "Show outliers?", value=TRUE), + selectInput(ns("scale"), "Scale Transform", choices=c("Log-10","None")), + plotOutput(ns("labdist"), width = "1000px") + ) +} + +mod_labdist_server <- function(input, output, session, data, settings) { + + ns <- session$ns + + mapped_data <- reactive({ + data() %>% + select( + Value = settings()[["value_col"]], + Measure = settings()[["measure_col"]] + )%>% + filter(!is.na(Value)) + }) + + output$labdist <- renderPlot({ + + req(mapped_data()) + + # set up the plot + p <- ggplot(data = mapped_data(), aes(x = Measure, y = Value)) + + theme_bw() + + theme( + axis.text.x = element_text(angle = 25, hjust = 1), + axis.text=element_text(size=12), + axis.title = element_text(size = 12) + ) + + # add/remove outliers + if (input$show_outliers){ + p <- p + geom_boxplot(fill = "orange") + } else { + p <- p + geom_boxplot(fill = "orange", outlier.shape = NA) + } + + # log-transform scale + if (input$scale=="Log-10"){ + p <- p + scale_y_log10() + } + + # show individual data points + if (input$show_points){ + p <- p + geom_jitter(width = 0.2) + } + + p + }) +} \ No newline at end of file diff --git a/inst/config/charts/functions/safety_histogram_chart.R b/inst/config/charts/functions/safety_histogram_chart.R new file mode 100644 index 00000000..a67b45ad --- /dev/null +++ b/inst/config/charts/functions/safety_histogram_chart.R @@ -0,0 +1,59 @@ +library(dplyr) +library(ggplot2) + +safety_histogram_chart <- function(data, settings, description="Safety Histogram"){ + id_col <- settings[["id_col"]] + value_col <- settings[["value_col"]] + measure_col <- settings[["measure_col"]] + normal_col_low <- settings[["normal_col_low"]] + normal_col_high <- settings[["normal_col_high"]] + unit_col <- settings[["unit_col"]] + + # prep data + dd <- data %>% + select(one_of(c(id_col, value_col, measure_col, normal_col_low, normal_col_high))) %>% + setNames(., c("id_col","value_col","measure_col","normal_col_low","normal_col_high")) %>% + filter(!is.na(value_col)) + + # get labels for fig + ylab <- "# of\nObservations" + plot_title <- description + + # color for histogram + col <- RColorBrewer::brewer.pal(3, "Set2")[1] + + p <- ggplot(data=dd) + + geom_rect( + aes( + xmin=normal_col_low , + xmax=normal_col_high, + ymin=-Inf, + ymax=Inf + ), + alpha=0.5, + stat="identity", + fill = "gray90", + color="gray70" + )+ + geom_histogram( + aes( + x=value_col + ), + fill=col, + alpha=0.6, + color=col + )+ + theme_bw() + + labs( + x="", + y=ylab, + title=plot_title + ) + + facet_wrap( + vars(measure_col), + scales="free_x" + ) + + + return(p) +} diff --git a/inst/config/charts/functions/tendril_chart.R b/inst/config/charts/functions/tendril_chart.R new file mode 100644 index 00000000..6a9d33ce --- /dev/null +++ b/inst/config/charts/functions/tendril_chart.R @@ -0,0 +1,4 @@ +tendril_chart <- function(data, settings){ + print("called the tendril chart") + return(plot(data, coloring = "OR", percentile = TRUE)) +} \ No newline at end of file diff --git a/inst/config/charts/functions/tendril_init.R b/inst/config/charts/functions/tendril_init.R new file mode 100644 index 00000000..f2165490 --- /dev/null +++ b/inst/config/charts/functions/tendril_init.R @@ -0,0 +1,46 @@ +library("Tendril") + +#compute tendril data +tendril_init<-function(data, settings){ + print("Init Tendril") + print(names(data)) + aes_arm <- left_join( + data$aes, + data$dm%>%select(settings$dm$id_col, settings$dm$treatment_col), + by=settings$dm$id_col) + + + #get treatments + all_treatments <- unique(aes_arm%>%pull(settings$dm$treatment_col)) + treatments <- c(settings[["aes"]][["treatment_values--group1"]],settings[["aes"]][["treatment_values--group2"]]) + + if(length(treatments)<2){ + treatments<-all_treatments[1:2] + } + + #subject data + subj <- data$dm %>% + count(!!sym(settings$dm$id_col),!!sym(settings$dm$treatment_col)) %>% + select(-n) %>% + as.data.frame() + + data.tendril <- Tendril( + mydata = aes_arm, + rotations = rep(3,dim(aes_arm)[1]), + AEfreqThreshold = 5, + Tag = "Comment", + Treatments = treatments, + Unique.Subject.Identifier = settings[["aes"]][["id_col"]], + Terms = settings[["aes"]][["bodsys_col"]], + Treat = settings[["dm"]][["treatment_col"]], + StartDay = settings[["aes"]][["stdy_col"]], + SubjList = subj, + SubjList.subject = settings[['dm']][['id_col']], + SubjList.treatment = settings[['dm']][['treatment_col']], + filter_double_events = TRUE, + suppress_warnings = TRUE + ) + + return(list(data=data.tendril, settings=list())) +} + diff --git a/inst/config/charts/functions/tplyr_aes_chart.R b/inst/config/charts/functions/tplyr_aes_chart.R new file mode 100644 index 00000000..632d4330 --- /dev/null +++ b/inst/config/charts/functions/tplyr_aes_chart.R @@ -0,0 +1,37 @@ +tplyr_aes_chart<-function(data,settings){ + + print("tplyr ae chart called") + dm_sub <- safetyGraphics::dm %>% select(USUBJID, ARM) + anly <- dm_sub %>% left_join(safetyGraphics::aes) + + + t <- tplyr_table(anly, ARM) %>% + set_pop_data(dm_sub) %>% + set_pop_treat_var(ARM) %>% + build() %>% + kable() + #%>% + # add_layer( + # group_count(vars(AEBODSYS, AEDECOD)) %>% + # set_distinct_by(USUBJID) %>% + # set_format_strings( + # n_counts = f_str("xx (xx.x%) [x]", distinct, distinct_pct, n) + # ) %>% + # set_nest_count(TRUE) %>% + # set_order_count_method('bycount') %>% + # set_result_order_var(distinct_n) %>% + # set_ordering_cols('Xanomeline High Dose') %>% + # add_risk_diff( + # c('Xanomeline High Dose', 'Placebo'), + # c('Xanomeline Low Dose', 'Placebo') + # ) + #) + + # t2<- suppressWarnings(build(t)) %>% + # select(starts_with('row'), starts_with('var'), starts_with('rdiff'), starts_with('ord')) %>% + # kable() %>% + # kable_styling() %>% + # scroll_box(width = "100%", height = "500px") + + return(t) +} \ No newline at end of file diff --git a/inst/config/charts/functions/tplyr_demog_chart.R b/inst/config/charts/functions/tplyr_demog_chart.R new file mode 100644 index 00000000..97ba6021 --- /dev/null +++ b/inst/config/charts/functions/tplyr_demog_chart.R @@ -0,0 +1,16 @@ +library(Tplyr) +library(kableExtra) + +tplyr_demog_chart <- function(data, settings){ + print(head(data)) + tab<-tplyr_table(data, ARM, cols = SEX) %>% + add_layer( + group_count(RACE, by = "Race") + ) %>% + add_layer( + group_desc(AGE, by = "Age (Years)") + ) %>% + build() + + return(tab) +} \ No newline at end of file diff --git a/inst/config/charts/functions/tplyr_shift_chart.R b/inst/config/charts/functions/tplyr_shift_chart.R new file mode 100644 index 00000000..4df3f605 --- /dev/null +++ b/inst/config/charts/functions/tplyr_shift_chart.R @@ -0,0 +1,20 @@ +tplyr_shift_chart<-function(data,settings){ + + adlb<-data$labs + adlb$ANRIND <- factor(adlb$ANRIND, levels=c("L", "N", "H")) + adlb$BNRIND <- factor(adlb$BNRIND, levels=c("L", "N", "H")) + # Create the table object + t <- tplyr_table(adlb, TRTA, where=PARAMCD == "ALP") %>% + # Add the shift layer, which takes two variables that will be the + # row and column variable you want for presentation + # Additionally note here that we're using two by variables to group by + # parameter and visit (though we've filtered to the CK parameter) + add_layer( + group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) + ) %>% + build() %>% + kable() %>% + kable_styling() %>% + scroll_box(width = "100%", height = "500px") + return(t) +} \ No newline at end of file diff --git a/inst/config/charts/hepexplorer.yaml b/inst/config/charts/hepexplorer.yaml new file mode 100644 index 00000000..6b25aa07 --- /dev/null +++ b/inst/config/charts/hepexplorer.yaml @@ -0,0 +1,6 @@ +label: Hepatic Safety Explorer +type: htmlwidget +domain: labs +package: safetyCharts +workflow: + widget: hepexplorer diff --git a/inst/config/charts/safetyHistogram.yaml b/inst/config/charts/safetyHistogram.yaml new file mode 100644 index 00000000..b1b8c580 --- /dev/null +++ b/inst/config/charts/safetyHistogram.yaml @@ -0,0 +1,6 @@ +label: Histogram +type: htmlwidget +domain: labs +package: safetyCharts +workflow: + widget: safetyHistogram diff --git a/inst/config/charts/safetyOutlierExplorer.yaml b/inst/config/charts/safetyOutlierExplorer.yaml new file mode 100644 index 00000000..c747a7dd --- /dev/null +++ b/inst/config/charts/safetyOutlierExplorer.yaml @@ -0,0 +1,6 @@ +label: Outlier Explorer +type: htmlwidget +domain: labs +package: safetyCharts +workflow: + widget: safetyOutlierExplorer diff --git a/inst/config/charts/safetyResultsOverTime.yaml b/inst/config/charts/safetyResultsOverTime.yaml new file mode 100644 index 00000000..4c34b6ce --- /dev/null +++ b/inst/config/charts/safetyResultsOverTime.yaml @@ -0,0 +1,6 @@ +label: Results Over Time +type: htmlwidget +domain: labs +package: safetyCharts +workflow: + widget: safetyResultsOverTime diff --git a/inst/config/charts/safetyShiftPlot.yaml b/inst/config/charts/safetyShiftPlot.yaml new file mode 100644 index 00000000..35f8cd48 --- /dev/null +++ b/inst/config/charts/safetyShiftPlot.yaml @@ -0,0 +1,6 @@ +label: Shift Plot +type: htmlwidget +domain: labs +package: safetyCharts +workflow: + widget: safetyShiftPlot diff --git a/inst/config/charts/tendril.yaml b/inst/config/charts/tendril.yaml new file mode 100644 index 00000000..b2d64056 --- /dev/null +++ b/inst/config/charts/tendril.yaml @@ -0,0 +1,7 @@ +label: Tendril Plot {Tendril} +type: plot +domain: multiple +package: Tendril +workflow: + init: tendril_init + main: tendril_chart diff --git a/inst/config/charts/tplyr_demog.yaml b/inst/config/charts/tplyr_demog.yaml new file mode 100644 index 00000000..0c81c842 --- /dev/null +++ b/inst/config/charts/tplyr_demog.yaml @@ -0,0 +1,6 @@ +label: Demographics Table {Tplyr} + {DT} +type: table +domain: dm +package: Tplyr +workflow: + main: tplyr_demog_chart diff --git a/inst/config/charts/tplyr_shift.yaml b/inst/config/charts/tplyr_shift.yaml new file mode 100644 index 00000000..0adee362 --- /dev/null +++ b/inst/config/charts/tplyr_shift.yaml @@ -0,0 +1,6 @@ +label: Shift Table {Tplyr} + {kable} +type: html +domain: multiple +pacakage: Tplyr +workflow: + main: tplyr_shift_chart diff --git a/inst/mappings/aes.yaml b/inst/config/mappings/aes.yaml similarity index 100% rename from inst/mappings/aes.yaml rename to inst/config/mappings/aes.yaml diff --git a/man/app_server.Rd b/man/app_server.Rd new file mode 100644 index 00000000..d8952393 --- /dev/null +++ b/man/app_server.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/app_server.R +\name{app_server} +\alias{app_server} +\title{Server for the default safetyGraphics shiny app} +\usage{ +app_server(input, output, session, meta, mapping, domainData, charts) +} +\arguments{ +\item{input}{app input} + +\item{output}{app output} + +\item{session}{app session} + +\item{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}.} + +\item{domainData}{named list of data.frames to be loaded in to the app.} + +\item{chartsList}{list of charts to include in the app} +} +\description{ +This function returns a server function suitable for use in shiny::runApp() +} diff --git a/man/app_startup.Rd b/man/app_startup.Rd new file mode 100644 index 00000000..dea363c2 --- /dev/null +++ b/man/app_startup.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/app_startup.R +\name{app_startup} +\alias{app_startup} +\title{Startup code for shiny app} +\usage{ +app_startup(domainData, meta, charts, mapping, chartSettingsPaths) +} +\value{ +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 } +} +} +\description{ +Prepare inputs for safetyGraphics app - run before app is initialized. See ?safetyGraphicsApp for parameter definitions +} diff --git a/man/chartsNav.Rd b/man/chartsNav.Rd index 9d11b303..332389a2 100644 --- a/man/chartsNav.Rd +++ b/man/chartsNav.Rd @@ -4,7 +4,7 @@ \alias{chartsNav} \title{Add a navbar tab that initializes the Chart Module UI} \usage{ -chartsNav(chart, label, package, type) +chartsNav(name, label, type, package) } \arguments{ \item{chart}{chart metadata} diff --git a/man/chartsRenderStatic.Rd b/man/chartsRenderStatic.Rd index 2c15ffc2..a876df7b 100644 --- a/man/chartsRenderStatic.Rd +++ b/man/chartsRenderStatic.Rd @@ -4,7 +4,7 @@ \alias{chartsRenderStatic} \title{Charts Module - render static chart server} \usage{ -chartsRenderStatic(input, output, session, chartFunction, params) +chartsRenderStatic(input, output, session, chartFunction, params, type) } \arguments{ \item{input}{Shiny input object} diff --git a/man/chartsRenderStaticUI.Rd b/man/chartsRenderStaticUI.Rd index d35bc513..3f383eef 100644 --- a/man/chartsRenderStaticUI.Rd +++ b/man/chartsRenderStaticUI.Rd @@ -4,7 +4,7 @@ \alias{chartsRenderStaticUI} \title{Charts Module - render static chart UI} \usage{ -chartsRenderStaticUI(id) +chartsRenderStaticUI(id, type) } \description{ Charts Module - sub module for rendering a static chart diff --git a/man/chartsTab.Rd b/man/chartsTab.Rd index 7e266ea9..b8f1bef0 100644 --- a/man/chartsTab.Rd +++ b/man/chartsTab.Rd @@ -4,19 +4,7 @@ \alias{chartsTab} \title{home tab - server} \usage{ -chartsTab( - input, - output, - session, - chart, - type, - package, - chartFunction, - initFunction, - domain, - data, - mapping -) +chartsTab(input, output, session, chart, data, mapping) } \arguments{ \item{input}{Input objects from module namespace} @@ -25,21 +13,11 @@ chartsTab( \item{session}{An environment that can be used to access information and functionality relating to the session} -\item{chart}{chart name. Should generally match the name of the function/widget/module to be intiated. See specific renderer modules for more details.} - -\item{type}{type of chart. Must be 'htmlwidget', 'module', 'static' or 'plotly'. See ?mod_chartRenderer{{type}} for more details about each chart type} - -\item{package}{package containing the widget.} - -\item{chartFunction}{function to generate static chart.} - -\item{initFunction}{function called before the chart is generated. The function should take `data` and `settings` as inputs and return `params` which should be a list which is then provided to the widget. If domain is specified, only domain-level information is passed to the init function, otherwise named lists containing information for all domains is provided. The mapping is parsed as a list using `generateMappingList()` before being passed to the init function. By default, init returns an unmodified list of data and settings - possibly subset to the specified domain (e.g. list(data=data, settings=settings))} - -\item{domain}{data domain. Should correspond to a domain in `meta` or be set to "multiple" to named lists for data and mappings containing domains.} +\item{chart}{list containing a safetyGraphics chart object. see custom chart vignette for details.} \item{data}{named list of current data sets [reactive].} -\item{mapping}{named list of the current data mappings [reactive].} +\item{mapping}{tibble capturing the current data mappings [reactive].} } \description{ server for the display of the chart tab diff --git a/man/chartsTabUI.Rd b/man/chartsTabUI.Rd index 6b6663ec..c2f490f9 100644 --- a/man/chartsTabUI.Rd +++ b/man/chartsTabUI.Rd @@ -4,7 +4,7 @@ \alias{chartsTabUI} \title{Charts Tab} \usage{ -chartsTabUI(id, chart, package, label = chart, type) +chartsTabUI(id, name, package, label = id, type) } \description{ Charting module diff --git a/man/generateMappingList.Rd b/man/generateMappingList.Rd index 58d9e4c1..604406a6 100644 --- a/man/generateMappingList.Rd +++ b/man/generateMappingList.Rd @@ -4,10 +4,10 @@ \alias{generateMappingList} \title{Convert mapping data.frame to a list} \usage{ -generateMappingList(settingsDF, domain) +generateMappingList(settingsDF, domain, pull = FALSE) } \arguments{ -\item{domain}{mapping domain to return (returns all domains as a named list by default)} +\item{domain}{call pull() the value for each parameter - needed for testing only. default: FALSE} \item{mappingDF}{data frame containing current mapping} } diff --git a/man/makeChartConfig.Rd b/man/makeChartConfig.Rd new file mode 100644 index 00000000..814a9e95 --- /dev/null +++ b/man/makeChartConfig.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/makeChartConfig.R +\name{makeChartConfig} +\alias{makeChartConfig} +\title{Make Chart Config} +\usage{ +makeChartConfig(dirs, sourceFiles = TRUE) +} +\arguments{ +\item{dirs}{path to one or more directories containing yaml files (relative to working directory)} + +\item{sourceFiles}{boolean indicating whether to source all R files found in dirs.} +} +\value{ +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. } +} +} +\description{ +Converts YAML chart configuration files to an R list and binds workflow functions. See the vignette about creating custom charts for more details. +} diff --git a/man/safetyGraphicsApp.Rd b/man/safetyGraphicsApp.Rd index 282f3bea..c16add92 100644 --- a/man/safetyGraphicsApp.Rd +++ b/man/safetyGraphicsApp.Rd @@ -5,27 +5,24 @@ \title{Run the interactive safety graphics app} \usage{ safetyGraphicsApp( - maxFileSize = NULL, - meta = safetyGraphics::meta, domainData = list(labs = safetyGraphics::labs, aes = safetyGraphics::aes, dm = safetyGraphics::dm), - charts = safetyGraphics::charts, + meta = safetyGraphics::meta, + charts = NULL, mapping = NULL, chartSettingsPaths = NULL ) } \arguments{ -\item{maxFileSize}{maximum file size in MB allowed for file upload} +\item{domainData}{named list of data.frames to be loaded in to the app.} \item{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}.} -\item{domainData}{named list of data.frames to be loaded in to the app.} - \item{charts}{data.frame of charts to be used in the app} \item{mapping}{data.frame specifying the initial values for each data mapping. If no mapping is provided, the app will attempt to generate one via \code{detectStandard()}} -\item{settingsPath}{path where customization functions are saved relative to your working directory. All charts can have itialization (e.g. [chart]Init.R) and static charts can have charting functions (e.g. [chart]Chart.R). All R files in this folder are sourced and files with the correct naming convention are linked to the chart. See the Custom Charts vignette for more details.} +\item{chartSettingsPaths}{path(s) where customization functions are saved relative to your working directory. All charts can have itialization (e.g. [chart]Init.R) and static charts can have charting functions (e.g. [chart]Chart.R). All R files in this folder are sourced and files with the correct naming convention are linked to the chart. See the Custom Charts vignette for more details.} } \description{ Run the interactive safety graphics app diff --git a/tests/testthat/module_examples/chartsRenderStatic/app.R b/tests/testthat/module_examples/chartsRenderStatic/app.R index 32620db8..f16e5d78 100644 --- a/tests/testthat/module_examples/chartsRenderStatic/app.R +++ b/tests/testthat/module_examples/chartsRenderStatic/app.R @@ -6,6 +6,7 @@ library(dplyr) data <- list(labs=safetyGraphics::labs, aes=safetyGraphics::aes) mapping <- list(measure_col="PARAM", value_col="AVAL") params<- reactive({list(data=data,settings=mapping)}) + # Test app code ui <- tagList( tags$head( diff --git a/tests/testthat/module_examples/chartsRenderWidget/app.R b/tests/testthat/module_examples/chartsRenderWidget/app.R index ce665c72..fe5b3095 100644 --- a/tests/testthat/module_examples/chartsRenderWidget/app.R +++ b/tests/testthat/module_examples/chartsRenderWidget/app.R @@ -29,23 +29,23 @@ body<-dashboardBody( tabItem( tabName="ex1-tab", { - h2("Example 1 - hepexplorer- called directly from safetyGraphics hepexplorer") - chartsRenderWidgetUI("ex1",chart="eDISH",package="safetyexploreR") + h2("Example 1 - hepexplorer - called directly from safetyCharts hepexplorer") + chartsRenderWidgetUI("ex1",chart="hepexplorer",package="safetyCharts") } ), tabItem( tabName="ex2-tab", { - h2("Example 2 - AE Explorer - called from safetyexploreR using custom init function") - chartsRenderWidgetUI("ex2",chart="aeExplorer",package="safetyexploreR") + h2("Example 2 - AE Explorer - called from safetyCharts using custom init function") + chartsRenderWidgetUI("ex2",chart="aeExplorer",package="safetyCharts") } ), tabItem( tabName="ex3-tab", { - h2("Example 3 - Results over time - called from safetyexploreR") - chartsRenderWidgetUI("ex3",chart="safetyResultsOverTime",package="safetyexploreR") + h2("Example 3 - Results over time - called from safetyCharts") + chartsRenderWidgetUI("ex3",chart="safetyResultsOverTime",package="safetyCharts") } ) ) @@ -73,13 +73,13 @@ ui <- tagList( ) server <- function(input,output,session){ - # Example 1 - hep explorer - paramsLabs <- reactive({list(data=domainData[["labs"]],settings=mappingLabs)}) - callModule( + # Example 1 - hep explorer + paramsLabs <- reactive({list(data=domainData[["labs"]],settings=mappingLabs)}) + callModule( chartsRenderWidget, "ex1", - chart="eDISH", - package="safetyexploreR", + chart="hepexplorer", + package="safetyCharts", params=paramsLabs ) @@ -100,7 +100,7 @@ server <- function(input,output,session){ chartsRenderWidget, "ex2", chart="aeExplorer", - package="safetyexploreR", + package="safetyCharts", params=paramsAEs ) @@ -109,7 +109,7 @@ server <- function(input,output,session){ chartsRenderWidget, "ex3", chart="safetyResultsOverTime", - package="safetyexploreR", + package="safetyCharts", params=paramsLabs ) } diff --git a/tests/testthat/module_examples/chartsTab/app.R b/tests/testthat/module_examples/chartsTab/app.R index f1f8d809..b0d3ba51 100644 --- a/tests/testthat/module_examples/chartsTab/app.R +++ b/tests/testthat/module_examples/chartsTab/app.R @@ -29,7 +29,7 @@ body<-dashboardBody( tabName="ex1-tab", { h2("Example 1 - hepexplorer- called directly from safetyGraphics hepexplorer") - chartsTabUI("ex1",chart="hepexplorer",package="safetyGraphics",label="Hepatic Explorer",type="htmlwidget") + chartsTabUI("ex1",name="hepexplorer",package="safetyCharts",label="Hepatic Explorer",type="htmlwidget") } ), @@ -37,35 +37,35 @@ body<-dashboardBody( tabName="ex2-tab", { h2("Example 2 - AE Explorer - called from safetyexploreR using custom init function") - chartsTabUI("ex2",chart="aeExplorer",package="safetyexploreR",label="AE Explorer",type="htmlwidget") + chartsTabUI("ex2",name="aeExplorer",package="safetyexploreR",label="AE Explorer",type="htmlwidget") } ), tabItem( tabName="ex3-tab", { h2("Example 3 - Results over time - called from safetyexploreR") - chartsTabUI("ex3",chart="safetyResultsOverTime",label="Lab Results Over Time", package="safetyexploreR",type="htmlwidget") + chartsTabUI("ex3",name="safetyResultsOverTime",label="Lab Results Over Time", package="safetyexploreR",type="htmlwidget") } ), tabItem( tabName="ex4-tab", { h2("Example 4 - Helloworld static chart") - chartsTabUI("ex4",chart="HelloWorld",label="Hello World",type="static") + chartsTabUI("ex4",name="HelloWorld",label="Hello World",type="plot") } ), tabItem( tabName="ex5-tab", { - h2("Example 5 - Helloworld static chart") - chartsTabUI("ex5",chart="Boxplot1",label="Box Plot 1",type="static") + h2("Example 5 - Box plot") + chartsTabUI("ex5",name="Boxplot1",label="Box Plot 1",type="plot") } ), tabItem( tabName="ex6-tab", { - h2("Example 6 - Helloworld static chart") - chartsTabUI("ex6",chart="Boxplot2",label="Custom Box Plot",type="static") + h2("Example 6 - Custom Box plot") + chartsTabUI("ex6",name="Boxplot2",label="Custom Box Plot",type="plot") } ) ) @@ -97,22 +97,21 @@ ui <- tagList( ) server <- function(input,output,session){ - # Example 1 - hep explorer - paramsLabs <- reactive({list(data=domainData[["labs"]],settings=mappingLabs)}) - callModule( - chartsTab, - "ex1", - chart="hepexplorer", - type="htmlwidget", - package="safetyGraphics", - domain="labs", - data=dataR, - mapping=mappingR - - ) + # Example 1 - hep explorer + charts<-MakeChartConfig(paste(.libPaths(),'safetygraphics','config', "charts", sep="/")) + paramsLabs <- reactive({list(data=domainData[["labs"]],settings=mappingLabs)}) + callModule( + chartsTab, + "ex1", + chart=charts$hepexplorer, + data=dataR, + mapping=mappingR +) # Example 2 - AE Explorer initAEE <- function(data, settings){ + print("intiAEEE") + data<-data$aes settings$variables=list( major=settings[["bodsys_col"]], minor=settings[["term_col"]], @@ -123,26 +122,21 @@ server <- function(input,output,session){ ) return(list(data=data,settings=settings)) } + + charts$aeExplorer$functions$init <- initAEE callModule( chartsTab, "ex2", - chart="aeExplorer", - package="safetyexploreR", - type="htmlwidget", - domain="aes", - data=dataR, + chart=charts$aeExplorer, mapping=mappingR, - initFunction=initAEE + data=dataR ) #Example 3 - results over time callModule( chartsTab, "ex3", - chart="safetyResultsOverTime", - package="safetyexploreR", - domain="labs", - type="htmlwidget", + chart=charts$safetyResultsOverTime, data=dataR, mapping=mappingR ) @@ -152,15 +146,22 @@ server <- function(input,output,session){ plot(-1:1, -1:1) text(runif(20, -1,1),runif(20, -1,1),"Hello World") } - + + helloworld_chart<-list( + name="HelloWorld", + type="plot", + domain="aes", + functions=list( + main=helloWorld + ) + ) + callModule( chartsTab, "ex4", - chart="HelloWorld", + chart=helloworld_chart, data=dataR, - mapping=mappingR, - type="static", - chartFunction=helloWorld + mapping=mappingR ) #Example 5 @@ -177,13 +178,19 @@ server <- function(input,output,session){ axis.title = element_text(size = 12)) } + box1_chart<-list( + name="Box1", + type="plot", + domain="labs", + functions=list( + main=boxPlot + ) + ) + callModule( chartsTab, "ex5", - chart="Boxplot1", - chartFunction=boxPlot, - type="static", - domain="labs", + chart=box1_chart, data=dataR, mapping=mappingR ) @@ -206,17 +213,22 @@ server <- function(input,output,session){ axis.text = element_text(size = 12), axis.title = element_text(size = 12)) } - + box2_chart<-list( + name="Box2", + type="plot", + domain="labs", + functions=list( + main=boxPlot2, + init=dataInit + ) + ) + callModule( chartsTab, "ex6", - chartFunction=boxPlot2, - chart="Boxplot2", + chart=box2_chart, data=dataR, - domain="labs", - mapping=mappingR, - initFunction=dataInit, - type="static" + mapping=mappingR ) } From 25ca610b1f37a966191345a703455541e1886862 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 6 Nov 2020 13:14:28 -0500 Subject: [PATCH 04/15] update chartTabUI to use chart revised object --- NAMESPACE | 2 + R/app_server.R | 2 +- R/mod_chartsNav.R | 15 ++---- R/mod_chartsTab.R | 14 ++--- inst/config/charts/functions/mod_labdist.R | 59 ---------------------- man/chartsNav.Rd | 2 +- man/chartsTabUI.Rd | 2 +- 7 files changed, 17 insertions(+), 79 deletions(-) delete mode 100644 inst/config/charts/functions/mod_labdist.R diff --git a/NAMESPACE b/NAMESPACE index a21af598..f5cd7122 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,8 @@ export(app_server) export(app_ui) export(chartsNav) +export(chartsRenderModule) +export(chartsRenderModuleUI) export(chartsRenderStatic) export(chartsRenderStaticUI) export(chartsRenderWidget) diff --git a/R/app_server.R b/R/app_server.R index 5bf833b5..c41630a2 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -38,7 +38,7 @@ app_server <- function(input, output, session, meta, mapping, domainData, charts callModule(homeTab, "home") #Initialize Chart UI - Adds subtabs to chart menu - this initializes initializes chart UIs - charts %>% map(~chartsNav(name=.x$name, label=.x$label, type=.x$type, package=.x$package)) + charts %>% map(chartsNav) #Initialize Chart Servers validDomains <- tolower(names(mapping)) diff --git a/R/mod_chartsNav.R b/R/mod_chartsNav.R index 95ca82db..600a360c 100644 --- a/R/mod_chartsNav.R +++ b/R/mod_chartsNav.R @@ -5,21 +5,16 @@ #' @export #' -chartsNav <- function(name, label, type, package){ - #chart$chartFunction <- NULL - #chart$initFunction <- NULL +chartsNav <- function(chart){ appendTab( inputId = "safetyGraphicsApp", menuName = "Charts", tab = tabPanel( - title = label, - value = name, + title = chart$label, + value = chart$name, chartsTabUI( - id=name, - name=name, - package=package, - label=label, - type=type + id=chart$name, + chart=chart ) ) ) diff --git a/R/mod_chartsTab.R b/R/mod_chartsTab.R index e25e66a5..09bfc3d0 100644 --- a/R/mod_chartsTab.R +++ b/R/mod_chartsTab.R @@ -3,18 +3,18 @@ #' #' @export -chartsTabUI <- function(id, name, package, label=id, type){ +chartsTabUI <- function(id, chart){ ns <- NS(id) - h2(paste("Chart:",label)) - if(tolower(type=="module")){ + h2(paste("Chart:",chart$label)) + if(tolower(chart$type=="module")){ #render the module UI - - }else if(tolower(type=="htmlwidget")){ + #chartsRenderModule(id=ns("wrap"), chartsRenderModuleUI()) + }else if(tolower(chart$type=="htmlwidget")){ #render the widget - chartsRenderWidgetUI(id=ns("wrap"),chart=name, package=package) + chartsRenderWidgetUI(id=ns("wrap"),chart=chart$name, package=chart$package) }else{ #create the static or plotly chart - chartsRenderStaticUI(id=ns("wrap"), type=type) + chartsRenderStaticUI(id=ns("wrap"), type=chart$type) } } diff --git a/inst/config/charts/functions/mod_labdist.R b/inst/config/charts/functions/mod_labdist.R deleted file mode 100644 index ecc75740..00000000 --- a/inst/config/charts/functions/mod_labdist.R +++ /dev/null @@ -1,59 +0,0 @@ -##################################################################### -# Step 1 - Write custom chart module code -##################################################################### -mod_labdist_UI <- function(id) { - ns <- NS(id) - tagList( - checkboxInput(ns("show_points"), "Show points?", value=FALSE), - checkboxInput(ns("show_outliers"), "Show outliers?", value=TRUE), - selectInput(ns("scale"), "Scale Transform", choices=c("Log-10","None")), - plotOutput(ns("labdist"), width = "1000px") - ) -} - -mod_labdist_server <- function(input, output, session, data, settings) { - - ns <- session$ns - - mapped_data <- reactive({ - data() %>% - select( - Value = settings()[["value_col"]], - Measure = settings()[["measure_col"]] - )%>% - filter(!is.na(Value)) - }) - - output$labdist <- renderPlot({ - - req(mapped_data()) - - # set up the plot - p <- ggplot(data = mapped_data(), aes(x = Measure, y = Value)) + - theme_bw() + - theme( - axis.text.x = element_text(angle = 25, hjust = 1), - axis.text=element_text(size=12), - axis.title = element_text(size = 12) - ) - - # add/remove outliers - if (input$show_outliers){ - p <- p + geom_boxplot(fill = "orange") - } else { - p <- p + geom_boxplot(fill = "orange", outlier.shape = NA) - } - - # log-transform scale - if (input$scale=="Log-10"){ - p <- p + scale_y_log10() - } - - # show individual data points - if (input$show_points){ - p <- p + geom_jitter(width = 0.2) - } - - p - }) -} \ No newline at end of file diff --git a/man/chartsNav.Rd b/man/chartsNav.Rd index 332389a2..bad6a978 100644 --- a/man/chartsNav.Rd +++ b/man/chartsNav.Rd @@ -4,7 +4,7 @@ \alias{chartsNav} \title{Add a navbar tab that initializes the Chart Module UI} \usage{ -chartsNav(name, label, type, package) +chartsNav(chart) } \arguments{ \item{chart}{chart metadata} diff --git a/man/chartsTabUI.Rd b/man/chartsTabUI.Rd index c2f490f9..6b26142f 100644 --- a/man/chartsTabUI.Rd +++ b/man/chartsTabUI.Rd @@ -4,7 +4,7 @@ \alias{chartsTabUI} \title{Charts Tab} \usage{ -chartsTabUI(id, name, package, label = id, type) +chartsTabUI(id, chart) } \description{ Charting module From c5040d257654533f6cb86928c360adf73bcb0447 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 6 Nov 2020 13:49:10 -0500 Subject: [PATCH 05/15] add support for custom modules. fix #429 --- R/mod_chartsRenderModule.R | 27 ++++++++++++ R/mod_chartsTab.R | 11 ++++- inst/config/charts/functions/labdist.R | 59 ++++++++++++++++++++++++++ inst/config/charts/labdist.yaml | 6 +++ man/chartsRenderModule.Rd | 22 ++++++++++ man/chartsRenderModuleUI.Rd | 11 +++++ 6 files changed, 134 insertions(+), 2 deletions(-) create mode 100644 R/mod_chartsRenderModule.R create mode 100644 inst/config/charts/functions/labdist.R create mode 100644 inst/config/charts/labdist.yaml create mode 100644 man/chartsRenderModule.Rd create mode 100644 man/chartsRenderModuleUI.Rd diff --git a/R/mod_chartsRenderModule.R b/R/mod_chartsRenderModule.R new file mode 100644 index 00000000..6e79fe84 --- /dev/null +++ b/R/mod_chartsRenderModule.R @@ -0,0 +1,27 @@ +#' @title Charts Module - render module chart UI +#' @description Charts Module - sub module for rendering a static chart +#' +#' @import DT +#' +#' @export + +chartsRenderModuleUI <- function(id, customModUI){ + ns <- NS(id) + customModUI(ns("customModUI")) +} + +#' @title Charts Module - render static chart server +#' @description server for the display of the loaded data +#' +#' @param input Shiny input object +#' @param output Shiny output object +#' @param session Shiny session object +#' @param chartFunction function to generate the chart. +#' @param params parameters to be passed to the widget [REACTIVE] +#' +#' @export + +chartsRenderModule <- function(input, output, session, serverFunction, params){ + ns <- session$ns + callModule(serverFunction, "customModUI", params) +} diff --git a/R/mod_chartsTab.R b/R/mod_chartsTab.R index 09bfc3d0..b31f7f87 100644 --- a/R/mod_chartsTab.R +++ b/R/mod_chartsTab.R @@ -8,7 +8,7 @@ chartsTabUI <- function(id, chart){ h2(paste("Chart:",chart$label)) if(tolower(chart$type=="module")){ #render the module UI - #chartsRenderModule(id=ns("wrap"), chartsRenderModuleUI()) + chartsRenderModuleUI(id=ns("wrap"), chart$functions[[chart$workflow$ui]]) }else if(tolower(chart$type=="htmlwidget")){ #render the widget chartsRenderWidgetUI(id=ns("wrap"),chart=chart$name, package=chart$package) @@ -62,7 +62,14 @@ chartsTab <- function(input, output, session, chart, data, mapping){ if(tolower(chart$type=="module")){ #render the module UI - #call the module server + message("chartsTab() is initializing a module at ", ns("wrap")) + serverFunction <- chart$functions[[chart$workflow$server]] + callModule( + module=chartsRenderModule, + id="wrap", + serverFunction=serverFunction, + params=params + ) }else if(tolower(chart$type=="htmlwidget")){ message("chartsTab() is initializing a widget at ", ns("wrap")) message("chart is ", chart$name, "; package is ", chart$package) diff --git a/inst/config/charts/functions/labdist.R b/inst/config/charts/functions/labdist.R new file mode 100644 index 00000000..d8fc82ae --- /dev/null +++ b/inst/config/charts/functions/labdist.R @@ -0,0 +1,59 @@ +##################################################################### +# Step 1 - Write custom chart module code +##################################################################### +labdist_ui <- function(id) { + ns <- NS(id) + tagList( + checkboxInput(ns("show_points"), "Show points?", value=FALSE), + checkboxInput(ns("show_outliers"), "Show outliers?", value=TRUE), + selectInput(ns("scale"), "Scale Transform", choices=c("Log-10","None")), + plotOutput(ns("labdist"), width = "1000px") + ) +} + +labdist_server <- function(input, output, session, params) { + + ns <- session$ns + + mapped_data <- reactive({ + params()$data %>% + select( + Value = params()$settings[["value_col"]], + Measure = params()$settings[["measure_col"]] + )%>% + filter(!is.na(Value)) + }) + + output$labdist <- renderPlot({ + + req(mapped_data()) + + # set up the plot + p <- ggplot(data = mapped_data(), aes(x = Measure, y = Value)) + + theme_bw() + + theme( + axis.text.x = element_text(angle = 25, hjust = 1), + axis.text=element_text(size=12), + axis.title = element_text(size = 12) + ) + + # add/remove outliers + if (input$show_outliers){ + p <- p + geom_boxplot(fill = "orange") + } else { + p <- p + geom_boxplot(fill = "orange", outlier.shape = NA) + } + + # log-transform scale + if (input$scale=="Log-10"){ + p <- p + scale_y_log10() + } + + # show individual data points + if (input$show_points){ + p <- p + geom_jitter(width = 0.2) + } + + p + }) +} \ No newline at end of file diff --git a/inst/config/charts/labdist.yaml b/inst/config/charts/labdist.yaml new file mode 100644 index 00000000..acb84928 --- /dev/null +++ b/inst/config/charts/labdist.yaml @@ -0,0 +1,6 @@ +label: Labs Distribution (custom shiny module) +type: module +domain: labs +workflow: + ui: labdist_ui + server: labdist_server diff --git a/man/chartsRenderModule.Rd b/man/chartsRenderModule.Rd new file mode 100644 index 00000000..321af142 --- /dev/null +++ b/man/chartsRenderModule.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_chartsRenderModule.R +\name{chartsRenderModule} +\alias{chartsRenderModule} +\title{Charts Module - render static chart server} +\usage{ +chartsRenderModule(input, output, session, serverFunction, params) +} +\arguments{ +\item{input}{Shiny input object} + +\item{output}{Shiny output object} + +\item{session}{Shiny session object} + +\item{params}{parameters to be passed to the widget [REACTIVE]} + +\item{chartFunction}{function to generate the chart.} +} +\description{ +server for the display of the loaded data +} diff --git a/man/chartsRenderModuleUI.Rd b/man/chartsRenderModuleUI.Rd new file mode 100644 index 00000000..7ab6b300 --- /dev/null +++ b/man/chartsRenderModuleUI.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mod_chartsRenderModule.R +\name{chartsRenderModuleUI} +\alias{chartsRenderModuleUI} +\title{Charts Module - render module chart UI} +\usage{ +chartsRenderModuleUI(id, customModUI) +} +\description{ +Charts Module - sub module for rendering a static chart +} From e462a08ba6ebecfb5a94df4a6727f71b7458f9de Mon Sep 17 00:00:00 2001 From: jwildfire Date: Wed, 11 Nov 2020 09:53:02 -0500 Subject: [PATCH 06/15] migrate config to safetyCharts fix #431 --- NAMESPACE | 1 - R/getChartFunctions.R | 44 -------------- R/makeChartConfig.R | 5 +- inst/config/charts/aeExplorer.yaml | 7 --- inst/config/charts/aeTimelines.yaml | 6 -- .../config/charts/functions/aeExplorer_init.R | 36 ----------- inst/config/charts/functions/labdist.R | 59 ------------------- .../charts/functions/safety_histogram_chart.R | 59 ------------------- inst/config/charts/functions/tendril_chart.R | 4 -- inst/config/charts/functions/tendril_init.R | 46 --------------- .../config/charts/functions/tplyr_aes_chart.R | 37 ------------ .../charts/functions/tplyr_demog_chart.R | 16 ----- .../charts/functions/tplyr_shift_chart.R | 20 ------- inst/config/charts/hepexplorer.yaml | 6 -- inst/config/charts/labdist.yaml | 6 -- inst/config/charts/safetyHistogram.yaml | 6 -- inst/config/charts/safetyOutlierExplorer.yaml | 6 -- inst/config/charts/safetyResultsOverTime.yaml | 6 -- inst/config/charts/safetyShiftPlot.yaml | 6 -- inst/config/charts/tendril.yaml | 7 --- inst/config/charts/tplyr_demog.yaml | 6 -- inst/config/charts/tplyr_shift.yaml | 6 -- man/getChartFunctions.Rd | 19 ------ 23 files changed, 3 insertions(+), 411 deletions(-) delete mode 100644 R/getChartFunctions.R delete mode 100644 inst/config/charts/aeExplorer.yaml delete mode 100644 inst/config/charts/aeTimelines.yaml delete mode 100644 inst/config/charts/functions/aeExplorer_init.R delete mode 100644 inst/config/charts/functions/labdist.R delete mode 100644 inst/config/charts/functions/safety_histogram_chart.R delete mode 100644 inst/config/charts/functions/tendril_chart.R delete mode 100644 inst/config/charts/functions/tendril_init.R delete mode 100644 inst/config/charts/functions/tplyr_aes_chart.R delete mode 100644 inst/config/charts/functions/tplyr_demog_chart.R delete mode 100644 inst/config/charts/functions/tplyr_shift_chart.R delete mode 100644 inst/config/charts/hepexplorer.yaml delete mode 100644 inst/config/charts/labdist.yaml delete mode 100644 inst/config/charts/safetyHistogram.yaml delete mode 100644 inst/config/charts/safetyOutlierExplorer.yaml delete mode 100644 inst/config/charts/safetyResultsOverTime.yaml delete mode 100644 inst/config/charts/safetyShiftPlot.yaml delete mode 100644 inst/config/charts/tendril.yaml delete mode 100644 inst/config/charts/tplyr_demog.yaml delete mode 100644 inst/config/charts/tplyr_shift.yaml delete mode 100644 man/getChartFunctions.Rd diff --git a/NAMESPACE b/NAMESPACE index f5cd7122..5d09a0d9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,7 +16,6 @@ export(evaluateStandard) export(filterTab) export(filterTabUI) export(generateMappingList) -export(getChartFunctions) export(homeTab) export(homeTabUI) export(makeChartConfig) diff --git a/R/getChartFunctions.R b/R/getChartFunctions.R deleted file mode 100644 index c09f5fe9..00000000 --- a/R/getChartFunctions.R +++ /dev/null @@ -1,44 +0,0 @@ -#' @title Get Chart Functions -#' @description Function to get functions associated with charts -#' -#' @param chartsList List of charts and thier parameters -#' @param chartSettingsPath path for custom files. -#' -#' @return an updated chartsList object with initFunction and chartFunction parameters added as appropriate -#' -#' @export -#' -getChartFunctions <- function(chartsList, chartSettingsPaths){ - #source all R files in specified settings paths - for(path in chartSettingsPaths){ - chartSettingsSources <- list.files(path, pattern = "\\.R$", ignore.case=TRUE, full.names=TRUE) - sapply(chartSettingsSources, source) - } - - for(chartID in names(chartsList)){ - #set default until function is found - chartsList[[chartID]][["initFunction"]]<-function(data,settings){ - return(list(data=data,settings=settings)) - } - - # add init function - if(exists(paste0(chartID,"_init"))){ - chartsList[[chartID]][["initFunction"]] <- match.fun(paste0(chartID,"_init")) - } - - # add chart function (type == static only) - chartsList[[chartID]][["chartFunction"]]<-function(data,settings){ - plot(-1:1, -1:1) - text(0,0,"Charting Function Not Found") - text(runif(20, -1,1),runif(20, -1,1),":(") - } - - if(exists(chartID)){ - chartsList[[chartID]][["chartFunction"]] <- match.fun(paste0(chartID)) - }else if(exists(paste0(chartID,"_chart"))){ - chartsList[[chartID]][["chartFunction"]] <- match.fun(paste0(chartID,"_chart")) - } - #TODO: Add some checks to make sure matches are in fact functions - } - return(chartsList) -} diff --git a/R/makeChartConfig.R b/R/makeChartConfig.R index 2d1b6354..c3b9be5d 100644 --- a/R/makeChartConfig.R +++ b/R/makeChartConfig.R @@ -27,12 +27,13 @@ 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(),'safetygraphics','config','charts', sep="/") + dirs<-paste(.libPaths(),'safetycharts','config', sep="/") } if(sourceFiles){ r_files<-list.files( - dirs, pattern = "\\.R$", + dirs, + pattern = "\\.R$", ignore.case=TRUE, full.names=TRUE, recursive=TRUE diff --git a/inst/config/charts/aeExplorer.yaml b/inst/config/charts/aeExplorer.yaml deleted file mode 100644 index 5f52cfed..00000000 --- a/inst/config/charts/aeExplorer.yaml +++ /dev/null @@ -1,7 +0,0 @@ -label: Safety Explorer -type: htmlwidget -domain: multiple -package: safetyCharts -workflow: - init: aeExplorer_init - widget: aeExplorer diff --git a/inst/config/charts/aeTimelines.yaml b/inst/config/charts/aeTimelines.yaml deleted file mode 100644 index bdb9086f..00000000 --- a/inst/config/charts/aeTimelines.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Safety Timelines -type: htmlwidget -domain: aes -package: safetyCharts -workflow: - widget: aeTimelines diff --git a/inst/config/charts/functions/aeExplorer_init.R b/inst/config/charts/functions/aeExplorer_init.R deleted file mode 100644 index 8b503fd5..00000000 --- a/inst/config/charts/functions/aeExplorer_init.R +++ /dev/null @@ -1,36 +0,0 @@ -library(dplyr) - -aeExplorer_init<- function(data, settings){ - print(data) - print(settings) - dm_sub <- data$dm %>% select(settings[["dm"]][["id_col"]], settings[["dm"]][["treatment_col"]]) - anly <- dm_sub %>% left_join(data$aes) - - print(head(anly)) - - settings<-c(settings$aes, settings$labs) - - settings$variables<-list( - major=settings[["bodsys_col"]], - minor=settings[["term_col"]], - group=settings[["trt_col"]], - id=paste0(settings[["id_col"]]), - filters=list(), - details=list() - ) - - settings$variableOptions<-list( - group=c( - settings[["treatment_values--group1"]], - settings[["treatment_values--group2"]] - ) - ) - - settings$defaults = list( - placeholderFlag = list( - valueCol = settings[["bodsys_col"]], - values = c("", NA, NULL) - ) - ) - return(list(data=anly,settings=settings)) -} \ No newline at end of file diff --git a/inst/config/charts/functions/labdist.R b/inst/config/charts/functions/labdist.R deleted file mode 100644 index d8fc82ae..00000000 --- a/inst/config/charts/functions/labdist.R +++ /dev/null @@ -1,59 +0,0 @@ -##################################################################### -# Step 1 - Write custom chart module code -##################################################################### -labdist_ui <- function(id) { - ns <- NS(id) - tagList( - checkboxInput(ns("show_points"), "Show points?", value=FALSE), - checkboxInput(ns("show_outliers"), "Show outliers?", value=TRUE), - selectInput(ns("scale"), "Scale Transform", choices=c("Log-10","None")), - plotOutput(ns("labdist"), width = "1000px") - ) -} - -labdist_server <- function(input, output, session, params) { - - ns <- session$ns - - mapped_data <- reactive({ - params()$data %>% - select( - Value = params()$settings[["value_col"]], - Measure = params()$settings[["measure_col"]] - )%>% - filter(!is.na(Value)) - }) - - output$labdist <- renderPlot({ - - req(mapped_data()) - - # set up the plot - p <- ggplot(data = mapped_data(), aes(x = Measure, y = Value)) + - theme_bw() + - theme( - axis.text.x = element_text(angle = 25, hjust = 1), - axis.text=element_text(size=12), - axis.title = element_text(size = 12) - ) - - # add/remove outliers - if (input$show_outliers){ - p <- p + geom_boxplot(fill = "orange") - } else { - p <- p + geom_boxplot(fill = "orange", outlier.shape = NA) - } - - # log-transform scale - if (input$scale=="Log-10"){ - p <- p + scale_y_log10() - } - - # show individual data points - if (input$show_points){ - p <- p + geom_jitter(width = 0.2) - } - - p - }) -} \ No newline at end of file diff --git a/inst/config/charts/functions/safety_histogram_chart.R b/inst/config/charts/functions/safety_histogram_chart.R deleted file mode 100644 index a67b45ad..00000000 --- a/inst/config/charts/functions/safety_histogram_chart.R +++ /dev/null @@ -1,59 +0,0 @@ -library(dplyr) -library(ggplot2) - -safety_histogram_chart <- function(data, settings, description="Safety Histogram"){ - id_col <- settings[["id_col"]] - value_col <- settings[["value_col"]] - measure_col <- settings[["measure_col"]] - normal_col_low <- settings[["normal_col_low"]] - normal_col_high <- settings[["normal_col_high"]] - unit_col <- settings[["unit_col"]] - - # prep data - dd <- data %>% - select(one_of(c(id_col, value_col, measure_col, normal_col_low, normal_col_high))) %>% - setNames(., c("id_col","value_col","measure_col","normal_col_low","normal_col_high")) %>% - filter(!is.na(value_col)) - - # get labels for fig - ylab <- "# of\nObservations" - plot_title <- description - - # color for histogram - col <- RColorBrewer::brewer.pal(3, "Set2")[1] - - p <- ggplot(data=dd) + - geom_rect( - aes( - xmin=normal_col_low , - xmax=normal_col_high, - ymin=-Inf, - ymax=Inf - ), - alpha=0.5, - stat="identity", - fill = "gray90", - color="gray70" - )+ - geom_histogram( - aes( - x=value_col - ), - fill=col, - alpha=0.6, - color=col - )+ - theme_bw() + - labs( - x="", - y=ylab, - title=plot_title - ) + - facet_wrap( - vars(measure_col), - scales="free_x" - ) - - - return(p) -} diff --git a/inst/config/charts/functions/tendril_chart.R b/inst/config/charts/functions/tendril_chart.R deleted file mode 100644 index 6a9d33ce..00000000 --- a/inst/config/charts/functions/tendril_chart.R +++ /dev/null @@ -1,4 +0,0 @@ -tendril_chart <- function(data, settings){ - print("called the tendril chart") - return(plot(data, coloring = "OR", percentile = TRUE)) -} \ No newline at end of file diff --git a/inst/config/charts/functions/tendril_init.R b/inst/config/charts/functions/tendril_init.R deleted file mode 100644 index f2165490..00000000 --- a/inst/config/charts/functions/tendril_init.R +++ /dev/null @@ -1,46 +0,0 @@ -library("Tendril") - -#compute tendril data -tendril_init<-function(data, settings){ - print("Init Tendril") - print(names(data)) - aes_arm <- left_join( - data$aes, - data$dm%>%select(settings$dm$id_col, settings$dm$treatment_col), - by=settings$dm$id_col) - - - #get treatments - all_treatments <- unique(aes_arm%>%pull(settings$dm$treatment_col)) - treatments <- c(settings[["aes"]][["treatment_values--group1"]],settings[["aes"]][["treatment_values--group2"]]) - - if(length(treatments)<2){ - treatments<-all_treatments[1:2] - } - - #subject data - subj <- data$dm %>% - count(!!sym(settings$dm$id_col),!!sym(settings$dm$treatment_col)) %>% - select(-n) %>% - as.data.frame() - - data.tendril <- Tendril( - mydata = aes_arm, - rotations = rep(3,dim(aes_arm)[1]), - AEfreqThreshold = 5, - Tag = "Comment", - Treatments = treatments, - Unique.Subject.Identifier = settings[["aes"]][["id_col"]], - Terms = settings[["aes"]][["bodsys_col"]], - Treat = settings[["dm"]][["treatment_col"]], - StartDay = settings[["aes"]][["stdy_col"]], - SubjList = subj, - SubjList.subject = settings[['dm']][['id_col']], - SubjList.treatment = settings[['dm']][['treatment_col']], - filter_double_events = TRUE, - suppress_warnings = TRUE - ) - - return(list(data=data.tendril, settings=list())) -} - diff --git a/inst/config/charts/functions/tplyr_aes_chart.R b/inst/config/charts/functions/tplyr_aes_chart.R deleted file mode 100644 index 632d4330..00000000 --- a/inst/config/charts/functions/tplyr_aes_chart.R +++ /dev/null @@ -1,37 +0,0 @@ -tplyr_aes_chart<-function(data,settings){ - - print("tplyr ae chart called") - dm_sub <- safetyGraphics::dm %>% select(USUBJID, ARM) - anly <- dm_sub %>% left_join(safetyGraphics::aes) - - - t <- tplyr_table(anly, ARM) %>% - set_pop_data(dm_sub) %>% - set_pop_treat_var(ARM) %>% - build() %>% - kable() - #%>% - # add_layer( - # group_count(vars(AEBODSYS, AEDECOD)) %>% - # set_distinct_by(USUBJID) %>% - # set_format_strings( - # n_counts = f_str("xx (xx.x%) [x]", distinct, distinct_pct, n) - # ) %>% - # set_nest_count(TRUE) %>% - # set_order_count_method('bycount') %>% - # set_result_order_var(distinct_n) %>% - # set_ordering_cols('Xanomeline High Dose') %>% - # add_risk_diff( - # c('Xanomeline High Dose', 'Placebo'), - # c('Xanomeline Low Dose', 'Placebo') - # ) - #) - - # t2<- suppressWarnings(build(t)) %>% - # select(starts_with('row'), starts_with('var'), starts_with('rdiff'), starts_with('ord')) %>% - # kable() %>% - # kable_styling() %>% - # scroll_box(width = "100%", height = "500px") - - return(t) -} \ No newline at end of file diff --git a/inst/config/charts/functions/tplyr_demog_chart.R b/inst/config/charts/functions/tplyr_demog_chart.R deleted file mode 100644 index 97ba6021..00000000 --- a/inst/config/charts/functions/tplyr_demog_chart.R +++ /dev/null @@ -1,16 +0,0 @@ -library(Tplyr) -library(kableExtra) - -tplyr_demog_chart <- function(data, settings){ - print(head(data)) - tab<-tplyr_table(data, ARM, cols = SEX) %>% - add_layer( - group_count(RACE, by = "Race") - ) %>% - add_layer( - group_desc(AGE, by = "Age (Years)") - ) %>% - build() - - return(tab) -} \ No newline at end of file diff --git a/inst/config/charts/functions/tplyr_shift_chart.R b/inst/config/charts/functions/tplyr_shift_chart.R deleted file mode 100644 index 4df3f605..00000000 --- a/inst/config/charts/functions/tplyr_shift_chart.R +++ /dev/null @@ -1,20 +0,0 @@ -tplyr_shift_chart<-function(data,settings){ - - adlb<-data$labs - adlb$ANRIND <- factor(adlb$ANRIND, levels=c("L", "N", "H")) - adlb$BNRIND <- factor(adlb$BNRIND, levels=c("L", "N", "H")) - # Create the table object - t <- tplyr_table(adlb, TRTA, where=PARAMCD == "ALP") %>% - # Add the shift layer, which takes two variables that will be the - # row and column variable you want for presentation - # Additionally note here that we're using two by variables to group by - # parameter and visit (though we've filtered to the CK parameter) - add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) - ) %>% - build() %>% - kable() %>% - kable_styling() %>% - scroll_box(width = "100%", height = "500px") - return(t) -} \ No newline at end of file diff --git a/inst/config/charts/hepexplorer.yaml b/inst/config/charts/hepexplorer.yaml deleted file mode 100644 index 6b25aa07..00000000 --- a/inst/config/charts/hepexplorer.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Hepatic Safety Explorer -type: htmlwidget -domain: labs -package: safetyCharts -workflow: - widget: hepexplorer diff --git a/inst/config/charts/labdist.yaml b/inst/config/charts/labdist.yaml deleted file mode 100644 index acb84928..00000000 --- a/inst/config/charts/labdist.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Labs Distribution (custom shiny module) -type: module -domain: labs -workflow: - ui: labdist_ui - server: labdist_server diff --git a/inst/config/charts/safetyHistogram.yaml b/inst/config/charts/safetyHistogram.yaml deleted file mode 100644 index b1b8c580..00000000 --- a/inst/config/charts/safetyHistogram.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Histogram -type: htmlwidget -domain: labs -package: safetyCharts -workflow: - widget: safetyHistogram diff --git a/inst/config/charts/safetyOutlierExplorer.yaml b/inst/config/charts/safetyOutlierExplorer.yaml deleted file mode 100644 index c747a7dd..00000000 --- a/inst/config/charts/safetyOutlierExplorer.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Outlier Explorer -type: htmlwidget -domain: labs -package: safetyCharts -workflow: - widget: safetyOutlierExplorer diff --git a/inst/config/charts/safetyResultsOverTime.yaml b/inst/config/charts/safetyResultsOverTime.yaml deleted file mode 100644 index 4c34b6ce..00000000 --- a/inst/config/charts/safetyResultsOverTime.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Results Over Time -type: htmlwidget -domain: labs -package: safetyCharts -workflow: - widget: safetyResultsOverTime diff --git a/inst/config/charts/safetyShiftPlot.yaml b/inst/config/charts/safetyShiftPlot.yaml deleted file mode 100644 index 35f8cd48..00000000 --- a/inst/config/charts/safetyShiftPlot.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Shift Plot -type: htmlwidget -domain: labs -package: safetyCharts -workflow: - widget: safetyShiftPlot diff --git a/inst/config/charts/tendril.yaml b/inst/config/charts/tendril.yaml deleted file mode 100644 index b2d64056..00000000 --- a/inst/config/charts/tendril.yaml +++ /dev/null @@ -1,7 +0,0 @@ -label: Tendril Plot {Tendril} -type: plot -domain: multiple -package: Tendril -workflow: - init: tendril_init - main: tendril_chart diff --git a/inst/config/charts/tplyr_demog.yaml b/inst/config/charts/tplyr_demog.yaml deleted file mode 100644 index 0c81c842..00000000 --- a/inst/config/charts/tplyr_demog.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Demographics Table {Tplyr} + {DT} -type: table -domain: dm -package: Tplyr -workflow: - main: tplyr_demog_chart diff --git a/inst/config/charts/tplyr_shift.yaml b/inst/config/charts/tplyr_shift.yaml deleted file mode 100644 index 0adee362..00000000 --- a/inst/config/charts/tplyr_shift.yaml +++ /dev/null @@ -1,6 +0,0 @@ -label: Shift Table {Tplyr} + {kable} -type: html -domain: multiple -pacakage: Tplyr -workflow: - main: tplyr_shift_chart diff --git a/man/getChartFunctions.Rd b/man/getChartFunctions.Rd deleted file mode 100644 index d485fe59..00000000 --- a/man/getChartFunctions.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/getChartFunctions.R -\name{getChartFunctions} -\alias{getChartFunctions} -\title{Get Chart Functions} -\usage{ -getChartFunctions(chartsList, chartSettingsPaths) -} -\arguments{ -\item{chartsList}{List of charts and thier parameters} - -\item{chartSettingsPath}{path for custom files.} -} -\value{ -an updated chartsList object with initFunction and chartFunction parameters added as appropriate -} -\description{ -Function to get functions associated with charts -} From 8b3fd6f3950a88146134a74449899d588f62f38f Mon Sep 17 00:00:00 2001 From: jwildfire Date: Wed, 11 Nov 2020 09:58:51 -0500 Subject: [PATCH 07/15] resolve shiny/DT namespace conflict. fix #438 --- NAMESPACE | 1 - R/mod_chartsRenderModule.R | 2 -- R/mod_chartsRenderStatic.R | 2 -- 3 files changed, 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5d09a0d9..624c3ab5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,7 +34,6 @@ export(settingsData) export(settingsDataUI) export(settingsMapping) export(settingsMappingUI) -import(DT) import(clisymbols) import(dplyr) import(magrittr) diff --git a/R/mod_chartsRenderModule.R b/R/mod_chartsRenderModule.R index 6e79fe84..57b2f955 100644 --- a/R/mod_chartsRenderModule.R +++ b/R/mod_chartsRenderModule.R @@ -1,8 +1,6 @@ #' @title Charts Module - render module chart UI #' @description Charts Module - sub module for rendering a static chart #' -#' @import DT -#' #' @export chartsRenderModuleUI <- function(id, customModUI){ diff --git a/R/mod_chartsRenderStatic.R b/R/mod_chartsRenderStatic.R index 1b634a8c..2db49718 100644 --- a/R/mod_chartsRenderStatic.R +++ b/R/mod_chartsRenderStatic.R @@ -1,8 +1,6 @@ #' @title Charts Module - render static chart UI #' @description Charts Module - sub module for rendering a static chart #' -#' @import DT -#' #' @export chartsRenderStaticUI <- function(id, type){ From 483df6d54d5428976c7e614ab23f690ac92ad373 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Wed, 11 Nov 2020 14:27:17 -0500 Subject: [PATCH 08/15] add support for markdown and regenerate docs --- DESCRIPTION | 1 + man/aes.Rd | 6 +-- man/app_startup.Rd | 12 ++--- man/chartsRenderModule.Rd | 2 +- man/chartsRenderStatic.Rd | 2 +- man/chartsRenderWidget.Rd | 2 +- man/chartsTab.Rd | 4 +- man/detectStandard.Rd | 2 +- man/dm.Rd | 6 +-- man/labs.Rd | 92 +++++++++++++++++++-------------------- man/makeChartConfig.Rd | 16 +++---- man/meta.Rd | 20 ++++----- man/safetyGraphicsApp.Rd | 2 +- 13 files changed, 84 insertions(+), 83 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ad5fc0d9..c4259a8e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,3 +44,4 @@ Imports: tidyr, shinybusy VignetteBuilder: knitr +Roxygen: list(markdown = TRUE) diff --git a/man/aes.Rd b/man/aes.Rd index 702a48ed..c289dbd6 100644 --- a/man/aes.Rd +++ b/man/aes.Rd @@ -7,9 +7,9 @@ \format{ A data frame with 10288 rows and 46 variables. \describe{ - \item{STUDYID}{Study Identifier} - \item{SUBJID}{Subject Identifier for the Study} - \item{USUBJID}{Unique Subject Identifier} +\item{STUDYID}{Study Identifier} +\item{SUBJID}{Subject Identifier for the Study} +\item{USUBJID}{Unique Subject Identifier} } } \source{ diff --git a/man/app_startup.Rd b/man/app_startup.Rd index dea363c2..eaa056cf 100644 --- a/man/app_startup.Rd +++ b/man/app_startup.Rd @@ -8,12 +8,12 @@ app_startup(domainData, meta, charts, mapping, chartSettingsPaths) } \value{ 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 } +\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 } } } \description{ diff --git a/man/chartsRenderModule.Rd b/man/chartsRenderModule.Rd index 321af142..0c35557b 100644 --- a/man/chartsRenderModule.Rd +++ b/man/chartsRenderModule.Rd @@ -13,7 +13,7 @@ chartsRenderModule(input, output, session, serverFunction, params) \item{session}{Shiny session object} -\item{params}{parameters to be passed to the widget [REACTIVE]} +\item{params}{parameters to be passed to the widget \link{REACTIVE}} \item{chartFunction}{function to generate the chart.} } diff --git a/man/chartsRenderStatic.Rd b/man/chartsRenderStatic.Rd index a876df7b..0222b97e 100644 --- a/man/chartsRenderStatic.Rd +++ b/man/chartsRenderStatic.Rd @@ -15,7 +15,7 @@ chartsRenderStatic(input, output, session, chartFunction, params, type) \item{chartFunction}{function to generate the chart.} -\item{params}{parameters to be passed to the widget [REACTIVE]} +\item{params}{parameters to be passed to the widget \link{REACTIVE}} } \description{ server for the display of the loaded data diff --git a/man/chartsRenderWidget.Rd b/man/chartsRenderWidget.Rd index 149b3fe9..43d21b96 100644 --- a/man/chartsRenderWidget.Rd +++ b/man/chartsRenderWidget.Rd @@ -25,7 +25,7 @@ chartsRenderWidget( \item{package}{package containing the widget. Note that package name is required for htmlwidgets.} -\item{params}{parameters to be passed to the widget [REACTIVE]} +\item{params}{parameters to be passed to the widget \link{REACTIVE}} \item{settingsToJSON}{convert param$settings to json? Default = TRUE} } diff --git a/man/chartsTab.Rd b/man/chartsTab.Rd index b8f1bef0..f63b4993 100644 --- a/man/chartsTab.Rd +++ b/man/chartsTab.Rd @@ -15,9 +15,9 @@ chartsTab(input, output, session, chart, data, mapping) \item{chart}{list containing a safetyGraphics chart object. see custom chart vignette for details.} -\item{data}{named list of current data sets [reactive].} +\item{data}{named list of current data sets \link{reactive}.} -\item{mapping}{tibble capturing the current data mappings [reactive].} +\item{mapping}{tibble capturing the current data mappings \link{reactive}.} } \description{ server for the display of the chart tab diff --git a/man/detectStandard.Rd b/man/detectStandard.Rd index 439314df..6f5fe95f 100644 --- a/man/detectStandard.Rd +++ b/man/detectStandard.Rd @@ -20,7 +20,7 @@ A data frame describing the detected standard for each \code{"text_key"} in the This function attempts to detect the clinical data standard used in a given R data frame. } \details{ -This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and ADaM CDISC() standards for clinical trial data by default. Additional standards can be added by modifying the \code{"meta"} data set included as part of this package. +This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and ADaM CDISC(\url{https://www.cdisc.org/}) standards for clinical trial data by default. Additional standards can be added by modifying the \code{"meta"} data set included as part of this package. } \examples{ detectStandard(data=safetyGraphics::aes) #aes domain evaluated by default diff --git a/man/dm.Rd b/man/dm.Rd index 9f100d05..9f95453d 100644 --- a/man/dm.Rd +++ b/man/dm.Rd @@ -7,9 +7,9 @@ \format{ A data frame with 306 rows and 25 variables. \describe{ - \item{STUDYID}{Study Identifier} - \item{SUBJID}{Subject Identifier for the Study} - \item{USUBJID}{Unique Subject Identifier} +\item{STUDYID}{Study Identifier} +\item{SUBJID}{Subject Identifier for the Study} +\item{USUBJID}{Unique Subject Identifier} } } \source{ diff --git a/man/labs.Rd b/man/labs.Rd index 3e869278..1068f25c 100644 --- a/man/labs.Rd +++ b/man/labs.Rd @@ -7,52 +7,52 @@ \format{ A data frame with 10288 rows and 46 variables. \describe{ - \item{STUDYID}{Study Identifier} - \item{SUBJID}{Subject Identifier for the Study} - \item{USUBJID}{Unique Subject Identifier} - \item{TRTP}{Planned Treatment} - \item{TRTPN}{Planned Treatment (N)} - \item{TRTA}{Actual Treatment} - \item{TRTAN}{Actual Treatment (N)} - \item{TRTSDT}{Date of First Exposure to Treatment} - \item{TRTEDT}{Date of Last Exposure to Treatment} - \item{AGE}{Age} - \item{AGEGR1}{Age Group} - \item{AGEGR1N}{Age Group (N)} - \item{RACE}{Race} - \item{RACEN}{Race (N)} - \item{SEX}{Sex} - \item{COMP24FL}{Completers Flag} - \item{DSRAEFL}{Discontinued due to AE?} - \item{SAFFL}{Safety Population Flag} - \item{AVISIT}{Analysis Visit} - \item{AVISITN}{Analysis Visit (N)} - \item{ADY}{Analysis Relative Day} - \item{ADT}{Analysis Relative Date} - \item{VISIT}{Visit} - \item{VISITNUM}{Visit (N)} - \item{PARAM}{Parameter} - \item{PARAMCD}{Parameter Code} - \item{PARAMN}{Parameter (N)} - \item{PARCAT1}{Parameter Category} - \item{AVAL}{Analysis Value} - \item{BASE}{Baseline Value} - \item{CHG}{Change from Baseline} - \item{A1LO}{Analysis Normal Range Lower Limit} - \item{A1HI}{Analysis Normal Range Upper Limit} - \item{R2A1LO}{Ratio to Low limit of Analysis Range} - \item{R2A1HI}{Ratio to High limit of Analysis Range} - \item{BR2A1LO}{Base Ratio to Analysis Range 1 Lower Lim} - \item{BR2A1HI}{Base Ratio to Analysis Range 1 Upper Lim} - \item{ANL01FL}{Analysis Population Flag} - \item{ALBTRVAL}{Amount Threshold Range} - \item{ANRIND}{Analysis Reference Range Indicator} - \item{BNRIND}{Baseline Reference Range Indicator} - \item{ABLFL}{Baseline Record Flag} - \item{AENTMTFL}{Analysis End Date Flag} - \item{LBSEQ}{Lab Sequence Number } - \item{LBNRIND}{Reference Range Indicator} - \item{LBSTRESN}{Numeric Result/Finding in Std Units} +\item{STUDYID}{Study Identifier} +\item{SUBJID}{Subject Identifier for the Study} +\item{USUBJID}{Unique Subject Identifier} +\item{TRTP}{Planned Treatment} +\item{TRTPN}{Planned Treatment (N)} +\item{TRTA}{Actual Treatment} +\item{TRTAN}{Actual Treatment (N)} +\item{TRTSDT}{Date of First Exposure to Treatment} +\item{TRTEDT}{Date of Last Exposure to Treatment} +\item{AGE}{Age} +\item{AGEGR1}{Age Group} +\item{AGEGR1N}{Age Group (N)} +\item{RACE}{Race} +\item{RACEN}{Race (N)} +\item{SEX}{Sex} +\item{COMP24FL}{Completers Flag} +\item{DSRAEFL}{Discontinued due to AE?} +\item{SAFFL}{Safety Population Flag} +\item{AVISIT}{Analysis Visit} +\item{AVISITN}{Analysis Visit (N)} +\item{ADY}{Analysis Relative Day} +\item{ADT}{Analysis Relative Date} +\item{VISIT}{Visit} +\item{VISITNUM}{Visit (N)} +\item{PARAM}{Parameter} +\item{PARAMCD}{Parameter Code} +\item{PARAMN}{Parameter (N)} +\item{PARCAT1}{Parameter Category} +\item{AVAL}{Analysis Value} +\item{BASE}{Baseline Value} +\item{CHG}{Change from Baseline} +\item{A1LO}{Analysis Normal Range Lower Limit} +\item{A1HI}{Analysis Normal Range Upper Limit} +\item{R2A1LO}{Ratio to Low limit of Analysis Range} +\item{R2A1HI}{Ratio to High limit of Analysis Range} +\item{BR2A1LO}{Base Ratio to Analysis Range 1 Lower Lim} +\item{BR2A1HI}{Base Ratio to Analysis Range 1 Upper Lim} +\item{ANL01FL}{Analysis Population Flag} +\item{ALBTRVAL}{Amount Threshold Range} +\item{ANRIND}{Analysis Reference Range Indicator} +\item{BNRIND}{Baseline Reference Range Indicator} +\item{ABLFL}{Baseline Record Flag} +\item{AENTMTFL}{Analysis End Date Flag} +\item{LBSEQ}{Lab Sequence Number } +\item{LBNRIND}{Reference Range Indicator} +\item{LBSTRESN}{Numeric Result/Finding in Std Units} } } \source{ diff --git a/man/makeChartConfig.Rd b/man/makeChartConfig.Rd index 814a9e95..e740aa9a 100644 --- a/man/makeChartConfig.Rd +++ b/man/makeChartConfig.Rd @@ -14,14 +14,14 @@ makeChartConfig(dirs, sourceFiles = TRUE) \value{ 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. } +\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 \code{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. } } } \description{ diff --git a/man/meta.Rd b/man/meta.Rd index 7d42e6bd..801bfebe 100644 --- a/man/meta.Rd +++ b/man/meta.Rd @@ -7,16 +7,16 @@ \format{ A data frame with 31 rows and 7 columns \describe{ - \item{domain}{Data domain} - \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping} - \item{col_key}{Key for the column mapping} - \item{field_key}{Key for the field mapping (if any)} - \item{type}{type of mapping - "field" or "column"} - \item{label}{Label} - \item{description}{Description} - \item{multiple}{Mapping supports multiple columns/fields } - \item{standard_adam}{Default values for the ADaM data standard} - \item{standard_sdtm}{Default values for the SDTM data standard} +\item{domain}{Data domain} +\item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping} +\item{col_key}{Key for the column mapping} +\item{field_key}{Key for the field mapping (if any)} +\item{type}{type of mapping - "field" or "column"} +\item{label}{Label} +\item{description}{Description} +\item{multiple}{Mapping supports multiple columns/fields } +\item{standard_adam}{Default values for the ADaM data standard} +\item{standard_sdtm}{Default values for the SDTM data standard} } } \source{ diff --git a/man/safetyGraphicsApp.Rd b/man/safetyGraphicsApp.Rd index c16add92..d54c38e3 100644 --- a/man/safetyGraphicsApp.Rd +++ b/man/safetyGraphicsApp.Rd @@ -22,7 +22,7 @@ safetyGraphicsApp( \item{mapping}{data.frame specifying the initial values for each data mapping. If no mapping is provided, the app will attempt to generate one via \code{detectStandard()}} -\item{chartSettingsPaths}{path(s) where customization functions are saved relative to your working directory. All charts can have itialization (e.g. [chart]Init.R) and static charts can have charting functions (e.g. [chart]Chart.R). All R files in this folder are sourced and files with the correct naming convention are linked to the chart. See the Custom Charts vignette for more details.} +\item{chartSettingsPaths}{path(s) where customization functions are saved relative to your working directory. All charts can have itialization (e.g. \link{chart}Init.R) and static charts can have charting functions (e.g. \link{chart}Chart.R). All R files in this folder are sourced and files with the correct naming convention are linked to the chart. See the Custom Charts vignette for more details.} } \description{ Run the interactive safety graphics app From c1f5d2e243e5837bd886e1686a3c4fc90270b92b Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 12 Nov 2020 16:04:31 -0500 Subject: [PATCH 09/15] improved function matching --- R/makeChartConfig.R | 53 ++++++++++++++++++++++++++++-------------- man/makeChartConfig.Rd | 2 +- 2 files changed, 37 insertions(+), 18 deletions(-) diff --git a/R/makeChartConfig.R b/R/makeChartConfig.R index c3b9be5d..d0ad9a3e 100644 --- a/R/makeChartConfig.R +++ b/R/makeChartConfig.R @@ -19,7 +19,7 @@ #' \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. } +#' \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 @@ -60,24 +60,43 @@ makeChartConfig <- function(dirs, sourceFiles=TRUE){ message("Found ", length(yaml_files), " config files: ",paste(names(charts),collapse=", ")) # Bind workflow functions to chart object - all_functions <- lsf.str(pos=1) - charts <- lapply(charts, function(chart){ - function_names <- all_functions[grep(chart$name,all_functions)] - chart$functions <- lapply(function_names, match.fun) - names(chart$functions) <- function_names + all_functions <- as.character(lsf.str(".GlobalEnv")) + message("Global Functions: ",all_functions) + charts <- lapply(charts, + function(chart){ + message("------------------",chart$name,"------------------------") + if(hasName(chart, "package")){ + message("has a package") + package_functions <- as.character(lsf.str(paste0("package:",chart$package))) + all_functions<-c(all_functions,package_functions) + message("Package :",chart$package, " has functions ",package_functions) + } - # check that functions exist for specified workflows - workflow_found <- sum(unlist(chart$workflow) %in% 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) - } + #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)) ){ + message("looking for function matches") + matches<-all_functions[str_detect(query, all_functions)] + chart_function_names <- c(chart_function_names, matches) + } - return(chart) - }) + message("Functions Found: ",chart_function_names) + 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) } diff --git a/man/makeChartConfig.Rd b/man/makeChartConfig.Rd index e740aa9a..89bed087 100644 --- a/man/makeChartConfig.Rd +++ b/man/makeChartConfig.Rd @@ -21,7 +21,7 @@ returns a named list of charts derived from YAML files. Each element of the list \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. } +\item{"functions"}{ List of functions for use in chart renderering. These functions must be located in the global environment or \code{package} field of the YAML config. Function names must include either the \code{name} or \code{workflow} fields of the YAML config. } } } \description{ From e67b894f63b5f35dba287d9115a3ad602e33f25a Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 12 Nov 2020 16:05:28 -0500 Subject: [PATCH 10/15] remove debug messages --- R/makeChartConfig.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/makeChartConfig.R b/R/makeChartConfig.R index d0ad9a3e..d5c118d3 100644 --- a/R/makeChartConfig.R +++ b/R/makeChartConfig.R @@ -64,23 +64,18 @@ makeChartConfig <- function(dirs, sourceFiles=TRUE){ message("Global Functions: ",all_functions) charts <- lapply(charts, function(chart){ - message("------------------",chart$name,"------------------------") if(hasName(chart, "package")){ - message("has a package") package_functions <- as.character(lsf.str(paste0("package:",chart$package))) all_functions<-c(all_functions,package_functions) - message("Package :",chart$package, " has 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)) ){ - message("looking for function matches") matches<-all_functions[str_detect(query, all_functions)] chart_function_names <- c(chart_function_names, matches) } - message("Functions Found: ",chart_function_names) chart$functions <- lapply(chart_function_names, match.fun) names(chart$functions) <- chart_function_names From 18812977765af7c9fedc1e724fd4d9529eb53019 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Mon, 23 Nov 2020 14:09:08 -0500 Subject: [PATCH 11/15] Update R/app_ui.R Co-authored-by: Xiao Ni --- R/app_ui.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/app_ui.R b/R/app_ui.R index d26bc5e5..485c3977 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -9,7 +9,7 @@ app_ui <- function(meta, domainData, mapping, standards){ #read css from pacakge - app_css <- HTML(readLines( paste(.libPaths(),'safetygraphics','safetyGraphics_app', 'www','index.css', sep="/"))) + app_css <- HTML(readLines( paste(.libPaths(),'safetyGraphics','safetyGraphics_app', 'www','index.css', sep="/"))) #script to append population badge nav bar participant_badge<-tags$script( From 91cd97fe9652fe679d00de532d5123b2e8108cde Mon Sep 17 00:00:00 2001 From: jwildfire Date: Mon, 23 Nov 2020 20:03:02 -0500 Subject: [PATCH 12/15] fix logic for custom charts dir --- R/app_startup.R | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/R/app_startup.R b/R/app_startup.R index 4c453a72..51a6ef9c 100644 --- a/R/app_startup.R +++ b/R/app_startup.R @@ -11,16 +11,14 @@ #' \item{"standards"}{ List of domain level data standards } #' } #' -app_startup<-function(domainData, meta, charts, mapping, chartSettingsPaths){ - +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(chartSettingsPaths) - }else{ charts <- makeChartConfig() + }else{ + charts <- makeChartConfig(chartSettingsPaths) } - } # get the data standards From f8b74b5ee66a58d91b3163b4aaa1386eb74c0d53 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Tue, 24 Nov 2020 11:09:07 -0500 Subject: [PATCH 13/15] resolve data preview bug. fix #442 --- R/mod_settingsData.R | 10 +++------- tests/testthat/module_examples/settingsData/app.R | 13 +++++-------- 2 files changed, 8 insertions(+), 15 deletions(-) diff --git a/R/mod_settingsData.R b/R/mod_settingsData.R index 57eb249f..ae55830c 100644 --- a/R/mod_settingsData.R +++ b/R/mod_settingsData.R @@ -32,7 +32,8 @@ settingsDataUI <- function(id, domains){ settingsData <- function(input, output, session, domains, filtered){ ns <- session$ns - for(domain in names(domains)){ + lapply(names(domains), function(domain){ + output[[domain]] <- renderDT({ DT::datatable( domains[[domain]], @@ -41,10 +42,5 @@ settingsData <- function(input, output, session, domains, filtered){ class="compact" ) }) - } - - #NOTE: There is no real need for this to be reactive right now, but in this is just a bit of future proofing for when data is more dynamic. - - return(reactive({domains})) - + }) } \ No newline at end of file diff --git a/tests/testthat/module_examples/settingsData/app.R b/tests/testthat/module_examples/settingsData/app.R index a9b9c0f2..e47771fe 100644 --- a/tests/testthat/module_examples/settingsData/app.R +++ b/tests/testthat/module_examples/settingsData/app.R @@ -1,24 +1,21 @@ library(shiny) library(safetyGraphics) - -domains <- list(labs=labs, aes=aes) reactlogReset() ui <- tagList( - fluidPage( h1("Example 1: Labs Only"), - settingsDataUI("ex1", domains), - # h2("Example 2: Labs+AES"), - # settingsDataUI("ex2"), + settingsDataUI("ex1", list(labs=labs)), + h2("Example 2: Labs+AES"), + settingsDataUI("ex2", list(labs=labs,aes=aes)), # h2("Example 3: Labs+AEs+Extras"), # settingsDataUI("ex3") ) ) server <- function(input,output,session){ - callModule(settingsData, "ex1", domains = domains) - # callModule(settingsData, "ex2", allData = rbind(lab_summary,ae_summary)) + callModule(settingsData, "ex1", domains = list(labs=labs)) + callModule(settingsData, "ex2", domains = list(labs=labs,aes=aes)) # callModule(settingsData, "ex3", allData = rbind(lab_summary,ae_summary,extra) ) } From 11f35dc3022b5fcc5975f3ab77d7a42b0f02b23d Mon Sep 17 00:00:00 2001 From: jwildfire Date: Tue, 24 Nov 2020 11:47:18 -0500 Subject: [PATCH 14/15] use tabset for data previews --- R/app_ui.R | 2 +- R/mod_settingsData.R | 32 ++++++++++++------- inst/safetyGraphics_app/www/index.css | 5 ++- .../module_examples/settingsData/app.R | 4 +-- 4 files changed, 27 insertions(+), 16 deletions(-) diff --git a/R/app_ui.R b/R/app_ui.R index 485c3977..67d7c768 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -35,7 +35,7 @@ app_ui <- function(meta, domainData, mapping, standards){ id="safetyGraphicsApp", tabPanel("Home", icon=icon("home"),homeTabUI("home")), navbarMenu('Data',icon=icon("database"), - tabPanel("Preview", icon=icon("table"), settingsDataUI("dataSettings", domains=domainData)), + 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")) ), diff --git a/R/mod_settingsData.R b/R/mod_settingsData.R index ae55830c..c5cbaffa 100644 --- a/R/mod_settingsData.R +++ b/R/mod_settingsData.R @@ -7,17 +7,12 @@ #' @export -settingsDataUI <- function(id, domains){ +settingsDataUI <- function(id){ ns <- NS(id) - names(domains) %>% map(function(domain){ - return( - list( - h1(paste0("Domain: ", domain)), - DTOutput(ns(domain)) - ) - ) - - }) + div( + h2("Data Domain Previews"), + uiOutput(ns('previews')) + ) } #' @title Settings Module - data details - server @@ -27,13 +22,26 @@ settingsDataUI <- function(id, domains){ #' @param output Shiny output object #' @param session Shiny session object #' @param domains named list of the data.frames for each domain -#' #' +#' #' @export settingsData <- function(input, output, session, domains, filtered){ ns <- session$ns + #Set up tabs + output$previews <- renderUI({ + tabs <- lapply(names(domains),function(domain){ + tabPanel(domain, + div( + #h3(paste0("Note: Showing filtered data. X of X rows displayed for the X selected participants.")), + DTOutput(ns(domain)) + ) + ) + }) + do.call(tabsetPanel, tabs) + }) + + # Draw the tables lapply(names(domains), function(domain){ - output[[domain]] <- renderDT({ DT::datatable( domains[[domain]], diff --git a/inst/safetyGraphics_app/www/index.css b/inst/safetyGraphics_app/www/index.css index 17769bf3..1971b618 100644 --- a/inst/safetyGraphics_app/www/index.css +++ b/inst/safetyGraphics_app/www/index.css @@ -44,7 +44,6 @@ border-color:green; } - table.dataTable tr > td:last-of-type, table.dataTable tr > th:last-of-type { border-left:2px solid black; background:#d0d1e6; @@ -54,3 +53,7 @@ table.dataTable tr > td:last-of-type, table.dataTable tr > th:last-of-type { float:right; margin-top:1em; } + +#dataSettings-previews .nav-tabs{ + margin-bottom: 1em; +} \ No newline at end of file diff --git a/tests/testthat/module_examples/settingsData/app.R b/tests/testthat/module_examples/settingsData/app.R index e47771fe..86fb772d 100644 --- a/tests/testthat/module_examples/settingsData/app.R +++ b/tests/testthat/module_examples/settingsData/app.R @@ -5,9 +5,9 @@ reactlogReset() ui <- tagList( fluidPage( h1("Example 1: Labs Only"), - settingsDataUI("ex1", list(labs=labs)), + settingsDataUI("ex1"), h2("Example 2: Labs+AES"), - settingsDataUI("ex2", list(labs=labs,aes=aes)), + settingsDataUI("ex2"), # h2("Example 3: Labs+AEs+Extras"), # settingsDataUI("ex3") ) From 6b6e007a8513d97d771b49c571126503a764cf1a Mon Sep 17 00:00:00 2001 From: rescalan Date: Wed, 2 Dec 2020 08:16:07 -0800 Subject: [PATCH 15/15] Update imports and documentation --- DESCRIPTION | 1 + NAMESPACE | 1 + man/chartsRenderStatic.Rd | 2 +- man/chartsRenderStaticUI.Rd | 2 +- man/chartsTab.Rd | 6 +++--- man/generateMappingList.Rd | 4 ++-- 6 files changed, 9 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ad5fc0d9..8abb3979 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,6 +27,7 @@ Suggests: plotly Imports: dplyr, + esquisse, htmlwidgets, purrr, stringr, diff --git a/NAMESPACE b/NAMESPACE index ef59e71f..6838b273 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,6 +31,7 @@ export(settingsData) export(settingsDataUI) export(settingsMapping) export(settingsMappingUI) +import(DT) import(dplyr) import(shiny) importFrom(DT,DTOutput) diff --git a/man/chartsRenderStatic.Rd b/man/chartsRenderStatic.Rd index 2c15ffc2..a876df7b 100644 --- a/man/chartsRenderStatic.Rd +++ b/man/chartsRenderStatic.Rd @@ -4,7 +4,7 @@ \alias{chartsRenderStatic} \title{Charts Module - render static chart server} \usage{ -chartsRenderStatic(input, output, session, chartFunction, params) +chartsRenderStatic(input, output, session, chartFunction, params, type) } \arguments{ \item{input}{Shiny input object} diff --git a/man/chartsRenderStaticUI.Rd b/man/chartsRenderStaticUI.Rd index d35bc513..3f383eef 100644 --- a/man/chartsRenderStaticUI.Rd +++ b/man/chartsRenderStaticUI.Rd @@ -4,7 +4,7 @@ \alias{chartsRenderStaticUI} \title{Charts Module - render static chart UI} \usage{ -chartsRenderStaticUI(id) +chartsRenderStaticUI(id, type) } \description{ Charts Module - sub module for rendering a static chart diff --git a/man/chartsTab.Rd b/man/chartsTab.Rd index 7e266ea9..455f628e 100644 --- a/man/chartsTab.Rd +++ b/man/chartsTab.Rd @@ -27,7 +27,7 @@ chartsTab( \item{chart}{chart name. Should generally match the name of the function/widget/module to be intiated. See specific renderer modules for more details.} -\item{type}{type of chart. Must be 'htmlwidget', 'module', 'static' or 'plotly'. See ?mod_chartRenderer{{type}} for more details about each chart type} +\item{type}{type of chart. Must be 'htmlwidget', 'module', 'plot', 'table', 'html' or 'plotly'. See ?mod_chartRenderer* functions for more details about each chart type.} \item{package}{package containing the widget.} @@ -35,11 +35,11 @@ chartsTab( \item{initFunction}{function called before the chart is generated. The function should take `data` and `settings` as inputs and return `params` which should be a list which is then provided to the widget. If domain is specified, only domain-level information is passed to the init function, otherwise named lists containing information for all domains is provided. The mapping is parsed as a list using `generateMappingList()` before being passed to the init function. By default, init returns an unmodified list of data and settings - possibly subset to the specified domain (e.g. list(data=data, settings=settings))} -\item{domain}{data domain. Should correspond to a domain in `meta` or be set to "multiple" to named lists for data and mappings containing domains.} +\item{domain}{data domain. Should correspond to a domain in `meta` or be set to "multiple", in which case, named lists for `data` and `mappings` containing all domain data are used.} \item{data}{named list of current data sets [reactive].} -\item{mapping}{named list of the current data mappings [reactive].} +\item{mapping}{tibble capturing the current data mappings [reactive].} } \description{ server for the display of the chart tab diff --git a/man/generateMappingList.Rd b/man/generateMappingList.Rd index 58d9e4c1..604406a6 100644 --- a/man/generateMappingList.Rd +++ b/man/generateMappingList.Rd @@ -4,10 +4,10 @@ \alias{generateMappingList} \title{Convert mapping data.frame to a list} \usage{ -generateMappingList(settingsDF, domain) +generateMappingList(settingsDF, domain, pull = FALSE) } \arguments{ -\item{domain}{mapping domain to return (returns all domains as a named list by default)} +\item{domain}{call pull() the value for each parameter - needed for testing only. default: FALSE} \item{mappingDF}{data frame containing current mapping} }