Merge pull request #107 from SafetyGraphics/dev

v0.3 release

.Rbuildignore

@@ -7,3 +7,4 @@ Examples
 cran-comments.md
 ^LICENSE\.md$
 ^CRAN-RELEASE$
+^CRAN-SUBMISSION$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: safetyCharts
 Title: Charts for Monitoring Clinical Trial Safety
-Version: 0.2.0
+Version: 0.3.0
 Authors@R:
     person(
         given = "Jeremy",
@@ -15,23 +15,25 @@ BugReports: https://github.com/SafetyGraphics/safetyCharts/issues
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Roxygen: list(markdown = TRUE)
 Imports:
     dplyr,
     DT,
-    Tplyr,
+    forcats,
     ggplot2,
+    htmlwidgets,
+    huxtable,
+    jsonlite, 
+    pharmaRTF,
+    plotly,
+    purrr,
+    RColorBrewer,
     rlang,
     shiny,
-    knitr,
-    RColorBrewer,
     stringr,
-    forcats,
     Tendril,
-    kableExtra,
-    huxtable, 
-    pharmaRTF
+    Tplyr
 Suggests:
     testthat,
     shinytest,

NAMESPACE

@@ -1,15 +1,21 @@
 # Generated by roxygen2: do not edit by hand
 
+export(QT_OutlierExplorer_server)
+export(QT_OutlierExplorer_ui)
+export(QT_Outlier_Explorer)
 export(demogRTF_server)
 export(demogRTF_table)
 export(demogRTF_ui)
+export(hepExplorer)
 export(init_aeExplorer)
+export(init_aeTimelines)
 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)
@@ -19,6 +25,7 @@ import(Tendril)
 import(Tplyr)
 import(dplyr)
 import(ggplot2)
+import(htmlwidgets)
 import(rlang)
 import(shiny)
 importFrom(huxtable,as_hux)
@@ -29,12 +36,20 @@ 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)
 importFrom(pharmaRTF,rtf_doc)
 importFrom(pharmaRTF,set_column_header_buffer)
 importFrom(pharmaRTF,set_font_size)
 importFrom(pharmaRTF,set_ignore_cell_padding)
+importFrom(plotly,animation_slider)
+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)

NEWS.md

@@ -1,3 +1,9 @@
+# safetyCharts v0.3
+
+This release adds several new features and bug fixes. New features include: 
+- Chart metadata has been migrated from `safetygraphics` to `safetycharts` to support the new metadata framework being introduced in the upcoming safetyGraphics v2.1 release.
+- A new `hepExplorer()`  function has been added to allow for a simple workflow to render the hepatic explorer with customizations. `hepExplorer()` calls a new `renderWidget()` function has been added for a more generalized widget rendering workflow. More updates may be added in this area in future releases. 
+
 # safetyCharts v0.2
 
 Initial CRAN release for safetyCharts. 

R/QT_Outlier_Explorer.R

@@ -0,0 +1,104 @@
+#' QT Outlier Explorer
+#'
+#' @param data ECG data structured as one record per person per visit per measurement. See details for column requirements.
+#' @param settings named list of settings with the parameters specified below.
+#'
+#' @details The settings object provides details the columns in the data set.
+#'
+#' \itemize{
+#'  \item{"id_col"}{ID column}
+#'  \item{"value_col"}{Value column}
+#'  \item{"measure_col"}{Measure column}
+#'  \item{"measure_values"}{Measure values}
+#'  \item{"visit_col"}{Visit column}
+#'  \item{"visitn_col"}{Visit number column (numeric)}
+#'  \item{"baseline_flag_col}{Baseline flag column}
+#'  \item{"baseline_flag_values}{Baseline flag value}
+#' }
+#'
+#'
+#' @return returns a chart object
+#'
+#' @importFrom plotly plot_ly animation_slider layout
+#' @import rlang
+#' @importFrom rlang .data
+#' @import dplyr
+#'
+#' @export
+
+
+
+
+QT_Outlier_Explorer <- function(data, settings)
+{
+
+    # horizontal reference line
+    hline <- function(y = 0, color = "blue") {
+        list(
+            type = "line",
+            x0 = 0,
+            x1 = 1,
+            xref = "paper",
+            y0 = y,
+            y1 = y,
+            line = list(color = color, width= 2, dash = 'dash')
+        )
+    }
+
+
+    # derive baseline and change from baseline
+    data_filtered <- data %>%
+        filter(.data[[settings$measure_col]] %in% settings$measure_values)  
+
+    data_bl <- data_filtered %>% 
+        filter( .data[[settings$baseline_flag_col]] == settings$baseline_flag_values) 
+
+
+    data1 <- data_bl %>% 
+        mutate( BL = .data[[ settings$value_col ]]) %>% 
+        select( .data$BL, settings$id_col) %>%
+        right_join(data_filtered, by = settings$id_col) %>% 
+        mutate(CHANGE = .data[[settings$value_col]] - .data$BL) %>%
+        mutate(Y450 = 450-.data$BL, Y480=480-.data$BL, Y500=500-.data$BL) 
+
+
+    #TODO: handle cross-over TQT study, VISIT-TPT scenario
+    #TODO: add mean profile plot
+
+
+
+    fig <- data1 %>%
+    plot_ly(
+        x         = ~BL,
+        y         = ~CHANGE,
+        size      = ~CHANGE,
+        color     = ~.data[[settings$treatment_col]],
+        frame     = ~paste0(sprintf("%02d", .data[[settings$visitn_col]]), " - ", .data[[settings$visit_col]] ),
+        text      = ~paste0(.data[[settings$measure_col]], "<br>Time point: ", .data[[settings$visit_col]], "<br>Treatment: ",
+                            .data[[settings$treatment_col]], "<br>Baseline:", BL, "<br>Change: ", CHANGE),
+        hoverinfo = "text",
+        type      = 'scatter',
+        mode      = 'markers'
+    ) %>%
+    animation_slider(
+        currentvalue = list(prefix = "Time Point: ")
+    ) %>%
+    layout(shapes = 
+        list(
+            hline(0), 
+            hline(30), 
+            hline(60),
+            list(
+                type="line", 
+                width= 2,  
+                line = list(dash = 'dash',color = "red"),
+                x0=0, 
+                x1=450, 
+                y0=450, 
+                y1=0
+            )
+        )
+    )
+
+return(fig)    
+}

R/hepExplorer.R

@@ -0,0 +1,106 @@
+#' Make standalone hepExplorer html widget
+#' 
+#' 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 shown below is designed to work with data in the CDISC ADaM format (like `safetydata::adam_adlbc`).    
+#' 
+#' ```
+#' 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)"
+#'            ), 
+#'            id_col = "USUBJID", 
+#'            value_col = "AVAL", 
+#'            normal_col_low = "A1LO",                    
+#'            normal_col_high = "A1HI", 
+#'            studyday_col = "ADY", 
+#'            visit_col = "VISIT",
+#'            visitn_col = "VISITNUM"
+#'        )                  
+#' ```
+#'
+#' Parameters that are not included in the default mapping can be accessed via ...; Key options and defaults for safetyData::adam_adlbc shown below: 
+#'
+#' - `filters`: list of columns to be included as data filters (e.g. `filters=c("SEX","AGEGR1")``)
+#' - `group_cols`: list of columns used to define grouping and set point color (e.g. `filters=c("SEX","AGEGR1")``)
+#' - `x_options` and `y_options` - specify which labs can be used for x and y axis dropdowns. By default, all options are included on x-axis, but only Bilirubin is shown on y-axis. To allow an interactive y-axis, use `y_options="all"`. 
+#' - `baseline` - flag defining the baseline visit for each participant. `baseline` must be provided to enable the mDish view on the hep-explorer chart. Define as a list with `value_col` and `values` (e.g. `baseline=list(value_col="ABLFL",values="Y")`)
+#' - `title` and `warningText` - Strings used to define the header text shown above the filters.  
+#' 
+#' For more options see the [full specs](https://github.com/SafetyGraphics/hep-explorer/wiki/Configuration) in the javascript library.
+#' 
+#' @examples 
+#' \dontrun{
+#' # Render widget with defaults
+#' hepExplorer() 
+#' 
+#' # Add age group to default
+#' hepExplorer(group_cols=c("SEX","AGEGR1")) 
+#' 
+#' # Enable interactive y-axis
+#' hepExplorer(y_options='all') 
+#' 
+#' # Use custom mapping for SDTM data
+#' hepExplorer(
+#'     df=safetyData::sdtm_lb,
+#'     measure_col = "LBTEST", 
+#'     measure_values = list(
+#'         ALT = "Alanine Aminotransferase", 
+#'         AST = "Aspartate Aminotransferase", 
+#'         TB = "Bilirubin",
+#'         ALP = "Alkaline Phosphatase"
+#'     ), 
+#'     id_col = "USUBJID", 
+#'     value_col = "LBSTRESN", 
+#'     normal_col_low = "LBORNRLO",                    
+#'     normal_col_high = "LBORNRHI", 
+#'     studyday_col = "LBDY", 
+#'     visit_col = "VISIT",
+#'     visitn_col = "VISITNUM"
+#' )
+#' }
+#' 
+#' @param df data frame containing lab data used to render for hepExplorer. Default is safetyData::adam_adlbc. 
+#' @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)"
+            ), 
+            id_col = "USUBJID", 
+            value_col = "AVAL", 
+            normal_col_low = "A1LO",                    
+            normal_col_high = "A1HI", 
+            studyday_col = "ADY", 
+            visit_col = "VISIT",
+            visitn_col = "VISITNUM"
+        )                   
+    }
+
+    # add ... to mapping
+    if(length(list(...))>0){
+        mapping <-  purrr::list_modify(mapping, !!!list(...))
+    }
+
+    # render widget as standalone html page
+    render_widget("hepExplorer" ,df, mapping)
+}

R/init_aeExplorer.R

@@ -9,34 +9,33 @@
 
 
 init_aeExplorer <- function(data, settings) {
-
     # Merge treatment with adverse events.
     dm_sub <- data$dm %>% select(settings[["dm"]][["id_col"]], settings[["dm"]][["treatment_col"]])
     anly <- dm_sub %>% left_join(data$aes) # left join to keep all rows in dm (even if there were no AEs)
 
-    settings <- c(settings$aes, settings$labs)
+    ae_settings <- list()
 
-    settings$variables <- list(
-        major = settings[["bodsys_col"]],
-        minor = settings[["term_col"]],
-        group = settings[["trt_col"]],
-        id = paste0(settings[["id_col"]]),
+    ae_settings$variables <- list(
+        major = settings[['aes']][["bodsys_col"]],
+        minor = settings[['aes']][["term_col"]],
+        group = settings[["dm"]][["treatment_col"]],
+        id = settings[["dm"]][["id_col"]],
         filters = list(),
         details = list()
     )
 
-    settings$variableOptions <- list(
+    ae_settings$variableOptions <- list(
         group = c(
-            settings[["treatment_values--group1"]],
-            settings[["treatment_values--group2"]]
+            settings[['dm']][["treatment_values--group1"]],
+            settings[['dm']][["treatment_values--group2"]]
         )
     )
 
-    settings$defaults <- list(
+    ae_settings$defaults <- list(
         placeholderFlag = list(
-            valueCol = settings[["bodsys_col"]],
+            valueCol = settings[['aes']][["bodsys_col"]],
             values = c("", NA, NULL)
         )
     )
-    return(list(data = anly, settings = settings))
+    return(list(data = anly, settings = ae_settings))
 }

R/init_aeTimelines.R

@@ -0,0 +1,20 @@
+#' Initialize Settings for AE Timeline widget
+#' 
+#' @param data labs data structured as one record per person per visit per measurement. See details for column requirements.
+#' @param settings named list of settings
+#'
+#' @return returns list with data and settings
+#'
+#' @export
+
+init_aeTimelines <- function(data, settings) {
+
+    settings$color <- list(
+        value_col = settings[["severity_col"]]
+    )
+    settings$highlight <- list(
+        value_col = settings[["serious_col"]]
+    )
+
+    return(list(data = data, settings = settings))
+}