diff --git a/DESCRIPTION b/DESCRIPTION
index be69d218..048f549f 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -18,11 +18,11 @@ License: MIT + file LICENSE
Encoding: UTF-8
LazyData: true
RoxygenNote: 6.1.1
-Suggests:
+Suggests:
testthat,
shinytest,
knitr
-Imports:
+Imports:
dplyr,
htmlwidgets,
purrr,
diff --git a/NAMESPACE b/NAMESPACE
index 3acbd77b..c39c9361 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -16,6 +16,7 @@ import(rmarkdown)
import(shinyjs)
importFrom(dplyr,"filter")
importFrom(dplyr,filter)
+importFrom(dplyr,full_join)
importFrom(haven,read_sas)
importFrom(magrittr,"%>%")
importFrom(purrr,keep)
diff --git a/R/checkColumn.R b/R/checkColumn.R
index 3674be7b..c6bb0db1 100644
--- a/R/checkColumn.R
+++ b/R/checkColumn.R
@@ -16,27 +16,27 @@
#' testSettings$filters[[1]]<-list(value_col="RACE",label="Race")
#' testSettings$filters[[2]]<-list(value_col=NULL,label="No Column")
#' testSettings$filters[[3]]<-list(value_col="NotAColumn",label="Invalid Column")
-#'
+#'
#' #pass ($valid == TRUE)
#' safetyGraphics:::checkColumn(key=list("id_col"),
-#' settings=testSettings, adlbc)
-#'
+#' settings=testSettings, adlbc)
+#'
#' #pass
#' safetyGraphics:::checkColumn(key=list("filters",1,"value_col"),
-#' settings=testSettings, adlbc)
-#'
+#' settings=testSettings, adlbc)
+#'
#' #NULL column pass
#' safetyGraphics:::checkColumn(key=list("filters",2,"value_col"),
-#' settings=testSettings, adlbc)
-#'
+#' settings=testSettings, adlbc)
+#'
#' #invalid column fails
#' safetyGraphics:::checkColumn(key=list("filters",3,"value_col"),
-#' settings=testSettings, adlbc)
+#' settings=testSettings, adlbc)
#' @keywords internal
checkColumn <- function(key, settings, data){
stopifnot(typeof(key)=="list",typeof(settings)=="list")
-
+
current <- list(key=key)
current$text_key <- paste( unlist(current$key), collapse='--')
current$type <- "column"
diff --git a/R/checkNumeric.R b/R/checkNumeric.R
index 435d4627..588c95b4 100644
--- a/R/checkNumeric.R
+++ b/R/checkNumeric.R
@@ -10,11 +10,11 @@
#' @examples
#' testSettings<-generateSettings(standard="AdAM")
#' #pass ($valid == FALSE)
-#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc)
-#'
+#' safetyGraphics:::checkNumeric(key=list("id_col"),settings=testSettings, data=adlbc)
+#'
#' #pass ($valid == TRUE)
-#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc)
-#'
+#' safetyGraphics:::checkNumeric(key=list("value_col"),settings=testSettings, data=adlbc)
+#'
#' @keywords internal
checkNumeric <- function(key, settings, data){
diff --git a/R/data_checks.R b/R/data_checks.R
new file mode 100644
index 00000000..0ae20a0b
--- /dev/null
+++ b/R/data_checks.R
@@ -0,0 +1 @@
+#Statistical Checks
\ No newline at end of file
diff --git a/R/generateSettings.R b/R/generateSettings.R
index ac5530d1..7a2963c7 100644
--- a/R/generateSettings.R
+++ b/R/generateSettings.R
@@ -1,104 +1,120 @@
#' Generate a settings object based on a data standard
#'
-#' This function returns a settings object for the eDish chart based on the specified data standard.
+#' This function returns a settings object for the eDish chart based on the specified data standard.
#'
#' The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data. Currently, eDish is the only chart supported.
#'
-#' @param standard The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"SDTM"}
-#' @param chart The chart for which standards should be generated ("eDish" only for now) . Default: \code{"eDish"}.
+#' @param standard The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"None"}.
+#' @param charts The chart or chart(s) for which settings should be generated. Default: \code{NULL} (uses all available charts).
+#' @param useDefaults Specifies whether default values from settingsMetadata should be included in the settings object. Default: \code{TRUE}.
#' @param partial Boolean for whether or not the standard is a partial standard. Default: \code{FALSE}.
#' @param partial_keys Optional character vector of the matched settings if partial is TRUE. Settings should be identified using the text_key format described in ?settingsMetadata. Setting is ignored when partial is FALSE. Default: \code{NULL}.
+#' @param custom_settings a tibble with text_key and customValue columns specifiying customizations to be applied to the settings object. Default: \code{NULL}.
#' @return A list containing the appropriate settings for the selected chart
-#'
-#' @examples
-#'
-#' generateSettings(standard="SDTM")
+#'
+#' @examples
+#'
+#' generateSettings(standard="SDTM")
#' generateSettings(standard="SdTm") #also ok
#' generateSettings(standard="ADaM")
#' pkeys<- c("id_col","measure_col","value_col")
#' generateSettings(standard="adam", partial=TRUE, partial_keys=pkeys)
-#'
-#' generateSettings(standard="a different standard")
+#'
+#' generateSettings(standard="a different standard")
#' #returns shell settings list with no data mapping
-#'
+#'
#' \dontrun{
-#' generateSettings(standard="adam",chart="AEExplorer") #Throws error. Only eDish supported so far.
+#' generateSettings(standard="adam",chart="AEExplorer") #Throws error. Only eDish supported so far.
#' }
-#'
-#' @importFrom dplyr "filter"
+#'
+#' @importFrom dplyr "filter" full_join
#' @importFrom stringr str_split
#' @importFrom rlang .data
-#'
+#'
#' @export
-generateSettings <- function(standard="None", chart="eDish", partial=FALSE, partial_keys=NULL){
- if(tolower(chart)!="edish"){
- stop(paste0("Can't generate settings for the specified chart ('",chart,"'). Only the 'eDish' chart is supported for now."))
- }
-
+generateSettings <- function(standard="None", charts=NULL, useDefaults=TRUE, partial=FALSE, partial_keys=NULL, custom_settings=NULL){
+
# Check that partial_keys is supplied if partial is true
if (is.null(partial_keys) & partial ) {
stop("partial_keys must be supplied if the standard is partial")
}
-
+
# Coerce options to lowercase
standard<-tolower(standard)
- chart<-tolower(chart)
-
+ if(!is.null(charts)){
+ charts<-tolower(charts)
+ }
+
+ #############################################################################
+ # get keys & default values for settings using a data standard (data and field mappings)
+ ############################################################################
# Build a table of data mappings for the selected standard and partial settings
- standardList<-c("adam","sdtm") #TODO: automatically generate this from metadata
+ standardList<-safetyGraphics::standardsMetadata%>%select(-.data$text_key)%>%names
+
if(standard %in% standardList){
- dataMappings <- safetyGraphics::getSettingsMetadata(
- charts = chart,
+ dataDefaults <- safetyGraphics::getSettingsMetadata(
+ charts = charts,
cols=c("text_key",standard,"setting_required")
- ) %>%
+ ) %>%
filter(.data$setting_required)%>%
- rename("column_name" = standard)%>%
- filter(.data$column_name != '')
-
- if(partial){
- dataMappings<-dataMappings%>%filter(.data$text_key %in% partial_keys)
- }
+ select(-.data$setting_required)%>%
+ rename("dataDefault" = standard)%>%
+ filter(.data$dataDefault != '')
+ }else{
+ dataDefaults<-tibble(text_key=character(),dataDefault=character(), .rows=0)
}
-
- # build shell settings for each chart
- # TODO: move these to `/data` eventually
- shells<-list()
- shells[["edish"]]<-list(
- id_col = NULL,
- value_col = NULL,
- measure_col = NULL,
- normal_col_low = NULL,
- normal_col_high = NULL,
- studyday_col=NULL,
- visit_col = NULL,
- visitn_col = NULL,
- filters = NULL,
- group_cols = NULL,
- measure_values = list(ALT = NULL,
- AST = NULL,
- TB = NULL,
- ALP = NULL),
- baseline = list(value_col=NULL,
- values=list()),
- analysisFlag = list(value_col=NULL,
- values=list()),
-
- x_options = c("ALT", "AST", "ALP"),
- y_options = c("TB", "ALP"),
- visit_window = 30,
- r_ratio_filter = TRUE,
- r_ratio_cut = 0,
- showTitle = TRUE,
- warningText = "Caution: This interactive graphic is not validated. Any clinical recommendations based on this tool should be confirmed using your organizations standard operating procedures."
- )
-
- # loop through dataMappings and apply them to the shell
- if(standard %in% standardList){
- for(row in 1:nrow(dataMappings)){
- shells[[chart]]<-setSettingsValue(settings = shells[[chart]], key = textKeysToList(dataMappings[row,"text_key"])[[1]], value = dataMappings[row, "column_name"])
- }
+
+ if(partial){
+ dataDefaults <-dataDefaults%>%filter(.data$text_key %in% partial_keys)
+ }
+
+ #############################################################################
+ # get keys & default values for settings not using a data standard
+ #############################################################################
+ if(useDefaults){
+ otherDefaults <- safetyGraphics::getSettingsMetadata(
+ charts = charts,
+ filter = !.data$column_mapping & !.data$field_mapping,
+ cols=c("text_key","default")
+ )%>%
+ rename("otherDefault"="default")
+ }else{
+ otherDefaults <- tibble(text_key=character(),otherDefault=character(), .rows=0)
+ }
+
+ #############################################################################
+ # merge all keys & default values
+ #############################################################################
+ key_values <- full_join(dataDefaults, otherDefaults, by="text_key")
+ key_values <- key_values %>% mutate(default=ifelse(is.na(.data$dataDefault),.data$otherDefault,.data$dataDefault))
+
+ #############################################################################
+ # Apply custom settings (if any)
+ #############################################################################
+ if(!is.null(custom_settings)){
+ key_values<-full_join(key_values, custom_settings, by="text_key")
+ } else {
+ key_values$customValue<-NA
+ }
+
+ key_values<-key_values %>% mutate(value=ifelse(is.na(.data$customValue), .data$default, .data$customValue))
+
+ #############################################################################
+ # create shell settings object
+ #############################################################################
+ shell<-generateShell(charts=charts)
+
+ #########################################################################################
+ # populate the shell settings by looping through key_values and apply them to the shell
+ #########################################################################################
+ for(row in 1:nrow(key_values)){
+ shell<-setSettingsValue(
+ settings = shell,
+ key = textKeysToList(key_values[row,"text_key"])[[1]],
+ value = key_values[row, "value"][[1]]
+ )
}
- return(shells[[chart]])
-}
\ No newline at end of file
+ return(shell)
+}
diff --git a/R/generateShell.R b/R/generateShell.R
new file mode 100644
index 00000000..f0dac6d7
--- /dev/null
+++ b/R/generateShell.R
@@ -0,0 +1,34 @@
+#' Generate a default settings shell based on settings metadata
+#'
+#' This function returns a default settings object based on the chart(s) specified.
+#'
+#' The function is designed to work with valid safetyGraphics charts.
+#'
+#' @param charts The chart or chart(s) to include in the shell settings object
+#' @return A list containing a setting shell (all values = NA) for the selected chart(s)
+#'
+#' @examples
+#'
+#' safetyGraphics:::generateShell(charts = "eDish")
+#'
+#' @keywords internal
+
+generateShell <- function(charts=NULL){
+ keys <- safetyGraphics::getSettingsMetadata(
+ charts = charts,
+ cols=c("text_key")
+ ) %>% textKeysToList()
+
+ shell <- list()
+
+ for (i in 1:length(keys) ) {
+ shell<-setSettingsValue(
+ key=keys[[i]],
+ value=NULL,
+ settings=shell,
+ forceCreate=TRUE
+ )
+ }
+
+ return(shell)
+}
diff --git a/R/setSettingsValue.R b/R/setSettingsValue.R
index 8052d237..e0cf4f53 100644
--- a/R/setSettingsValue.R
+++ b/R/setSettingsValue.R
@@ -5,6 +5,7 @@
#' @param key a list (like those provided by \code{getSettingKeys()}) defining the position of parameter in the settings object.
#' @param value the value to set
#' @param settings The settings list used to generate a chart like \code{eDISH()}
+#' @param forceCreate Specifies whether the function should create a new list() when none exisits. This most commonly occurs when deeply nested objects.
#' @return the updated settings object
#'
#' @examples
@@ -21,17 +22,26 @@
#' @keywords internal
-setSettingsValue <- function(key, value, settings){
- stopifnot(
- typeof(settings)=="list"
- )
+setSettingsValue <- function(key, value, settings, forceCreate=FALSE){
+
+ if(typeof(settings)!="list"){
+ if(forceCreate){
+ settings=list()
+ }else{
+ stop("Settings is not a valid list object. Set forceCreate to TRUE and re-run if you want to create a new list and continue.")
+ }
+ }
firstKey <- key[[1]]
if(length(key)==1){
- settings[[firstKey]]<-value
+ if(is.null(value)){
+ settings[firstKey]<-list(NULL)
+ }else{
+ settings[[firstKey]]<-value
+ }
return(settings)
}else{
- settings[[firstKey]]<-setSettingsValue(settings = settings[[firstKey]],key = key[2:length(key)], value)
+ settings[[firstKey]]<-setSettingsValue(settings = settings[[firstKey]],key = key[2:length(key)], value=value, forceCreate=forceCreate)
return(settings)
}
}
\ No newline at end of file
diff --git a/R/settingsMetadata.R b/R/settingsMetadata.R
index 92882d95..e2ba463e 100644
--- a/R/settingsMetadata.R
+++ b/R/settingsMetadata.R
@@ -15,6 +15,7 @@
#' \item{field_mapping}{Flag indicating whether the setting corresponds to a field-level mapping in the data}
#' \item{field_column_key}{Key for the column that provides options for the field-level mapping in the data}
#' \item{setting_cat}{Setting category (data, measure, appearance)}
+#' \item{default}{Default value for non-data settings}
#' }
#'
#' @source Created for this package
diff --git a/R/trimData.R b/R/trimData.R
index f50fe288..b7e72c54 100644
--- a/R/trimData.R
+++ b/R/trimData.R
@@ -22,10 +22,10 @@ trimData <- function(data, settings, chart="edish"){
## Remove columns not in settings ##
col_names <- colnames(data)
-
+
allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = c("text_key","setting_type"))
dataKeys <- allKeys %>% filter(.data$setting_type !="vector") %>% pull(.data$text_key) %>% textKeysToList()
-
+
# Add items in vectors to list individually
dataVectorKeys <- allKeys %>% filter(.data$setting_type =="vector") %>% pull(.data$text_key) %>% textKeysToList()
for(key in dataVectorKeys){
@@ -37,12 +37,12 @@ trimData <- function(data, settings, chart="edish"){
sub <- current[[i]]
if(typeof(sub)=="list"){
newKey[[1+length(newKey)]]<-"value_col"
- }
- dataKeys[[1+length(dataKeys)]]<-newKey
+ }
+ dataKeys[[1+length(dataKeys)]]<-newKey
}
}
}
-
+
settings_values <- map(dataKeys, function(x) {return(getSettingValue(x, settings))})
common_cols <- intersect(col_names,settings_values)
@@ -50,22 +50,25 @@ trimData <- function(data, settings, chart="edish"){
data_subset <- select(data, unlist(common_cols))
## Remove rows if baseline or analysisFlag is specified ##
+ baselineSetting<-settings[['baseline']][['value_col']]
+ baselineMissing <- is.null(baselineSetting)
+ analysisSetting<-settings[['analysisFlag']][['value_col']]
+ analysisMissing <- is.null(analysisSetting)
- if(!is.null(settings[['baseline']][['value_col']]) | !is.null(settings[['analysisFlag']][['value_col']])) {
+ if(!baselineMissing | !analysisMissing) {
# Create Baseline String
- baseline_string <- ifelse(!is.null(settings[['baseline']][['value_col']]),
+ baseline_string <- ifelse(!baselineMissing,
paste(settings[['baseline']][['value_col']], "%in% settings[['baseline']][['values']]"),
"")
# Create AnalysisFlag String
- analysis_string <- ifelse(!is.null(settings[['analysisFlag']][['value_col']]),
+ analysis_string <- ifelse(!analysisMissing,
paste(settings[['analysisFlag']][['value_col']], "%in% settings[['analysisFlag']][['values']]"),
"")
# Include OR operator if both are specified
- operator <- ifelse(!is.null(settings[['baseline']][['value_col']]) & !is.null(settings[['analysisFlag']][['value_col']]),
- "|","")
+ operator <- ifelse(!baselineMissing & !analysisMissing, "|", "")
# Create filter string and make it an expression
filter_string <- paste(baseline_string, operator, analysis_string)
diff --git a/README.md b/README.md
index 9b95cc03..7e148e01 100644
--- a/README.md
+++ b/README.md
@@ -1,11 +1,11 @@
-[](https://travis-ci.org/ASA-DIA-InteractiveSafetyGraphics/safetyGraphics) [](https://cran.r-project.org/package=safetyGraphics)
+[](https://travis-ci.org/SafetyGraphics/safetyGraphics) [](https://cran.r-project.org/package=safetyGraphics)
# safetyGraphics: Clinical Trial Safety Graphics with R 
-The **safetyGraphics** package provides a framework for evaluation of clinical trial safety in R. The initial release focuses on Evaluation of Drug-Induced Serious Hepatotoxicity (eDISH). A prototype of the eDish interactive graphic is available [here](https://asa-dia-interactivesafetygraphics.github.io/safety-eDISH/test/) and is shown below.
+The **safetyGraphics** package provides a framework for evaluation of clinical trial safety in R. The initial release focuses on Evaluation of Drug-Induced Serious Hepatotoxicity (eDISH). A prototype of the eDish interactive graphic is available [here](https://safetygraphics.github.io/safety-eDISH/test/) and is shown below.
-This package is being built in conjunction with the [safety-eDISH](https://github.com/ASA-DIA-InteractiveSafetyGraphics/safety-eDISH) javascript library. Both packages are under active development with beta testing and an initial release planned for early 2019.
+This package is being built in conjunction with the [safety-eDISH](https://github.com/safetyGraphics/safety-eDISH) javascript library. Both packages are under active development with beta testing and an initial release planned for early 2019.
@@ -21,7 +21,7 @@ The Shiny app provides a simple interface for:
- Viewing and exporting the interactive graphics
```r
-devtools::install_github("ASA-DIA-InteractiveSafetyGraphics/safetyGraphics")
+devtools::install_github("SafetyGraphics/safetyGraphics")
library("safetyGraphics")
chartBuilderApp() #open the shiny application
```
@@ -31,7 +31,7 @@ chartBuilderApp() #open the shiny application
Users can also initialize customized standalone charts with a few lines of code.
```r
-devtools::install_github("ASA-DIA-InteractiveSafetyGraphics/safetyGraphics")
+devtools::install_github("safetyGraphics/safetyGraphics")
library("safetyGraphics")
eDISH(data=adlbc,
id_col = "USUBJID",
diff --git a/data-raw/csv_to_rda.R b/data-raw/csv_to_rda.R
index de6c8b5f..07dfc3cb 100644
--- a/data-raw/csv_to_rda.R
+++ b/data-raw/csv_to_rda.R
@@ -3,8 +3,14 @@ library(usethis)
ablbc <- read.csv("data-raw/adlbc.csv")
usethis::use_data(adlbc, overwrite = TRUE)
-settingsMetadata <- read.csv("data-raw/settingsMetadata.csv")
+partialSettingsMetadata <- read.csv("data-raw/settingsMetadata.csv")
+
+#merge defaults on to settingsMetadata
+defaults <- readRDS("data-raw/defaults.rda") #why is this not working... grrrr
+
+settingsMetadata <- merge(partialSettingsMetadata, defaults, by="text_key")
+
usethis::use_data(settingsMetadata, overwrite = TRUE)
standardsMetadata <- read.csv("data-raw/standardsMetadata.csv")
-usethis::use_data(standardsMetadata, overwrite = TRUE)
\ No newline at end of file
+usethis::use_data(standardsMetadata, overwrite = TRUE)
diff --git a/data-raw/defaults.rda b/data-raw/defaults.rda
new file mode 100644
index 00000000..018b5ccd
Binary files /dev/null and b/data-raw/defaults.rda differ
diff --git a/data-raw/generateDefaults.R b/data-raw/generateDefaults.R
new file mode 100644
index 00000000..cd92d952
--- /dev/null
+++ b/data-raw/generateDefaults.R
@@ -0,0 +1,29 @@
+defaults <- tribble(~text_key, ~default,
+ "id_col", NULL,
+ "value_col", NULL,
+ "measure_col", NULL,
+ "measure_values--ALT", NULL,
+ "measure_values--AST", NULL,
+ "measure_values--TB", NULL,
+ "measure_values--ALP", NULL,
+ "normal_col_low", NULL,
+ "normal_col_high", NULL,
+ "studyday_col",NULL,
+ "visit_col", NULL,
+ "visitn_col", NULL,
+ "filters", NULL,
+ "group_cols", NULL,
+ "baseline--value_col", NULL,
+ "baseline--values", list(),
+ "analysisFlag--value_col", NULL,
+ "analysisFlag--values", list(),
+ "x_options", c("ALT", "AST", "ALP"),
+ "y_options", c("TB", "ALP"),
+ "visit_window", 30,
+ "r_ratio_filter", TRUE,
+ "r_ratio_cut", 0,
+ "showTitle", TRUE,
+ "warningText", "Caution: This interactive graphic is not validated. Any clinical recommendations based on this tool should be confirmed using your organizations standard operating procedures."
+ )
+
+saveRDS(defaults, file="data-raw/defaults.rda")
diff --git a/data/adlbc.rda b/data/adlbc.rda
index aa28c2db..aea28611 100644
Binary files a/data/adlbc.rda and b/data/adlbc.rda differ
diff --git a/data/settingsMetadata.rda b/data/settingsMetadata.rda
index 525b0f1d..175251fa 100644
Binary files a/data/settingsMetadata.rda and b/data/settingsMetadata.rda differ
diff --git a/data/standardsMetadata.rda b/data/standardsMetadata.rda
index 4aaca682..638a5e66 100644
Binary files a/data/standardsMetadata.rda and b/data/standardsMetadata.rda differ
diff --git a/inst/htmlwidgets/eDISH.yaml b/inst/htmlwidgets/eDISH.yaml
index aa307410..17ad864a 100644
--- a/inst/htmlwidgets/eDISH.yaml
+++ b/inst/htmlwidgets/eDISH.yaml
@@ -4,11 +4,11 @@ dependencies:
src: htmlwidgets/lib/d3-3.5.17
script: d3.v3.min.js
- name: webcharts
- version: 1.11.1
- src: htmlwidgets/lib/webcharts-1.11.1
+ version: 1.11.3
+ src: htmlwidgets/lib/webcharts-1.11.3
script: webcharts.js
stylesheet: webcharts.css
- name: safety-eDish
- version: 0.16.2
- src: htmlwidgets/lib/safety-eDISH-0.16.2
+ version: 0.16.3
+ src: htmlwidgets/lib/safety-eDISH-0.16.3
script: safetyedish.js
diff --git a/inst/htmlwidgets/lib/safety-eDISH-0.16.2/safetyedish.js b/inst/htmlwidgets/lib/safety-eDISH-0.16.3/safetyedish.js
similarity index 99%
rename from inst/htmlwidgets/lib/safety-eDISH-0.16.2/safetyedish.js
rename to inst/htmlwidgets/lib/safety-eDISH-0.16.3/safetyedish.js
index 0ce8b7f1..03550241 100644
--- a/inst/htmlwidgets/lib/safety-eDISH-0.16.2/safetyedish.js
+++ b/inst/htmlwidgets/lib/safety-eDISH-0.16.3/safetyedish.js
@@ -2,8 +2,8 @@
typeof exports === 'object' && typeof module !== 'undefined'
? (module.exports = factory(require('webcharts')))
: typeof define === 'function' && define.amd
- ? define(['webcharts'], factory)
- : (global.safetyedish = factory(global.webCharts));
+ ? define(['webcharts'], factory)
+ : (global.safetyedish = factory(global.webCharts));
})(this, function(webcharts) {
'use strict';
@@ -217,8 +217,8 @@
studyday_col: 'DY',
value_col: 'STRESN',
measure_col: 'TEST',
- normal_col_low: 'STNRLO',
normal_col_high: 'STNRHI',
+ normal_col_low: null,
visit_col: null,
visitn_col: null,
group_cols: null,
@@ -407,8 +407,8 @@
label: filter.label
? filter.label
: filter.value_col
- ? filter.value_col
- : filter
+ ? filter.value_col
+ : filter
};
if (
@@ -432,8 +432,8 @@
label: group.label
? group.label
: group.value_col
- ? group.value_col
- : filter
+ ? group.value_col
+ : filter
};
if (
defaultDetails.find(function(f) {
@@ -464,8 +464,8 @@
label: detail.label
? detail.label
: detail.value_col
- ? detail.value_col
- : detail
+ ? detail.value_col
+ : detail
});
});
settings.details = defaultDetails;
@@ -718,8 +718,8 @@
label: filter.label
? filter.label
: filter.value_col
- ? filter.value_col
- : filter
+ ? filter.value_col
+ : filter
};
return filter;
});
@@ -922,7 +922,7 @@
/////////////////////////
// Remove invalid rows
/////////////////////////
- var numerics = ['value_col', 'studyday_col', 'normal_col_low', 'normal_col_high'];
+ var numerics = ['value_col', 'studyday_col', 'normal_col_high'];
chart.imputed_data = chart.initial_data.filter(function(f) {
return true;
});
@@ -1864,10 +1864,10 @@
config.display == 'relative_uln'
? ' [xULN]'
: config.display == 'relative_baseline'
- ? ' [xBaseline]'
- : config.display == 'absolute'
- ? ' [raw values]'
- : null;
+ ? ' [xBaseline]'
+ : config.display == 'absolute'
+ ? ' [raw values]'
+ : null;
//Update axis labels.
config.x.label = config.measure_values[config.x.column] + unit;
@@ -2848,10 +2848,12 @@
visitn: config.visitn_col ? +m[config.visitn_col] : null,
studyday: +m[config.studyday_col],
value: +m[config.value_col],
- lln: +m[config.normal_col_low],
+ lln: config.normal_col_low ? +m[config.normal_col_low] : null,
uln: +m[config.normal_col_high],
population_extent: measureObj.population_extent,
- outlier_low: +m[config.value_col] < +m[config.normal_col_low],
+ outlier_low: config.normal_col_low
+ ? +m[config.value_col] < +m[config.normal_col_low]
+ : null,
outlier_high: +m[config.value_col] > +m[config.normal_col_high]
};
obj.outlier = obj.outlier_low || obj.outlier_high;
@@ -3240,10 +3242,10 @@
([0, 4, 5, 6, 7, 8, 9].indexOf(lastDigit) > -1
? 'th'
: lastDigit === 3
- ? 'rd'
- : lastDigit === 2
- ? 'nd'
- : 'st');
+ ? 'rd'
+ : lastDigit === 2
+ ? 'nd'
+ : 'st');
return text;
})
.join(' and ') +
@@ -3673,7 +3675,7 @@
.style('font-size', '0.7em')
.style('padding-top', '0.1em')
.text(
- 'Points are shown for values above the current reference value. Mouseover a line to see the reference line for that lab.'
+ 'Points are filled for values above the current reference value. Mouseover a line to see the reference line for that lab.'
);
}
@@ -3745,10 +3747,10 @@
config.display == 'relative_uln'
? 'Values are plotted as multiples of the upper limit of normal for the measure.'
: config.display == 'relative_baseline'
- ? "Values are plotted as multiples of the partipant's baseline value for the measure."
- : config.display == 'absolute'
- ? ' Values are plotted using the raw units for the measure.'
- : null;
+ ? "Values are plotted as multiples of the partipant's baseline value for the measure."
+ : config.display == 'absolute'
+ ? ' Values are plotted using the raw units for the measure.'
+ : null;
var axisLabels = chart.svg
.selectAll('.axis')
diff --git a/inst/htmlwidgets/lib/webcharts-1.11.1/webcharts.css b/inst/htmlwidgets/lib/webcharts-1.11.3/webcharts.css
similarity index 99%
rename from inst/htmlwidgets/lib/webcharts-1.11.1/webcharts.css
rename to inst/htmlwidgets/lib/webcharts-1.11.3/webcharts.css
index cc3fcb48..a64215a3 100644
--- a/inst/htmlwidgets/lib/webcharts-1.11.1/webcharts.css
+++ b/inst/htmlwidgets/lib/webcharts-1.11.3/webcharts.css
@@ -1,4 +1,3 @@
- @import url(//fonts.googleapis.com/css?family=Open+Sans:400,300);
/*------------------------------------------------------------------------------------------------\
Small Multiple Layout
\------------------------------------------------------------------------------------------------*/
diff --git a/inst/htmlwidgets/lib/webcharts-1.11.1/webcharts.js b/inst/htmlwidgets/lib/webcharts-1.11.3/webcharts.js
similarity index 99%
rename from inst/htmlwidgets/lib/webcharts-1.11.1/webcharts.js
rename to inst/htmlwidgets/lib/webcharts-1.11.3/webcharts.js
index 51a61ca2..e6fe9061 100644
--- a/inst/htmlwidgets/lib/webcharts-1.11.1/webcharts.js
+++ b/inst/htmlwidgets/lib/webcharts-1.11.3/webcharts.js
@@ -4,9 +4,9 @@
: typeof define === 'function' && define.amd
? define(['d3'], factory)
: (global.webCharts = factory(global.d3));
-})(this, function(d3) {
+})(typeof self !== 'undefined' ? self : this, function(d3) {
'use strict';
- var version = '1.11.1';
+ var version = '1.11.3';
function init(data) {
var _this = this;
@@ -433,7 +433,7 @@
return f instanceof Date;
});
})
- .entries(this.raw_data)
+ .entries(this.filtered_data)
.sort(function(a, b) {
return d3.min(b.values) - d3.min(a.values);
})
@@ -1592,7 +1592,7 @@
}
function makeLegend() {
- var scale$$1 = arguments.length > 0 && arguments[0] !== undefined
+ var scale = arguments.length > 0 && arguments[0] !== undefined
? arguments[0]
: this.colorScale;
var label = arguments.length > 1 && arguments[1] !== undefined ? arguments[1] : '';
@@ -1638,7 +1638,7 @@
var legend_data =
custom_data ||
- scale$$1
+ scale
.domain()
.slice(0)
.filter(function(f) {
@@ -1670,7 +1670,7 @@
.attr('class', 'legend-item')
.style({ 'list-style-type': 'none', 'margin-right': '1em' });
new_parts.append('span').attr('class', 'legend-mark-text').style('color', function(d) {
- return scale$$1(d.label);
+ return scale(d.label);
});
new_parts
.append('svg')
@@ -1695,16 +1695,16 @@
leg_parts.selectAll('.legend-color-block').select('.legend-mark').remove();
leg_parts.selectAll('.legend-color-block').each(function(e) {
- var svg$$1 = d3.select(this);
+ var svg = d3.select(this);
if (e.mark === 'circle') {
- svg$$1.append('circle').attr({
+ svg.append('circle').attr({
cx: '.5em',
cy: '.5em',
r: '.45em',
class: 'legend-mark'
});
} else if (e.mark === 'line') {
- svg$$1.append('line').attr({
+ svg.append('line').attr({
x1: 0,
y1: '.5em',
x2: '1em',
@@ -1714,7 +1714,7 @@
class: 'legend-mark'
});
} else if (e.mark === 'square') {
- svg$$1.append('rect').attr({
+ svg.append('rect').attr({
height: '1em',
width: '1em',
class: 'legend-mark',
@@ -1726,10 +1726,10 @@
.selectAll('.legend-color-block')
.select('.legend-mark')
.attr('fill', function(d) {
- return d.color || scale$$1(d.label);
+ return d.color || scale(d.label);
})
.attr('stroke', function(d) {
- return d.color || scale$$1(d.label);
+ return d.color || scale(d.label);
})
.each(function(e) {
d3.select(this).attr(e.attributes);
@@ -1743,7 +1743,7 @@
return d.label;
});
- if (scale$$1.domain().length > 0) {
+ if (scale.domain().length > 0) {
var legendDisplay = (this.config.legend.location === 'bottom' ||
this.config.legend.location === 'top') &&
!this.parent
@@ -3335,8 +3335,8 @@
}
/*------------------------------------------------------------------------------------------------\
- Check equality of two arrays (https://stackoverflow.com/questions/7837456/how-to-compare-arrays-in-javascript)
-\------------------------------------------------------------------------------------------------*/
+ Check equality of two arrays (https://stackoverflow.com/questions/7837456/how-to-compare-arrays-in-javascript)
+ \------------------------------------------------------------------------------------------------*/
// Warn if overriding existing method
if (Array.prototype.equals)
@@ -3782,6 +3782,7 @@
}
function layout$4() {
+ //Add sort container.
this.sortable.wrap = this.wrap
.select('.table-top')
.append('div')
@@ -3970,8 +3971,8 @@
if (next >= this.config.nPages) next = this.config.nPages - 1; // nothing after the last page
/**-------------------------------------------------------------------------------------------\
- Left side
- \-------------------------------------------------------------------------------------------**/
+ Left side
+ \-------------------------------------------------------------------------------------------**/
this.pagination.wrap
.insert('span', ':first-child')
@@ -3998,8 +3999,8 @@
.text('<<');
/**-------------------------------------------------------------------------------------------\
- Right side
- \-------------------------------------------------------------------------------------------**/
+ Right side
+ \-------------------------------------------------------------------------------------------**/
this.pagination.wrap
.append('span')
@@ -4353,8 +4354,8 @@
this.events.onDatatransform.call(this);
/**-------------------------------------------------------------------------------------------\
- Code below associated with the former paradigm of a d3.nest() data array.
- \-------------------------------------------------------------------------------------------**/
+ Code below associated with the former paradigm of a d3.nest() data array.
+ \-------------------------------------------------------------------------------------------**/
if (config.row_per) {
var rev_order = config.row_per.slice(0).reverse();
diff --git a/man/generateSettings.Rd b/man/generateSettings.Rd
index f4bb5e9c..2c14b94e 100644
--- a/man/generateSettings.Rd
+++ b/man/generateSettings.Rd
@@ -4,17 +4,22 @@
\alias{generateSettings}
\title{Generate a settings object based on a data standard}
\usage{
-generateSettings(standard = "None", chart = "eDish", partial = FALSE,
- partial_keys = NULL)
+generateSettings(standard = "None", charts = NULL,
+ useDefaults = TRUE, partial = FALSE, partial_keys = NULL,
+ custom_settings = NULL)
}
\arguments{
-\item{standard}{The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"SDTM"}}
+\item{standard}{The data standard for which to create settings. Valid options are "SDTM", "AdAM" or "None". Default: \code{"None"}.}
-\item{chart}{The chart for which standards should be generated ("eDish" only for now) . Default: \code{"eDish"}.}
+\item{charts}{The chart or chart(s) for which settings should be generated. Default: \code{NULL} (uses all available charts).}
+
+\item{useDefaults}{Specifies whether default values from settingsMetadata should be included in the settings object. Default: \code{TRUE}.}
\item{partial}{Boolean for whether or not the standard is a partial standard. Default: \code{FALSE}.}
\item{partial_keys}{Optional character vector of the matched settings if partial is TRUE. Settings should be identified using the text_key format described in ?settingsMetadata. Setting is ignored when partial is FALSE. Default: \code{NULL}.}
+
+\item{custom_settings}{a tibble with text_key and customValue columns specifiying customizations to be applied to the settings object. Default: \code{NULL}.}
}
\value{
A list containing the appropriate settings for the selected chart
diff --git a/man/generateShell.Rd b/man/generateShell.Rd
new file mode 100644
index 00000000..d66a4d57
--- /dev/null
+++ b/man/generateShell.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/generateShell.R
+\name{generateShell}
+\alias{generateShell}
+\title{Generate a default settings shell based on settings metadata}
+\usage{
+generateShell(charts = NULL)
+}
+\arguments{
+\item{charts}{The chart or chart(s) to include in the shell settings object}
+}
+\value{
+A list containing a setting shell (all values = NA) for the selected chart(s)
+}
+\description{
+This function returns a default settings object based on the chart(s) specified.
+}
+\details{
+The function is designed to work with valid safetyGraphics charts.
+}
+\examples{
+
+safetyGraphics:::generateShell(charts = "eDish")
+
+}
+\keyword{internal}
diff --git a/man/setSettingsValue.Rd b/man/setSettingsValue.Rd
index 250bc4c4..dcced802 100644
--- a/man/setSettingsValue.Rd
+++ b/man/setSettingsValue.Rd
@@ -4,7 +4,7 @@
\alias{setSettingsValue}
\title{Set the value for a given named parameter}
\usage{
-setSettingsValue(key, value, settings)
+setSettingsValue(key, value, settings, forceCreate = FALSE)
}
\arguments{
\item{key}{a list (like those provided by \code{getSettingKeys()}) defining the position of parameter in the settings object.}
@@ -12,6 +12,8 @@ setSettingsValue(key, value, settings)
\item{value}{the value to set}
\item{settings}{The settings list used to generate a chart like \code{eDISH()}}
+
+\item{forceCreate}{Specifies whether the function should create a new list() when none exisits. This most commonly occurs when deeply nested objects.}
}
\value{
the updated settings object
diff --git a/man/settingsMetadata.Rd b/man/settingsMetadata.Rd
index 7574fe69..dcadfa89 100644
--- a/man/settingsMetadata.Rd
+++ b/man/settingsMetadata.Rd
@@ -17,6 +17,7 @@
\item{field_mapping}{Flag indicating whether the setting corresponds to a field-level mapping in the data}
\item{field_column_key}{Key for the column that provides options for the field-level mapping in the data}
\item{setting_cat}{Setting category (data, measure, appearance)}
+ \item{default}{Default value for non-data settings}
}}
\source{
Created for this package
diff --git a/tests/testthat/test_generateSettings.R b/tests/testthat/test_generateSettings.R
index 78dbc96b..f99a356c 100644
--- a/tests/testthat/test_generateSettings.R
+++ b/tests/testthat/test_generateSettings.R
@@ -5,19 +5,17 @@ setting_names<-c("id_col","value_col","measure_col","normal_col_low","normal_col
test_that("a list with the expected properties and structure is returned for all standards",{
expect_is(generateSettings(standard="None"),"list")
- expect_named(generateSettings(standard="None"),setting_names)
- expect_named(generateSettings(standard="None")[["measure_values"]], c("ALT","AST","TB","ALP"))
+ expect_equal(sort(names(generateSettings(standard="None"))),sort(setting_names))
+ expect_equal(sort(names(generateSettings(standard="None")[["measure_values"]])), sort(c("ALT","AST","TB","ALP")))
expect_is(generateSettings(standard="ADaM"),"list")
- expect_named(generateSettings(standard="ADaM"),setting_names)
- expect_named(generateSettings(standard="ADaM")[["measure_values"]], c("ALT","AST","TB","ALP"))
-
+ expect_equal(sort(names(generateSettings(standard="ADaM"))),sort(setting_names))
+ expect_equal(sort(names(generateSettings(standard="ADaM")[["measure_values"]])), sort(c("ALT","AST","TB","ALP")))
expect_is(generateSettings(standard="SDTM"),"list")
- expect_named(generateSettings(standard="SDTM"),setting_names)
- expect_named(generateSettings(standard="SDTM")[["measure_values"]], c("ALT","AST","TB","ALP"))
-})
+ expect_equal(sort(names(generateSettings(standard="SDTM"))),sort(setting_names))
+ expect_equal(sort(names(generateSettings(standard="SDTM")[["measure_values"]])), sort(c("ALT","AST","TB","ALP")))})
-test_that("a warning is thrown if chart isn't eDish",{
+test_that("a warning is thrown if chart isn't found in the chart list",{
expect_error(generateSettings(chart="aeexplorer"))
expect_error(generateSettings(chart=""))
expect_silent(generateSettings(chart="eDish"))
@@ -30,13 +28,13 @@ test_that("data mappings are null when setting=none, character otherwise",{
none_settings <- generateSettings(standard="None")
for(text_key in data_setting_keys){
key<-textKeysToList(text_key)[[1]]
- expect_null(getSettingValue(settings=none_settings,key=key))
+ expect_equal(getSettingValue(settings=none_settings,key=key),NULL)
}
other_settings <- generateSettings(standard="a different standard")
for(text_key in data_setting_keys){
key<-textKeysToList(text_key)[[1]]
- expect_null(getSettingValue(settings=other_settings,key=key))
+ expect_equal(getSettingValue(settings=other_settings,key=key),NULL)
}
sdtm_settings <- generateSettings(standard="SDTM")
@@ -73,7 +71,7 @@ test_that("data mappings are null when setting=none, character otherwise",{
if (text_key %in% c("id_col","measure_col","measure_values--ALT")) {
expect_is(getSettingValue(settings=partial_adam_settings,key=key),"character")
} else {
- expect_null(getSettingValue(settings=partial_adam_settings,key=key))
+ expect_equal(getSettingValue(settings=partial_adam_settings,key=key),NULL)
}
}
@@ -86,4 +84,28 @@ test_that("data mappings are null when setting=none, character otherwise",{
#Testing failure when partial is true with no specified columns
expect_error(partial_settings_no_cols <- generateSettings(standard="ADaM", partial=TRUE))
+
+ #Test useDefaults
+ noDefaults <- generateSettings(standard="adam",useDefaults=FALSE)
+ option_keys<-c("x_options", "y_options", "visit_window", "r_ratio_filter", "r_ratio_cut", "showTitle", "warningText")
+
+ #non data mappings are NA
+ for(text_key in option_keys){
+ key<-textKeysToList(text_key)[[1]]
+ expect_equal(getSettingValue(settings=noDefaults,key=key),NULL)
+ }
+
+ #data mappings are filled as expected
+ for(text_key in data_setting_keys){
+ key<-textKeysToList(text_key)[[1]]
+ expect_is(getSettingValue(settings=noDefaults,key=key),"character")
+ }
+
+ #Test customSettings
+ customizations<- tibble(text_key=c("id_col","warningText","measure_values--ALT"),customValue=c("customID","This is a custom warning","custom ALT"))
+ customSettings<-generateSettings(standard="adam",custom_settings=customizations)
+ expect_equal(getSettingValue(settings=customSettings,key=list("id_col")),"customID")
+ expect_equal(getSettingValue(settings=customSettings,key=list("warningText")),"This is a custom warning")
+ expect_equal(getSettingValue(settings=customSettings,key=list("measure_values","ALT")),"custom ALT")
+ expect_equal(getSettingValue(settings=customSettings,key=list("measure_col")),"PARAM")
})
diff --git a/tests/testthat/test_generateShell.R b/tests/testthat/test_generateShell.R
new file mode 100644
index 00000000..f0dbbba7
--- /dev/null
+++ b/tests/testthat/test_generateShell.R
@@ -0,0 +1,13 @@
+context("Tests for the generateShell() function")
+library(safetyGraphics)
+
+default <- generateShell()
+
+test_that("a list with the expected properties and structure is returned by default",{
+ expect_type(default, "list")
+ expect_equal(default[["id_col"]],NULL)
+ expect_equal(default[["measure_values"]][["ALT"]],NULL)
+ expect_null(default[["not_a_setting"]])
+})
+
+# TODO: Add tests for the charts parameter once multiple charts are added
\ No newline at end of file
diff --git a/tests/testthat/test_getRequiredSettings.R b/tests/testthat/test_getRequiredSettings.R
index b1d463cc..ea3fed4a 100644
--- a/tests/testthat/test_getRequiredSettings.R
+++ b/tests/testthat/test_getRequiredSettings.R
@@ -4,15 +4,15 @@ library(testthat)
defaultRequiredSettings <- list(
list("id_col"),
- list("value_col"),
list("measure_col"),
+ list("measure_values","ALP"),
list("measure_values","ALT"),
list("measure_values","AST"),
list("measure_values","TB"),
- list("measure_values","ALP"),
- list("normal_col_low"),
list("normal_col_high"),
- list("studyday_col")
+ list("normal_col_low"),
+ list("studyday_col"),
+ list("value_col")
)
diff --git a/tests/testthat/test_getSettingValue.R b/tests/testthat/test_getSettingValue.R
index 59f5ac00..ea32427a 100644
--- a/tests/testthat/test_getSettingValue.R
+++ b/tests/testthat/test_getSettingValue.R
@@ -14,7 +14,7 @@ test_that("different data types for `key` parameter work as expected",{
expect_equal(getSettingValue(key="id_col",settings=testSettings),"USUBJID")
expect_equal(getSettingValue(key=c("measure_values","ALT"),settings=testSettings),"Aminotransferase, alanine (ALT)")
expect_equal(getSettingValue(key=list("measure_values","ALT"),settings=testSettings),"Aminotransferase, alanine (ALT)")
- expect_equal(getSettingValue(key=list("measure_values",1),settings=testSettings),"Aminotransferase, alanine (ALT)")
+ expect_equal(getSettingValue(key=list("measure_values",2),settings=testSettings),"Aminotransferase, alanine (ALT)")
})
test_that("returns null if the setting isn't found",{