R/prepareChart.R

In safetyGraphics: Interactive Graphics for Monitoring Clinical Trial Safety

#' Prepare a chart object for safetyGraphics
#' 
#' Sets default values and binds needed functions to a chart object based on chart type. 
#' 
#' @param chart chart object like the one generated by makeChartConfig().
#'
#' @import purrr
#' @importFrom stringr str_replace_all
#' 
#' @return returns the chart object with a new functions object added. 
#' 
#' @export

prepareChart <- function(chart){
    #### Check required parameters ####

    # If no name is provided, use a placeholder and throw a message
    if(!hasName(chart,"name")) chart$name <- "safetyGraphicsChart"
    
    # Remove whitespace (if any) from chart$name
    chart$name<-stringr::str_replace_all(chart$name, "[[:space:]]", "")

    # Chart should be exportable by default
    if(!hasName(chart,"export")) chart$export <- TRUE

    # Put chart at the end order is provided.
    chart$order <- ifelse(
        is.null(chart$order),
        999999,
        chart$order
    ) %>% as.numeric

    # check for valid environment 
    chart$envValid <- ifelse(
        is.null(chart$env),
        FALSE,
        tolower(chart$env)=="safetygraphics"
    )

    #### Bind Workflow functions to chart object ####
    if(!hasName(chart,"functions")){

        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(
                    expr, 
                    rownames = FALSE,
                    options = list(
                        pageLength = 20,
                        ordering = FALSE,
                        searching = FALSE
                    )
                )
            }
            chart$functions$main<-chart$functions[[chart$workflow$main]]
        }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]]
        }
        
        # Print a message summarizing 
        message<-paste0(chart$name,": Loaded ", length(chart$functions)," functions: ", paste(names(chart$functions),collapse=","))
        message(message)
    }
    return(chart)
}