add framework for rendering widgets

DESCRIPTION

@@ -20,19 +20,22 @@ Roxygen: list(markdown = TRUE)
 Imports:
     dplyr,
     DT,
-    Tplyr,
+    forcats,
     ggplot2,
+    htmlwidgets,
+    huxtable,
+    jsonlite, 
+    kableExtra,
+    knitr,
+    pharmaRTF,
     plotly,
+    purrr,
+    RColorBrewer,
     rlang,
     shiny,
-    knitr,
-    RColorBrewer,
     stringr,
-    forcats,
     Tendril,
-    kableExtra,
-    huxtable, 
-    pharmaRTF
+    Tplyr
 Suggests:
     testthat,
     shinytest,

NAMESPACE

@@ -6,13 +6,15 @@ export(QT_Outlier_Explorer)
 export(demogRTF_server)
 export(demogRTF_table)
 export(demogRTF_ui)
+export(hepExplorer)
 export(init_aeExplorer)
 export(init_paneledOutlierExplorer)
 export(init_safetyOutlierExplorer)
 export(init_safetyResultsOverTime)
 export(init_safetyShiftPlot)
 export(lab_distribution_server)
 export(lab_distribution_ui)
+export(render_widget)
 export(safetyOutlierExplorer_server)
 export(safetyOutlierExplorer_ui)
 export(safety_outlier_explorer)
@@ -22,6 +24,7 @@ import(Tendril)
 import(Tplyr)
 import(dplyr)
 import(ggplot2)
+import(htmlwidgets)
 import(rlang)
 import(shiny)
 importFrom(huxtable,as_hux)
@@ -32,6 +35,7 @@ importFrom(huxtable,set_col_width)
 importFrom(huxtable,set_escape_contents)
 importFrom(huxtable,set_valign)
 importFrom(huxtable,set_width)
+importFrom(jsonlite,toJSON)
 importFrom(pharmaRTF,add_footnotes)
 importFrom(pharmaRTF,add_titles)
 importFrom(pharmaRTF,hf_line)
@@ -44,6 +48,7 @@ importFrom(plotly,layout)
 importFrom(plotly,plot_ly)
 importFrom(plotly,plotlyOutput)
 importFrom(plotly,renderPlotly)
+importFrom(purrr,list_modify)
 importFrom(rlang,.data)
 importFrom(stringr,str_detect)
 importFrom(utils,hasName)

R/hepExplorer.R

@@ -0,0 +1,74 @@
+#' Convience mapping of render_widget for hepExplorer
+#' 
+#' @details The [data](https://github.com/SafetyGraphics/hep-explorer/wiki/Data-Guidelines) and [mapping](https://github.com/SafetyGraphics/hep-explorer/wiki/Configuration) should match the specs described in the [hepExplorer](https://github.com/SafetyGraphics/hep-explorer/wiki/Configuration) javascript library. Items passed in ... are added to mapping, and then the list is converted to json via `jsonlite::toJSON(mapping, auto_unbox=TRUE, null="null").
+#' 
+#' The default mapping - designed to work with safetyata::adam_adlbc is:   
+#' ```
+#' mapping <- list(
+#'            measure_col = "PARAM", 
+#'            measure_values = list(
+#'                ALT = "Alanine Aminotransferase (U/L)", 
+#'                AST = "Aspartate Aminotransferase (U/L)", 
+#'                TB = "Bilirubin (umol/L)",
+#'                ALP = "Alkaline Phosphatase (U/L)"
+#'            ), 
+#'            baseline_flag_col = "", 
+#'            baseline_flag_values = "", 
+#'            analysis_flag_col = "", 
+#'            analysis_flag_values = "",
+#'           id_col = "USUBJID", 
+#'            value_col = "AVAL", 
+#'            normal_col_low = "A1LO",                    
+#'            normal_col_high = "A1HI", 
+#'            studyday_col = "ADY", 
+#'            visit_col = "VISIT",
+#'            visitn_col = "VISITNUM", 
+#'            unit_col = ""
+#'        )                  
+#' ```
+#' 
+#' @examples 
+#' hepExplorer() #render widget with defaults
+#' hepExplorer(group_cols=c("SEX","AGEGR1")) # Adding age group
+#'
+#' @param df data frame for hep-explorer
+#' @param mapping named list with the current data mappings. See details for default mapping. 
+#' @param ... additional options to be added to mapping. Will overwrite mapping. 
+#' 
+#' @importFrom purrr list_modify
+#' 
+#' @export
+
+hepExplorer <- function(df=safetyData::adam_adlbc, mapping=NULL, ...){
+    #default mapping
+    if(is.null(mapping)){
+        mapping <- list(
+            measure_col = "PARAM", 
+            measure_values = list(
+                ALT = "Alanine Aminotransferase (U/L)", 
+                AST = "Aspartate Aminotransferase (U/L)", 
+                TB = "Bilirubin (umol/L)",
+                ALP = "Alkaline Phosphatase (U/L)"
+            ), 
+            baseline_flag_col = "", 
+            baseline_flag_values = "", 
+            analysis_flag_col = "", 
+            analysis_flag_values = "",
+            id_col = "USUBJID", 
+            value_col = "AVAL", 
+            normal_col_low = "A1LO",                    
+            normal_col_high = "A1HI", 
+            studyday_col = "ADY", 
+            visit_col = "VISIT",
+            visitn_col = "VISITNUM", 
+            unit_col = ""
+        )                   
+    }
+
+    # add ... to mapping
+    if(length(list(...))>0){
+        mapping <-  purrr::list_modify(mapping, !!!list(...))
+    }
+
+    render_widget("hepExplorer" ,df, mapping)
+}

R/render_widget.R

@@ -0,0 +1,33 @@
+#' Render an htmlwidget using standard safetyGraphics workflow
+#' 
+#' @param widgetName name of the widget saved in safetyCharts 
+#' @param data named list of current data sets
+#' @param mapping named list with the current data mappings
+#'
+#' @import htmlwidgets
+#' @importFrom jsonlite toJSON
+#'
+#' @export
+#' 
+render_widget <- function(widgetName, data, mapping){
+    params<-list(data=data, settings=mapping)
+
+    widgetParams <- list(
+        name=widgetName,
+        package='safetyCharts',
+        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
+
+    # Run the chart
+    do.call(htmlwidgets::createWidget, params)
+}
+