added ecg domain + QT charts

DESCRIPTION

@@ -15,13 +15,14 @@ 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,
     ggplot2,
+    plotly,
     rlang,
     shiny,
     knitr,

NAMESPACE

@@ -1,5 +1,8 @@
 # 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)
@@ -36,5 +39,11 @@ 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(rlang,.data)
 importFrom(stringr,str_detect)
 importFrom(utils,hasName)

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/meta_ecg.R

@@ -0,0 +1,19 @@
+#' Metadata data frame containing information about the data mapping used to configure safetyGraphics charts for the ecg domain. One record per unique data mapping
+#'
+#' @format A data frame with 22 rows and 10 columns
+#' \describe{
+#'    \item{domain}{Data domain}
+#'    \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a field level data mapping}
+#'    \item{col_key}{Key for the column mapping}
+#'    \item{field_key}{Key for the field mapping (if any)}
+#'    \item{type}{type of mapping - "field" or "column"}
+#'    \item{label}{Label}
+#'    \item{description}{Description}
+#'    \item{multiple}{Mapping supports multiple columns/fields }
+#'    \item{standard_adam}{Default values for the ADaM data standard}
+#'    \item{standard_sdtm}{Default values for the SDTM data standard}
+#' }    
+#' 
+#' @source Created for this package
+
+"meta_ecg"

R/mod_QT_OutlierExplorer.R

@@ -0,0 +1,91 @@
+
+#' QT Outlier Explorer Module - UI
+#'
+#' @param id module id
+#'
+#' @return returns shiny module UI
+#'
+#' @import shiny
+#' @importFrom plotly plotlyOutput
+#'
+#' @export
+#'
+
+QT_OutlierExplorer_ui <- function(id) {
+    ns <- NS(id)
+    sidebar<-sidebarPanel(
+        uiOutput(ns("selectMeasures"))
+    )
+    main<-mainPanel(
+        tabsetPanel(
+            tabPanel("QT Vis", plotlyOutput(ns("QT_OutlierExplorer"), height = 800)),
+            tabPanel("QT Data Info", verbatimTextOutput(ns("info")))
+        )
+
+    )
+    ui<-fluidPage(
+        sidebarLayout(
+            sidebar,
+            main,
+            position = c("right"),
+            fluid=TRUE
+        )
+    )
+    return(ui)
+}
+
+
+#' QT Outlier Explorer Module - UI
+#'
+#' @param input module input
+#' @param output module output
+#' @param session module session
+#' @param params parameters object with `data` and `settings` options.
+#'
+#' @return returns shiny module Server function
+#'
+#' @import shiny
+#' @importFrom plotly renderPlotly
+#'
+#' @export
+
+QT_OutlierExplorer_server <- function(input, output, session, params) {
+    ns <- session$ns
+
+
+    output$selectMeasures <- renderUI({
+        measure_col <- params()$settings$measure_col
+        measures <- unique(params()$data[[measure_col]])
+
+
+        selectizeInput(
+            ns("measures"),
+            "Select Measures",
+            multiple=TRUE,
+            choices=measures,
+            selected = "QTcF"
+        )
+    })
+
+    # Populate control with measures and select all by default
+
+    # customize selected measures based on input
+    settingsR <- reactive({
+        settings <- params()$settings
+        settings$measure_values <- input$measures
+        return(settings)
+    })
+
+    # data info
+
+    output$info <- renderPrint({
+        params()$data %>% count(.data[[params()$settings$visit_col]], .data[[params()$settings$tpt_col]], sort=FALSE) %>% data.frame
+    })
+
+    #draw the chart
+    output$QT_OutlierExplorer <- renderPlotly({
+
+        req(input$measures)
+        QT_Outlier_Explorer(params()$data, settingsR())
+    })
+}

data-raw/makeMeta.R

@@ -0,0 +1,7 @@
+# Note: expected to be run from the root package directory
+library(tidyverse)
+library(usethis)
+
+#Copy metadata to /data
+meta_ecg<-read_csv("data-raw/meta_ecg.csv")
+usethis::use_data(meta_ecg, overwrite = TRUE)

data-raw/meta_ecg.csv

@@ -0,0 +1,23 @@
+text_key,domain,col_key,field_key,type,label,description,multiple,standard_adam,standard_sdtm
+id_col,ecg,id_col,NA,column,ID column,Unique subject identifier variable name.,FALSE,USUBJID,USUBJID
+value_col,ecg,value_col,NA,column,Value column,QT result variable name.,FALSE,AVAL,EGSTRESN
+measure_col,ecg,measure_col,NA,column,Measure column,QT measure variable name,FALSE,PARAM,EGTEST
+normal_col_low,ecg,normal_col_low,NA,column,Lower Limit of Normal column,Lower limit of normal variable name,FALSE,ANRLO,EGSTNRLO
+normal_col_high,ecg,normal_col_high,NA,column,Upper Limit of Normal column,Upper limit of normal variable name,FALSE,ANRHI,EGSTNRHI
+studyday_col,ecg,studyday_col,NA,column,Study Day column,Visit day variable name,FALSE,ADY,EGDY
+visit_col,ecg,visit_col,NA,column,Visit column,Visit variable name,FALSE,AVISIT,VISIT
+visitn_col,ecg,visitn_col,NA,column,Visit Number column,Visit number variable name,FALSE,AVISITN,VISITNUM
+tpt_col,ecg,tpt_col,NA,column,Timepoint column,Timepoint variable name,FALSE,ATPT,EGTPT
+tptn_col,ecg,tptn_col,NA,column,Timepoint number column,Timepoint number variable name,FALSE,ATPTN,NA
+period_col,ecg,period_col,NA,column,Period column ,Period variable name,FALSE,APERIOD,NA
+measure_values--QT,ecg,measure_col,QT,field,QT inteval,Value used for QT in the specified measure column,FALSE,QT,QT
+measure_values--QTcF,ecg,measure_col,QTcF,field,QT with Fridericia Correction ,Value used for QTcF in the specified measure column,FALSE,QTcF,QTCF
+measure_values--QTcB,ecg,measure_col,QTcB,field,QT with Bazett's Correction ,Value used for QTcB in the specified measure column,FALSE,QTcB,QTCB
+measure_values--RR,ecg,measure_col,RR,field,RR interval,Value used for RR interval in the specified measure column,FALSE,RR,RR
+measure_values--QRS,ecg,measure_col,QRS,field,QRS ,Value used for QRS interval in the specified measure column,FALSE,QRS,QRS
+unit_col,ecg,unit_col,NA,column,Unit column,Unit of measure variable name,FALSE,AVALU,EGSTRESU
+baseline_flag_col,ecg,baseline_flag_col,NA,column,Baseline column,An optional list defining which column represent the baseline visit(s) of the study.,FALSE,ABLFL,EGBLFL
+baseline_flag_values,ecg,baseline_flag_col,values,field,Baseline values,An optional list defining which values (one or more) represent the baseline visit(s) of the study.,TRUE,Y,Y
+treatment_col,ecg,treatment_col,NA,column,Treatment Column,Treatment Column,FALSE,TRTA,ARM
+analysis_flag_col,ecg,analysis_flag_col,NA,column,Analysis column,An optional list defining which column represent the analysis visit(s) of the study.,FALSE,NA,NA
+analysis_flag_values,ecg,analysis_flag_col,values,field,Analysis values,An optional list defining which values (one or more) represent the analysis visit(s) of the study.,TRUE,NA,NA

inst/config/QTOutlierExplorerModule.yaml

@@ -0,0 +1,14 @@
+env: safetyGraphics
+label: QT Outlier Explorer - Module
+name: qTexplorer
+type: module
+package: safetyCharts
+export: true
+order: 37
+domain: 
+  - ecg
+workflow:
+  ui: QT_OutlierExplorer_ui
+  server: QT_OutlierExplorer_server
+links:
+  safetyCharts: https://github.com/SafetyGraphics/safetycharts

inst/config/QTpaneledOutlierExplorer.yaml

@@ -0,0 +1,17 @@
+env: safetyGraphics
+label: QT Paneled Outlier Explorer
+type: htmlwidget
+domain: 
+  - ecg
+package: safetyCharts
+export: true
+order: 32
+workflow:
+  init: init_paneledOutlierExplorer
+  widget: paneledOutlierExplorer
+links:
+  Homepage: https://github.com/RhoInc/paneled-outlier-explorer
+  Wiki: https://github.com/RhoInc/paneled-outlier-explorer/wiki 
+  Issues: https://github.com/RhoInc/paneled-outlier-explorer/issues
+  Demo: https://rhoinc.github.io/paneled-outlier-explorer/test-page/
+

inst/config/QTsafetyDeltaDelta.yaml

@@ -0,0 +1,17 @@
+env: safetyGraphics
+label: QT Delta-Delta
+type: htmlwidget
+package: safetyCharts
+export: true
+order: 36
+domain: 
+  - ecg
+workflow:
+  widget: safetyDeltaDelta
+links:
+  Homepage: https://github.com/RhoInc/safety-delta-delta
+  Wiki: https://github.com/RhoInc/safety-delta-delta/wiki 
+  Issues: https://github.com/RhoInc/safety-delta-delta/issues
+  Demo: https://rhoinc.github.io/safety-delta-delta/test-page/
+  safetyCharts: https://github.com/SafetyGraphics/safetycharts
+

inst/config/QTsafetyHistogram.yaml

@@ -0,0 +1,17 @@
+env: safetyGraphics
+label: QT Histogram
+type: htmlwidget
+package: safetyCharts
+domain: 
+  - ecg
+export: true
+order: 33
+workflow:
+  widget: safetyHistogram
+links:
+  Homepage: https://github.com/RhoInc/safety-histogram
+  Wiki: https://github.com/RhoInc/safety-histogram/wiki 
+  Issues: https://github.com/RhoInc/safety-histogram/issues
+  Demo: https://rhoinc.github.io/safety-histogram/test-page/
+  safetyCharts: https://github.com/SafetyGraphics/safetycharts
+

inst/config/QTsafetyOutlierExplorer.yaml

@@ -0,0 +1,17 @@
+env: safetyGraphics
+label: QT Outlier Explorer
+type: htmlwidget
+package: safetyCharts
+export: true
+order: 31
+domain: 
+  - ecg
+workflow:
+  init: init_safetyOutlierExplorer
+  widget: safetyOutlierExplorer
+links:
+  Homepage: https://github.com/RhoInc/safety-outlier-explorer
+  Wiki: https://github.com/RhoInc/safety-outlier-explorer/wiki 
+  Issues: https://github.com/RhoInc/safety-outlier-explorer/issues
+  Demo: https://rhoinc.github.io/safety-outlier-explorer/test-page/
+  safetyCharts: https://github.com/SafetyGraphics/safetycharts

inst/config/QTsafetyResultsOverTime.yaml

@@ -0,0 +1,17 @@
+env: safetyGraphics
+label: QT Results Over Time
+type: htmlwidget
+package: safetyCharts
+export: true
+order: 34
+domain: 
+  - ecg
+workflow:
+  init: init_safetyResultsOverTime
+  widget: safetyResultsOverTime
+links:
+  Homepage: https://github.com/RhoInc/safety-results-over-time
+  Wiki: https://github.com/RhoInc/safety-results-over-time/wiki
+  Issues: https://github.com/RhoInc/safety-results-over-time/issues
+  Demo: https://rhoinc.github.io/safety-results-over-time/test-page/
+  safetyCharts: https://github.com/SafetyGraphics/safetycharts