R/makeChartExport.R

In safetyGraphics: Interactive Graphics for Monitoring Clinical Trial Safety

#' Make Chart Export 
#' 
#' Creates R code that allows chart to be exported
#' 
#' @param chart chart object like the one generated by makeChartConfig().
#' @param mapping mapping object like the one generated by makeMapping().
#' 
#' @import purrr
#' @importFrom yaml as.yaml
#' @importFrom utils hasName
#' 
#' @return returns a character vector that can be saved as R code. 
#' 
#' @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
    if(chart$type=="module"){
        initScript<-c(
            "# Run the chart",
            "library(shiny)",
            "app <- shinyApp(",
            paste0("    ui =",chart$workflow$ui,"('chart-wrap'),"),
            "    server = function(input,output,session){",
            "        callModule(",
            paste0("            ",chart$workflow$server,","),
            "            'chart-wrap',",
            "            reactive({params})",
            "        )",
            "    }",
            ")",
            "runApp(app, launch.browser = TRUE)"
        )
    }else{
        initScript<-c(
            "# Run the chart",
            paste0("do.call(",chart$workflow$main,",params)")
        )
    }




    fullScript<- c(
        packageScript, 
        dataScript,
        mappingScript,
        paramScript, 
        initScript
    )

    return(fullScript)
}