-
Notifications
You must be signed in to change notification settings - Fork 25
Add Chart Code export #594
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Merged
Changes from all commits
Commits
Show all changes
11 commits
Select commit
Hold shift + click to select a range
009ff86
simplify chart workflow to prepare for #518
jwildfire 59b2d59
simplified chart UI renderering
jwildfire f3081bf
continue refactor of charting workflow
jwildfire 6551eac
fix modules in new workflow
jwildfire 4eeb8e5
simplify export code
jwildfire 989ffa7
refactor export workflow. #594
jwildfire e2ace34
Implement standard export script. fix #594
jwildfire 6ebd2cb
Merge branch 'dev' into chartCode
jwildfire 573163e
tweak report title. remove background tab.
jwildfire 0f7d5b6
update tests and clear checks
jwildfire fb57a93
drop charts with negative order in app
jwildfire File filter
Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,92 @@ | ||
| #' Make Chart Config Functions | ||
| #' | ||
| #' Binds needed functions to a chart object based on chart type. | ||
| #' | ||
| #' @param chart chart object like the one generated by makeChartConfig(). | ||
| #' | ||
| #' @import purrr | ||
| #' | ||
| #' @return returns the chart object with a new functions object added. | ||
| #' | ||
| #' @export | ||
|
|
||
| makeChartConfigFunctions <- function(chart){ | ||
| all_functions <- as.character(utils::lsf.str(".GlobalEnv")) | ||
|
|
||
| if(utils::hasName(chart, "package")){ | ||
| package_functions <- as.character(utils::lsf.str(paste0("package:",chart$package))) | ||
| all_functions<-c(all_functions,package_functions) | ||
| } | ||
|
|
||
| #search functions that include the charts name or the workflow function names | ||
| chart_function_names <- c() | ||
| for(query in c(chart$name, unlist(chart$workflow)) ){ | ||
| matches<-all_functions[str_detect(query, all_functions)] | ||
| chart_function_names <- c(chart_function_names, matches) | ||
| } | ||
|
|
||
| chart$functions <- lapply(chart_function_names, match.fun) | ||
| names(chart$functions) <- chart_function_names | ||
|
|
||
| # Define UI function unless one is provided | ||
| if(chart$type=="plot"){ | ||
| chart$functions$ui<-plotOutput | ||
| chart$functions$server<-renderPlot | ||
| chart$functions$main<-chart$functions[[chart$workflow$main]] | ||
| }else if(chart$type=="html"){ | ||
| chart$functions$ui<-htmlOutput | ||
| chart$functions$server<-renderText | ||
| chart$functions$main<-chart$functions[[chart$workflow$main]] | ||
| }else if(chart$type=="table"){ | ||
| chart$functions$ui<-DT::dataTableOutput | ||
| chart$functions$server<-function(expr ){ | ||
| DT::renderDataTable( | ||
| rownames = FALSE, | ||
| options = list( | ||
| pageLength = 20, | ||
| ordering = FALSE, | ||
| searching = FALSE | ||
| ) | ||
| ) | ||
| } | ||
| chart$functions$main<-chart$functions[[chart$workflow$main]] | ||
| #} | ||
| # }else if(chart$type=="rtf"){ | ||
| # chart$functions$ui<-div( | ||
| # downloadButton(ns("downloadRTF"), "Download RTF"), | ||
| # DT::dataTableOutput(ns("chart-wrap")) | ||
| # ) | ||
| }else if(chart$type=="htmlwidget"){ | ||
| # Helper functions for html widget render | ||
| widgetOutput <- function(outputId, width = "100%", height = "400px") { | ||
| htmlwidgets::shinyWidgetOutput(outputId, chart$workflow$widget, width, height, package=chart$package) | ||
| } | ||
|
|
||
| renderWidget <- function(expr, env = parent.frame(), quoted = FALSE) { | ||
| if (!quoted) { expr <- substitute(expr) } # force quoted | ||
| htmlwidgets::shinyRenderWidget(expr, widgetOutput, env, quoted = TRUE) | ||
| } | ||
|
|
||
| chart$functions$ui<-widgetOutput | ||
| chart$functions$server<-renderWidget | ||
| chart$functions$main<-htmlwidgets::createWidget | ||
| chart$workflow$main <- "htmlwidgets::createWidget" | ||
|
|
||
| }else if (chart$type=="module"){ | ||
| chart$functions$ui<-chart$functions[[chart$workflow$ui]] | ||
| chart$functions$server<-callModule | ||
| chart$functions$main <- chart$functions[[chart$workflow$server]] | ||
| } | ||
|
|
||
| # 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("+ ",message) | ||
| }else{ | ||
| message("x ", message) | ||
| } | ||
|
|
||
| return(chart) | ||
| } |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,112 @@ | ||
| #' Make Chart Config Functions | ||
| #' | ||
| #' Binds needed functions to a chart object based on chart type. | ||
| #' | ||
| #' @param chart chart object like the one generated by makeChartConfig(). | ||
| #' @param mapping mapping object like the one generatedf by makeMapping(). | ||
| #' | ||
| #' @import purrr | ||
| #' @importFrom utils hasName | ||
| #' | ||
| #' @return returns the chart object with an export script added. | ||
| #' | ||
| #' @export | ||
|
|
||
| makeChartExport <- function(chart, mapping){ | ||
| # Load packages | ||
| packageScript<-c( | ||
| "library(yaml)", | ||
| paste0("library(",chart$package,")"), | ||
| "", | ||
| paste0("### Reproducible Code for ",chart$label, " (",chart$type,") ###"), | ||
| "" | ||
| ) | ||
|
|
||
| # TODO: src custom functions identified in workflow. Probably not a big deal for v2.0 | ||
|
|
||
| # Load data | ||
| demodata <- list( | ||
| labs="safetyData::adam_adlbc", | ||
| aes="safetyData::adam_adae", | ||
| dm="safetyData::adam_adsl" | ||
| ) | ||
| if(length(chart$domain)==1){ | ||
| dataLoad <- paste0("data<-",demodata[[chart$domain]]) | ||
| }else{ | ||
|
|
||
| dataLoad<-c( | ||
| "data <- list(", | ||
| chart$domain %>% map_chr(~paste0(" ",.x, "=",demodata[[.x]])) %>% paste(collapse=",\n"), | ||
| ")" | ||
| ) | ||
| } | ||
|
|
||
| dataScript <- c( | ||
| "#Load Data", | ||
| "#NOTE: Correct data names should be updated by user", | ||
| dataLoad, | ||
| "" | ||
| ) | ||
|
|
||
| # Load mapping | ||
| mappingScript<-c( | ||
| "#Load mapping", | ||
| "#NOTE: mapping can also be saved as a .yaml and used for multiple charts.", | ||
| paste0('mapping_yaml<-"',as.yaml(mapping),'"'), | ||
| "mapping <- read_yaml(text=mapping_yaml)", | ||
| "" | ||
| ) | ||
|
|
||
| # make parameters | ||
| if(utils::hasName(chart$workflow, "init")){ | ||
| paramScript <- c( | ||
| "# Create parameter list using custom initialization function", | ||
| paste0("params<-",chart$workflow$init,"(data,mapping)"), | ||
| "" | ||
| ) | ||
| }else{ | ||
| paramScript<-c( | ||
| "# Create Parameter list", | ||
| "params<-list(data=data, settings=mapping)", | ||
| "" | ||
| ) | ||
| } | ||
|
|
||
| # format for widget (if needed) | ||
| if(chart$type =="htmlwidget"){ | ||
| paramScript <- c( | ||
| paramScript, | ||
| "widgetParams <- list(", | ||
| paste0(" name='",chart$workflow$widget,"',"), | ||
| paste0(" package='",chart$package,"',"), | ||
| " sizingPolicy = htmlwidgets::sizingPolicy(viewer.suppress=TRUE, browser.external = TRUE),", | ||
| " x=list()", | ||
| ")", | ||
| "widgetParams$x$data <- params$data", | ||
| "widgetParams$x$rSettings <- params$settings", | ||
| "widgetParams$x$settings <- jsonlite::toJSON(", | ||
| " params$settings,", | ||
| " auto_unbox = TRUE,", | ||
| ' null = "null"', | ||
| ")", | ||
| "params <- widgetParams", | ||
| "" | ||
| ) | ||
| } | ||
|
|
||
| # Initialize the chart | ||
| initScript<-c( | ||
| "# Run the chart", | ||
| paste0("do.call(",chart$workflow$main,",params)") | ||
| ) | ||
|
|
||
| fullScript<- c( | ||
| packageScript, | ||
| dataScript, | ||
| mappingScript, | ||
| paramScript, | ||
| initScript | ||
| ) | ||
|
|
||
| return(fullScript) | ||
| } |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,48 @@ | ||
| #' @title Make Chart Parameters | ||
| #' @description Updates raw data and mapping for use with a specific chart | ||
| #' | ||
| #' @param data list of domain-level data | ||
| #' @param chart list containing chart specifications | ||
| #' @param mapping data frame with current mapping | ||
| #' | ||
| #' @export | ||
|
|
||
| makeChartParams <- function(data, chart, mapping){ | ||
| settingsList <- safetyGraphics::generateMappingList(mapping, domain=chart$domain) | ||
|
|
||
| #subset data to specific domain (if specified) | ||
| if(length(chart$domain)>1){ | ||
| domainData <- data | ||
| }else{ | ||
| domainData<- data[[chart$domain]] | ||
| } | ||
| params <- list(data=domainData, settings=settingsList) | ||
|
|
||
| #customize initial the parameters if desired - otherwise pass through domain level data and mapping) | ||
| if(utils::hasName(chart,"functions")){ | ||
| if(utils::hasName(chart$workflow,"init")){ | ||
| message(chart$name, " has an init.") | ||
| params <- do.call(chart$functions[[chart$workflow$init]], params) | ||
| } | ||
| } | ||
|
|
||
| # format parameters for htmlwidget | ||
| if(chart$type == "htmlwidget"){ | ||
| widgetParams <- list( | ||
| name=chart$workflow$widget, | ||
| package=chart$package, | ||
| sizingPolicy = htmlwidgets::sizingPolicy(viewer.suppress=TRUE, browser.external = TRUE), | ||
| x=list() | ||
| ) | ||
| widgetParams$x$data <- params$data | ||
| widgetParams$x$rSettings <- params$settings | ||
| widgetParams$x$settings <- jsonlite::toJSON( | ||
| params$settings, | ||
| auto_unbox = TRUE, | ||
| null = "null", | ||
| ) | ||
| params <- widgetParams | ||
| } | ||
|
|
||
| return(params) | ||
| } |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
This fixes the bug noted in #595