From 3dc1dc3fa31261a282f743f140d11378a70c3960 Mon Sep 17 00:00:00 2001 From: Preston Burns Date: Wed, 20 Feb 2019 10:14:14 -0500 Subject: [PATCH 1/7] fix analysisFlag values warning --- inst/eDISH_app/modules/renderSettings/renderSettings.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/eDISH_app/modules/renderSettings/renderSettings.R b/inst/eDISH_app/modules/renderSettings/renderSettings.R index 3c6aa6d9..41e62c3f 100644 --- a/inst/eDISH_app/modules/renderSettings/renderSettings.R +++ b/inst/eDISH_app/modules/renderSettings/renderSettings.R @@ -213,7 +213,7 @@ renderSettings <- function(input, output, session, data, settings, status){ } if (! is.null(input$`analysisFlag--values`)){ - if (! input$`analysisFlag--values`==""){ + if (! input$`analysisFlag--values`[1]==""){ settings$analysisFlag <- list(value_col = input$`analysisFlag--value_col`, values = input$`analysisFlag--values`) } From f6a62653cfbf0c895beb8097fcd85bd0a2d58ca1 Mon Sep 17 00:00:00 2001 From: Preston Burns Date: Wed, 20 Feb 2019 15:49:59 -0500 Subject: [PATCH 2/7] temporary bug fix and added test --- R/validateSettings.R | 30 +++++++++++++++++++------ data-raw/settingsMetadata.csv | 6 ++--- data/settingsMetadata.rda | Bin 1952 -> 1955 bytes tests/testthat/test_validateSettings.R | 14 ++++++++++++ 4 files changed, 40 insertions(+), 10 deletions(-) diff --git a/R/validateSettings.R b/R/validateSettings.R index fd5af710..cc15c422 100644 --- a/R/validateSettings.R +++ b/R/validateSettings.R @@ -39,16 +39,32 @@ validateSettings <- function(data, settings, chart="eDish"){ - + settingStatus<-list() - + # Check that all required parameters are not null requiredChecks <- getRequiredSettings(chart = chart) %>% purrr::map(checkRequired, settings = settings) - + #Check that non-null setting columns are found in the data dataKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = "text_key")%>%textKeysToList() + + # Add filters and group_cols to dataKeys manually as temporary fix - they are no longer True for column_mapping in settingsMetadata + if (length(settings$filters) > 0) { + for (i in 1:length(settings$filters)){ + dataKeys[[1+length(dataKeys)]] <- list("filters",i,"value_col") + } + + } + + if (length(settings$filters) > 0) { + for (i in 1:length(settings$filters)){ + dataKeys[[1+length(dataKeys)]] <- list("filters",i,"value_col") + } + + } + columnChecks <- dataKeys %>% purrr::map(checkColumn, settings=settings, data=data) - + #Check that non-null field/column combinations are found in the data fieldKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$field_mapping)%>% filter(.data$setting_type!="vector")%>% #TODO: check the vectorized fields as well. Not sure a big deal now, since none are required ... @@ -56,7 +72,7 @@ validateSettings <- function(data, settings, chart="eDish"){ unlist()%>% textKeysToList() fieldChecks <- fieldKeys %>% purrr::map(checkField, settings=settings, data=data ) - + #Check that settings for mapping numeric data are associated with numeric columns numericKeys <- getSettingsMetadata(charts=chart, filter_expr=.data$column_type=="numeric", cols="text_key")%>%textKeysToList() numericChecks <- numericKeys %>% purrr::map(checkNumeric, settings=settings, data=data ) @@ -76,10 +92,10 @@ validateSettings <- function(data, settings, chart="eDish"){ #valid=true if all checks pass, false otherwise settingStatus$valid <- settingStatus$checks%>%select(.data$valid)%>%unlist%>%all - + #create summary string failCount <- nrow(settingStatus$checks%>%filter(!.data$valid)) checkCount <- nrow(settingStatus$checks) settingStatus$status <- paste0(failCount," of ",checkCount," checks failed.") return (settingStatus) -} +} \ No newline at end of file diff --git a/data-raw/settingsMetadata.csv b/data-raw/settingsMetadata.csv index ce95c2f3..e1f8c434 100644 --- a/data-raw/settingsMetadata.csv +++ b/data-raw/settingsMetadata.csv @@ -7,8 +7,8 @@ TRUE,normal_col_high,Upper Limit of Normal column,Upper limit of normal variable TRUE,studyday_col,Study Day column,Visit day variable name,character,TRUE,TRUE,numeric,FALSE,,ADY,DY TRUE,visit_col,Visit column,Visit variable name,character,FALSE,TRUE,character,FALSE,,VISIT,VISIT TRUE,visitn_col,Visit Number column,Visit number variable name,character,FALSE,TRUE,numeric,FALSE,,VISITNUM,VISITNUM -TRUE,filters,Filters columns,"An optional list of specifications for filters. Each filter is a nested, named list (containing the filter value column: 'value_col' and associated label: 'label') within the larger list.",vector,FALSE,TRUE,NA,FALSE,,, -TRUE,group_cols,Group columns,"An optional list of specifications for grouping columns. Each group column is a nested, named list (containing the group variable column: 'value_col' and associated label: 'label') within the larger list. ",vector,FALSE,TRUE,NA,FALSE,,, +TRUE,filters,Filters columns,"An optional list of specifications for filters. Each filter is a nested, named list (containing the filter value column: 'value_col' and associated label: 'label') within the larger list.",vector,FALSE,FALSE,NA,FALSE,,, +TRUE,group_cols,Group columns,"An optional list of specifications for grouping columns. Each group column is a nested, named list (containing the group variable column: 'value_col' and associated label: 'label') within the larger list. ",vector,FALSE,FALSE,NA,FALSE,,, TRUE,measure_values--ALT,Alanine Aminotransferase value,Value used for Alanine Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Alanine Aminotransferase (U/L),"Aminotransferase, alanine (ALT)" TRUE,measure_values--AST,Aspartate Aminotransferase value,Value used for Aspartate Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Aspartate Aminotransferase (U/L),"Aminotransferase, aspartate (AST)" TRUE,measure_values--TB,Total Bilirubin value,Value used for Total Bilirubin in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Bilirubin (umol/L),Total Bilirubin @@ -23,4 +23,4 @@ TRUE,visit_window,Default Visit Window in Days ,Default visit window used to hig TRUE,r_ratio_filter,Show R Ratio Filter?,Specifies whether the R Ratio filter should be shown. R ratio is defined as: (ALT value/ULN for ALT) / (ALP value/ULN for ALP).,logical,FALSE,FALSE,NA,FALSE,,, TRUE,r_ratio_cut,Default R Ratio Cut,Default cut point for R Ratio filter. Ignored when r_ratio_filter = FALSE. User can update this setting via the UI when r_ratio_filter = TRUE. ,numeric,FALSE,FALSE,NA,FALSE,,, TRUE,showTitle,Show Chart Title? ,Specifies whether the title should be drawn above the controls.,logical,FALSE,FALSE,NA,FALSE,,, -TRUE,warningText,Warning text,"Informational text to be displayed near the top of the controls (beneath the title, if any). No warning is displayed if warningText = ''. ",Character,FALSE,FALSE,NA,FALSE,,, \ No newline at end of file +TRUE,warningText,Warning text,"Informational text to be displayed near the top of the controls (beneath the title, if any). No warning is displayed if warningText = ''. ",Character,FALSE,FALSE,NA,FALSE,,, diff --git a/data/settingsMetadata.rda b/data/settingsMetadata.rda index c70c9c65635c9e1653236e721fe5a9073d45f8ee..132c7566b02c6ae1628b34c062b79b57d0109737 100644 GIT binary patch delta 1943 zcmV;I2Wa@952FteLRx4!F+o`-Q&~!(JLzQm_~pGo}e-S2Glgsrhs~fs5YmlB_lwZ8i0*Qq5+`tfEoY;K+p}S&^C}7032v& zXlMq2#0>$E00x=>8Uc_101R=Vp`oA}0}wO@KmZzO0B8n4001$@hK7cKXbeEm82|uj zpaGy6e*gdg!bE`q0EUKynr#I=C#mgF^HB{wOf@}5Mu2*ZjWht!>R!LJlICaz#xX1F zDFE1^puMCTT5K<+FmH~5XQhP=pfS9|RLKtmiXwH>Jlx(>ajOM8sPclc#CST2v~9io z(XHC4V|~Pgs^gDhiFn;&o0AoIr1ywkb=zzHf0K$~nY(JDLYHiOZHSc_>!_halUFQ- z6MN*3VlQHi(viX-nlshMuRT>*ONu~o)1Ez%5}rlm-t}P5DN$S&(~NJ18I_dKHTHE(N{m;Ior{UVnT5qR zL4HLODiCNJ{UN&O6v}Fu1t*I^e|A=~2>ChfG0ewNlZ4`BkxVwpywi`LL)J>t z5aFhStEG)K9-_t!6^_@Lq;})1B@%<9Xd|G*oGT2nYi;C+EZdJ%JXdhE+awz?Je%h7 zxb_UfFQ|bm1{#g<=J*Vj+TjgyM&HIG_V81zXoW!0JdFZ3jfiUuct?O6e*#ePE1^P+ zl1T-ogwZUF#L92eTqqpP(N$_k=dMZ^>7E@Pp;MVz?BYv@t zo>&kIoL64D=1GFJu8*h88jobekwE;nDOwFw5!$6lW&K8<0x|lb>KEO+W1eI6Tz6IwU>p#9EAL#f;8+o z0$3hnxq+Dx>pN<7p6nuM?9F=-B$V~0&bCNok5To|+=bcyKq`jJTd^(gxENf4zjGLKptiS>hX+q`2G@bEyRmPiQ@) zZAA+uirN>_Wn`}vIFBIbJ3w=Z5E`?oLr@4@6&PSZv5^J^M5b#V+sX$Qs}|32J)bj_P~3rZ>S^*eWSQQ z(%XcB`uytv_y!a9_90|4UDKpF@{p4%gC-O@djhF_4ZhN6e7!pm4mR$5VN{E^DF(uZ zi3zR+L%s(-W1ZvH`uVE0W>K_%euqqJPYk#LG5Kru^NfAHxX;Nq}!nVUB=yugIU zkjNV#gUjhCbE2MwBd46+7#cJJn8;mRw-_rnF8D}BAv43TVQq^-FGyvO1du6^mQF?o zK(8H@5KSF}KI-`*Wd>*iAdrPM9P1X52QyKiu$cssxzR|_)smrMtAu#@WQ;IKvr4jv zJa7o0*lHk5fBAehJzjc&fuXjOya{4Vf*>NtAxRpT)AX>XaAG-n4wQ{!GinBbGQfG* zi3dtILA>TC zfRl(o#L&hx#)i=-AP&A3D5i050sx;VZp{`QFn}?Qf7dIiq?O4lj%$*TVi_Gj3tsj& zs|!Fz*U8K{gIghTP8C9BAb^sD*fTbCj4I03*W9wNqF}N~r6M=7#@|2Uc!7wf8rrdB zOct{r0;&!mp)|y1Ov%L3U4{kZTV}@ta}J$5=82a~x^^0%?wnpcEM}$^29=Bz;k|{1 zvpy?8eI_=1H+JmlQB892}7(8UVc*2Udm9Y6#F73)s>Vyfmslv#%hs1=V2E z?n!BoC)(jI9)SB}lX}Js8Wr7}xQT_`9`%5qfxysS;A?a!R*+toF2YptP>F7elC(j* dWyyLF90l!<@wcO+AV2?VMhKY;(Xaohj^ delta 1940 zcmV;F2W$AF51ia-DW000^zQ$*UQsBDu# zpwXZJ13&-`28M=#ko64%O%60PG&BQ1Vg`W700T_`4FJdh00ubF(9qBg0f-s{AOHiFM}w%VM%&}%jgHkz8}1|}R~$QJ zEr%Z#6I@vFT}lYqJ$d8zm|1VYvIb=FX!#jlb=iM}#O^&<8t-zgmN z1ks+p9hvK@!dwyqhMdw2IB}NUMQNQCxAE|Xfy%-3aVw4%lVCR3j(`T2r1dd$PJ#p& zq|znQ!{wB~FbeG(){d~kHj`c8@oK!92!RkLnF0o25kn~RXmF~9X$#*GA@#cQz!ql> zf2CB2L()7}lCj@ML~KL&#;C$s*#nj<61rbja-}@FzE6(~t*6g@*~Kj<^ip)jkb4rJ zJ0|qytqdQ;tlgXxcLN;#WCA^4Z3(d^z!PZ+F(6CJ;DQE&-(;8xDWQp^pEE)^*n7|O zFaw38k{d&50N4S05&?fEFVOxrASMGye@V0eZsyo8Lp=fVZib5T4RLYHtW*{-`Il?$ z_Akw8Jc(XEtji?uic{$e>pD_Qf2_R5vds0)p`YhVj`f+>&7rno8E!L_q77ZzOWJGu zYaop)D@g;ab(TcH51ZSyZ&6IfVvLgJ7V6eV#LP?<@u-f3_P4 z(_1cKx17LKFcmh;=DIDa>#0d8Vlf*wS4@i5p>k3ylbJ|us_7zDV%@R~hNn*lf_P(a z_Qx)F+Iq>)BKcI|*RRKAV7Bs?CeEP5@H1zJs$x`Pymauc2L@&r6x#*)6ilc=px?|J z?tx6ExsYjx7Xs<6p@iee;)T=Vf9fid%pj&GAbeRmQlNQR<07rMXnVnHmT7}A#F3uE z&{2a0+1oYzQ~j^b9wrHcTrZf!z4Z)oZp73Sd%tVx38iTpWWGX4iNz*`M}0%_i)`T!Hg2p6INw!`PI!a4=JA>}SSip*f)e^{|%kAp-) z0y7Zk&(Ux&96N()Sf^J|m@m?Bm^}k9Fd26=Mk&^<6>0JrS7{c79!Fsu{&O7^D6AJK zq~#|Jk&9BNZ=3c9T^<6s&_CpR1}KRkPsU!4pbqtEWI^d`;WJ5vKHz7lJ@&z*iY2=! z1$|C)$q4#P!oW)-brgyif1!AP>nL)Cc3?I(+V~HZ6Tz6IwikuL97Oyff;DY8f><8e z*ucz)`cEZJ+3vz7j}~jxi6p17Hg?$|l04_#LwXmB{{U4We#K<67=D{#g!rzcj?usn zkpn>3X(Gq7)o*2rw`Y9L^wej#H<{xnC~dY*y)c|M*mVV~E`&s;e|830NPu9fIms0n zUcUK!)WW0}tL|fvITy`faF-L!T0q)julTT(XodIctnm%()Ld@~xzvJ(7i2pq+=>=U z6}T^?%E?|WJCrLq&w!lEijgcYkadAwM3Xll$=DcPT{B?!UQjqZ__li?*)m{1I2_?{ z5<%DU!Z{Z>en(_9e~q7P9jOhVZ4F3)ZZ28*EOol+%)_=1bO*Y|`hq~0v~~y@Td!aMwuMi?YnrCCHB_ykaF zHIOEHJGDIif8{{H(YBMk31UowAR@;RNgCMG_?T0$F&v!-N=Ct%wF5wzU_HhnLc-y5 zw$TVX$RU?^vlvULI@ExG$sV_FT*xOK@?ugN)@TfRl(o z#L&hx#)i=-AP(O>iYc5NU_cY(4f&$OrVs`(zU6f_e-gPRam#X23_~NQ;A_i`>cY?? zbK>P3L9vjyrwXAmkU&X7Y#Ez6MipgiYwlTB%`jOc(vci&vAf*-?+`H*!(&z~iGtW; z>#CsO3KL95WXzmRCE_qIBHMPj8<=$J%as.character,"2 of 10288 values were not numeric. Records with non-numeric values may not appear in the graphic.") }) + +test_that("validateSettings works with filters and group_cols ",{ + groupFilterSettings <- validSettings + groupFilterSettings$filters <- list() + groupFilterSettings$filters[[1]] <- list(value_col = "RACE", + label = "RACE") + groupFilterSettings$group_cols <- list() + groupFilterSettings$group_cols[[1]] <- list(value_col = "SEX", + label = "SEX") + Passed<-validateSettings(data=adlbc,settings=groupFilterSettings) + expect_true(Passed[["valid"]]) +}) + + From 4b49257916cf0729531f8257a615f38c2cfbc21f Mon Sep 17 00:00:00 2001 From: Preston Burns Date: Wed, 20 Feb 2019 16:06:54 -0500 Subject: [PATCH 3/7] fix duplicate filters code --- R/validateSettings.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/validateSettings.R b/R/validateSettings.R index cc15c422..175699e4 100644 --- a/R/validateSettings.R +++ b/R/validateSettings.R @@ -56,9 +56,9 @@ validateSettings <- function(data, settings, chart="eDish"){ } - if (length(settings$filters) > 0) { - for (i in 1:length(settings$filters)){ - dataKeys[[1+length(dataKeys)]] <- list("filters",i,"value_col") + if (length(settings$group_cols) > 0) { + for (i in 1:length(settings$group_cols)){ + dataKeys[[1+length(dataKeys)]] <- list("group_cols",i,"value_col") } } From f2ae0c0515e09147ffad0a87f5b1d605c7ffa92a Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 21 Feb 2019 19:29:53 -0800 Subject: [PATCH 4/7] support vectors in field/column checks. fix #170 --- R/checkField.R | 18 +++++++-- R/checkFieldSettings.R | 48 ----------------------- R/trimData.R | 42 ++++++++++---------- R/validateSettings.R | 51 ++++++++++++++++--------- data-raw/settingsMetadata.csv | 6 +-- data/settingsMetadata.rda | Bin 1955 -> 1952 bytes man/checkField.Rd | 2 +- man/checkFieldSettings.Rd | 31 --------------- tests/testthat/test_validateSettings.R | 18 +++++---- 9 files changed, 82 insertions(+), 134 deletions(-) delete mode 100644 R/checkFieldSettings.R delete mode 100644 man/checkFieldSettings.Rd diff --git a/R/checkField.R b/R/checkField.R index ec6c48d6..5afb45c2 100644 --- a/R/checkField.R +++ b/R/checkField.R @@ -13,11 +13,11 @@ #' @examples #' testSettings<-generateSettings(standard="AdAM") #' fields<-list("measure_values","TB") -#' safetyGraphics:::checkFieldSettings(fieldKey=fields,settings=testSettings, data=adlbc) +#' safetyGraphics:::checkField(fieldKey=fields,settings=testSettings, data=adlbc) #' #' @keywords internal -checkFieldSettings <- function(fieldKey, settings, data){ +checkField <- function(fieldKey, settings, data){ stopifnot(typeof(fieldKey)=="list", typeof(settings)=="list") # Check to see that the field data specified in the seetings is found in the data @@ -29,12 +29,22 @@ checkFieldSettings <- function(fieldKey, settings, data){ fieldCheck$value <- getSettingValue(key=fieldCheck$key,settings=settings) #get the name of the column containing the field - columnTextKey<-getSettingsMetadata(cols="field_column_key",text_keys=fieldCheck$text_key) + lastKey <- fieldCheck$key[[length(fieldCheck$key)]] + + #use the parent metadata entry if the item is a vector + if(is.numeric(lastKey)){ + sub_key <- fieldKey[-length(fieldKey)] + sub_text_key <- paste(unlist(sub_key), collapse='--') + columnTextKey <-getSettingsMetadata(cols="field_column_key",text_keys=sub_text_key) + }else{ + columnTextKey <-getSettingsMetadata(cols="field_column_key",text_keys=fieldCheck$text_key) + } + columnKey<-textKeysToList(columnTextKey)[[1]] columnName<-getSettingValue(key=columnKey,settings=settings) if(length(fieldCheck$value)>0){ - fieldCheck$valid <- hasField(fieldValue=fieldCheck$value, columnName=columnName,data=data) + fieldCheck$valid <- hasField(fieldValue=fieldCheck$value, columnName=columnName,data=data) }else{ fieldCheck$value <- "--No Value Given--" fieldCheck$valid <- TRUE #null values are ok diff --git a/R/checkFieldSettings.R b/R/checkFieldSettings.R deleted file mode 100644 index ececcecc..00000000 --- a/R/checkFieldSettings.R +++ /dev/null @@ -1,48 +0,0 @@ -#' Check that a setting parameter has a matching data field -#' -#' Checks that a single parameter from the settings list matches a field value in a specified data set -#' -#' This function compares settings with field values as part of the \code{validateSettings()} function. More specifically, the function checks whether the \code{fieldKey} in a \code{settings} object matches a column/field combination in \code{"data"}. The function makes 2 major assumptions about the structure of the settings object. First, it assumes that the first value in fieldKey is "settingName_values" and there is a corresponding "settingName_col" setting that defines the column to search for field-level data. Second, it expects that the value specified by key/settings is a list, and that each value in the list is a field of the variable above. -#' -#' @param fieldKey a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object. -#' @param settings The settings list used to generate a chart like \code{eDISH()} -#' @param data A data frame to check for the specified field -#' @return A list containing the results of the check following the format specified in \code{validateSettings()[["checkList"]]} -#' -#' -#' @examples -#' testSettings<-generateSettings(standard="AdAM") -#' fields<-list("measure_values","TB") -#' safetyGraphics:::checkField(fieldKey=fields,settings=testSettings, data=adlbc) -#' -#' @importFrom stringr str_split -#' @importFrom magrittr "%>%" -#' @importFrom purrr map -#' @keywords internal - -checkField<- function(fieldKey, settings, data){ - stopifnot(typeof(fieldKey)=="list", typeof(settings)=="list") - - # Check to see that the field data specified in the seetings is found in the data - fieldCheck <- list() - fieldCheck$key<-fieldKey - fieldCheck$text_key<- paste( unlist(fieldKey), collapse='--') - fieldCheck$type <- "field" - fieldCheck$description <- "field value from setting found in data" - fieldCheck$value <- getSettingValue(key=fieldCheck$key,settings=settings) - - #get the name of the column containing the field - columnTextKey<-getSettingsMetadata(cols="field_column_key",text_keys=fieldCheck$text_key) - columnKey<-textKeysToList(columnTextKey)[[1]] - columnName<-getSettingValue(key=columnKey,settings=settings) - - if(length(fieldCheck$value)>0){ - fieldCheck$valid <- hasField(fieldValue=fieldCheck$value, columnName=columnName,data=data) - }else{ - fieldCheck$value <- "--No Value Given--" - fieldCheck$valid <- TRUE #null values are ok - } - fieldCheck$message <- ifelse(!fieldCheck$valid, paste0("Value of ",fieldCheck$value, " for '",fieldCheck$text_key,"' not found in ",columnName),"") - - return(fieldCheck) -} diff --git a/R/trimData.R b/R/trimData.R index 4ed44b52..8650bba2 100644 --- a/R/trimData.R +++ b/R/trimData.R @@ -8,33 +8,33 @@ #' #' @examples #' testSettings <- generateSettings(standard="adam") -#' safetyGraphics:::trimData(data=adlbc, settings=testSettings) -#' +#' safetyGraphics:::trimData(data=adlbc, settings=testSettings) +#' #' @importFrom dplyr filter -#' @importFrom purrr map +#' @importFrom purrr map #' @importFrom rlang parse_expr -#' +#' #' @keywords internal trimData <- function(data, settings){ - + ## Remove columns not in settings ## - + col_names <- colnames(data) settings_keys <- safetyGraphics::getSettingsMetadata(cols="text_key", filter_expr=column_mapping==TRUE) %>% str_split("--") - - settings_values <- map(settings_keys, function(x) {return(safetyGraphics:::getSettingValue(x, settings))}) - + + settings_values <- map(settings_keys, function(x) {return(getSettingValue(x, settings))}) + common_cols <- intersect(col_names,settings_values) - + data_subset <- select(data, unlist(common_cols)) - + ## Remove rows if baseline or analysisFlag is specified ## - + if(!is.null(settings[['baseline']][['value_col']]) | !is.null(settings[['analysisFlag']][['value_col']])) { - + # Create Baseline String baseline_string <- ifelse(!is.null(settings[['baseline']][['value_col']]), paste(settings[['baseline']][['value_col']], "%in% settings[['baseline']][['values']]"), @@ -44,19 +44,19 @@ trimData <- function(data, settings){ analysis_string <- ifelse(!is.null(settings[['analysisFlag']][['value_col']]), paste(settings[['analysisFlag']][['value_col']], "%in% settings[['analysisFlag']][['values']]"), "") - - # Include OR operator if both are specified + + # Include OR operator if both are specified operator <- ifelse(!is.null(settings[['baseline']][['value_col']]) & !is.null(settings[['analysisFlag']][['value_col']]), "|","") - + # Create filter string and make it an expression filter_string <- paste(baseline_string, operator, analysis_string) filter_expression <- parse_expr(filter_string) - + #Filter on baseline and analysisFlag - data_subset <- filter(data_subset, !!filter_expression) - - } - + data_subset <- filter(data_subset, !!filter_expression) + + } + return(data_subset) } diff --git a/R/validateSettings.R b/R/validateSettings.R index 175699e4..c04b6eee 100644 --- a/R/validateSettings.R +++ b/R/validateSettings.R @@ -46,31 +46,44 @@ validateSettings <- function(data, settings, chart="eDish"){ requiredChecks <- getRequiredSettings(chart = chart) %>% purrr::map(checkRequired, settings = settings) #Check that non-null setting columns are found in the data - dataKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = "text_key")%>%textKeysToList() + allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = c("text_key","setting_type")) + dataKeys <- allKeys %>% filter(setting_type !="vector") %>% pull(text_key) %>% textKeysToList() - # Add filters and group_cols to dataKeys manually as temporary fix - they are no longer True for column_mapping in settingsMetadata - if (length(settings$filters) > 0) { - for (i in 1:length(settings$filters)){ - dataKeys[[1+length(dataKeys)]] <- list("filters",i,"value_col") + # Add items in vectors to list individually + dataVectorKeys <- allKeys %>% filter(setting_type =="vector") %>% pull(text_key) %>% textKeysToList() + for(key in dataVectorKeys){ + current<-getSettingValue(key, settings=settings) + if (length(current) > 0 ) { + for (i in 1:length(current)){ + newKey <- key + newKey[[1+length(newKey)]]<-i + sub <- current[[i]] + if(typeof(sub)=="list"){ + newKey[[1+length(newKey)]]<-"value_col" + } + dataKeys[[1+length(dataKeys)]]<-newKey + } } - - } - - if (length(settings$group_cols) > 0) { - for (i in 1:length(settings$group_cols)){ - dataKeys[[1+length(dataKeys)]] <- list("group_cols",i,"value_col") - } - } columnChecks <- dataKeys %>% purrr::map(checkColumn, settings=settings, data=data) - + #Check that non-null field/column combinations are found in the data - fieldKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$field_mapping)%>% - filter(.data$setting_type!="vector")%>% #TODO: check the vectorized fields as well. Not sure a big deal now, since none are required ... - select(.data$text_key)%>% - unlist()%>% - textKeysToList() + allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$field_mapping, cols = c("text_key","setting_type")) + fieldKeys <- allKeys %>% filter(.data$setting_type!="vector")%>% pull(.data$text_key)%>%textKeysToList() + + #Add items in vectors to list individually + fieldVectorKeys <- allKeys %>% filter(.data$setting_type=="vector")%>% pull(.data$text_key)%>%textKeysToList() + for(key in fieldVectorKeys){ + current<-getSettingValue(key, settings=settings) + if (length(current) > 0 ) { + for (i in 1:length(current)){ + newKey <- key + newKey[[1+length(newKey)]]<-i + fieldKeys[[1+length(fieldKeys)]]<-newKey + } + } + } fieldChecks <- fieldKeys %>% purrr::map(checkField, settings=settings, data=data ) #Check that settings for mapping numeric data are associated with numeric columns diff --git a/data-raw/settingsMetadata.csv b/data-raw/settingsMetadata.csv index e1f8c434..ce95c2f3 100644 --- a/data-raw/settingsMetadata.csv +++ b/data-raw/settingsMetadata.csv @@ -7,8 +7,8 @@ TRUE,normal_col_high,Upper Limit of Normal column,Upper limit of normal variable TRUE,studyday_col,Study Day column,Visit day variable name,character,TRUE,TRUE,numeric,FALSE,,ADY,DY TRUE,visit_col,Visit column,Visit variable name,character,FALSE,TRUE,character,FALSE,,VISIT,VISIT TRUE,visitn_col,Visit Number column,Visit number variable name,character,FALSE,TRUE,numeric,FALSE,,VISITNUM,VISITNUM -TRUE,filters,Filters columns,"An optional list of specifications for filters. Each filter is a nested, named list (containing the filter value column: 'value_col' and associated label: 'label') within the larger list.",vector,FALSE,FALSE,NA,FALSE,,, -TRUE,group_cols,Group columns,"An optional list of specifications for grouping columns. Each group column is a nested, named list (containing the group variable column: 'value_col' and associated label: 'label') within the larger list. ",vector,FALSE,FALSE,NA,FALSE,,, +TRUE,filters,Filters columns,"An optional list of specifications for filters. Each filter is a nested, named list (containing the filter value column: 'value_col' and associated label: 'label') within the larger list.",vector,FALSE,TRUE,NA,FALSE,,, +TRUE,group_cols,Group columns,"An optional list of specifications for grouping columns. Each group column is a nested, named list (containing the group variable column: 'value_col' and associated label: 'label') within the larger list. ",vector,FALSE,TRUE,NA,FALSE,,, TRUE,measure_values--ALT,Alanine Aminotransferase value,Value used for Alanine Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Alanine Aminotransferase (U/L),"Aminotransferase, alanine (ALT)" TRUE,measure_values--AST,Aspartate Aminotransferase value,Value used for Aspartate Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Aspartate Aminotransferase (U/L),"Aminotransferase, aspartate (AST)" TRUE,measure_values--TB,Total Bilirubin value,Value used for Total Bilirubin in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Bilirubin (umol/L),Total Bilirubin @@ -23,4 +23,4 @@ TRUE,visit_window,Default Visit Window in Days ,Default visit window used to hig TRUE,r_ratio_filter,Show R Ratio Filter?,Specifies whether the R Ratio filter should be shown. R ratio is defined as: (ALT value/ULN for ALT) / (ALP value/ULN for ALP).,logical,FALSE,FALSE,NA,FALSE,,, TRUE,r_ratio_cut,Default R Ratio Cut,Default cut point for R Ratio filter. Ignored when r_ratio_filter = FALSE. User can update this setting via the UI when r_ratio_filter = TRUE. ,numeric,FALSE,FALSE,NA,FALSE,,, TRUE,showTitle,Show Chart Title? ,Specifies whether the title should be drawn above the controls.,logical,FALSE,FALSE,NA,FALSE,,, -TRUE,warningText,Warning text,"Informational text to be displayed near the top of the controls (beneath the title, if any). No warning is displayed if warningText = ''. ",Character,FALSE,FALSE,NA,FALSE,,, +TRUE,warningText,Warning text,"Informational text to be displayed near the top of the controls (beneath the title, if any). No warning is displayed if warningText = ''. ",Character,FALSE,FALSE,NA,FALSE,,, \ No newline at end of file diff --git a/data/settingsMetadata.rda b/data/settingsMetadata.rda index 132c7566b02c6ae1628b34c062b79b57d0109737..c70c9c65635c9e1653236e721fe5a9073d45f8ee 100644 GIT binary patch delta 1940 zcmV;F2W$AF51ia-DW000^zQ$*UQsBDu# zpwXZJ13&-`28M=#ko64%O%60PG&BQ1Vg`W700T_`4FJdh00ubF(9qBg0f-s{AOHiFM}w%VM%&}%jgHkz8}1|}R~$QJ zEr%Z#6I@vFT}lYqJ$d8zm|1VYvIb=FX!#jlb=iM}#O^&<8t-zgmN z1ks+p9hvK@!dwyqhMdw2IB}NUMQNQCxAE|Xfy%-3aVw4%lVCR3j(`T2r1dd$PJ#p& zq|znQ!{wB~FbeG(){d~kHj`c8@oK!92!RkLnF0o25kn~RXmF~9X$#*GA@#cQz!ql> zf2CB2L()7}lCj@ML~KL&#;C$s*#nj<61rbja-}@FzE6(~t*6g@*~Kj<^ip)jkb4rJ zJ0|qytqdQ;tlgXxcLN;#WCA^4Z3(d^z!PZ+F(6CJ;DQE&-(;8xDWQp^pEE)^*n7|O zFaw38k{d&50N4S05&?fEFVOxrASMGye@V0eZsyo8Lp=fVZib5T4RLYHtW*{-`Il?$ z_Akw8Jc(XEtji?uic{$e>pD_Qf2_R5vds0)p`YhVj`f+>&7rno8E!L_q77ZzOWJGu zYaop)D@g;ab(TcH51ZSyZ&6IfVvLgJ7V6eV#LP?<@u-f3_P4 z(_1cKx17LKFcmh;=DIDa>#0d8Vlf*wS4@i5p>k3ylbJ|us_7zDV%@R~hNn*lf_P(a z_Qx)F+Iq>)BKcI|*RRKAV7Bs?CeEP5@H1zJs$x`Pymauc2L@&r6x#*)6ilc=px?|J z?tx6ExsYjx7Xs<6p@iee;)T=Vf9fid%pj&GAbeRmQlNQR<07rMXnVnHmT7}A#F3uE z&{2a0+1oYzQ~j^b9wrHcTrZf!z4Z)oZp73Sd%tVx38iTpWWGX4iNz*`M}0%_i)`T!Hg2p6INw!`PI!a4=JA>}SSip*f)e^{|%kAp-) z0y7Zk&(Ux&96N()Sf^J|m@m?Bm^}k9Fd26=Mk&^<6>0JrS7{c79!Fsu{&O7^D6AJK zq~#|Jk&9BNZ=3c9T^<6s&_CpR1}KRkPsU!4pbqtEWI^d`;WJ5vKHz7lJ@&z*iY2=! z1$|C)$q4#P!oW)-brgyif1!AP>nL)Cc3?I(+V~HZ6Tz6IwikuL97Oyff;DY8f><8e z*ucz)`cEZJ+3vz7j}~jxi6p17Hg?$|l04_#LwXmB{{U4We#K<67=D{#g!rzcj?usn zkpn>3X(Gq7)o*2rw`Y9L^wej#H<{xnC~dY*y)c|M*mVV~E`&s;e|830NPu9fIms0n zUcUK!)WW0}tL|fvITy`faF-L!T0q)julTT(XodIctnm%()Ld@~xzvJ(7i2pq+=>=U z6}T^?%E?|WJCrLq&w!lEijgcYkadAwM3Xll$=DcPT{B?!UQjqZ__li?*)m{1I2_?{ z5<%DU!Z{Z>en(_9e~q7P9jOhVZ4F3)ZZ28*EOol+%)_=1bO*Y|`hq~0v~~y@Td!aMwuMi?YnrCCHB_ykaF zHIOEHJGDIif8{{H(YBMk31UowAR@;RNgCMG_?T0$F&v!-N=Ct%wF5wzU_HhnLc-y5 zw$TVX$RU?^vlvULI@ExG$sV_FT*xOK@?ugN)@TfRl(o z#L&hx#)i=-AP(O>iYc5NU_cY(4f&$OrVs`(zU6f_e-gPRam#X23_~NQ;A_i`>cY?? zbK>P3L9vjyrwXAmkU&X7Y#Ez6MipgiYwlTB%`jOc(vci&vAf*-?+`H*!(&z~iGtW; z>#CsO3KL95WXzmRCE_qIBHMPj8<=$JJLzQm_~pGo}e-S2Glgsrhs~fs5YmlB_lwZ8i0*Qq5+`tfEoY;K+p}S&^C}7032v& zXlMq2#0>$E00x=>8Uc_101R=Vp`oA}0}wO@KmZzO0B8n4001$@hK7cKXbeEm82|uj zpaGy6e*gdg!bE`q0EUKynr#I=C#mgF^HB{wOf@}5Mu2*ZjWht!>R!LJlICaz#xX1F zDFE1^puMCTT5K<+FmH~5XQhP=pfS9|RLKtmiXwH>Jlx(>ajOM8sPclc#CST2v~9io z(XHC4V|~Pgs^gDhiFn;&o0AoIr1ywkb=zzHf0K$~nY(JDLYHiOZHSc_>!_halUFQ- z6MN*3VlQHi(viX-nlshMuRT>*ONu~o)1Ez%5}rlm-t}P5DN$S&(~NJ18I_dKHTHE(N{m;Ior{UVnT5qR zL4HLODiCNJ{UN&O6v}Fu1t*I^e|A=~2>ChfG0ewNlZ4`BkxVwpywi`LL)J>t z5aFhStEG)K9-_t!6^_@Lq;})1B@%<9Xd|G*oGT2nYi;C+EZdJ%JXdhE+awz?Je%h7 zxb_UfFQ|bm1{#g<=J*Vj+TjgyM&HIG_V81zXoW!0JdFZ3jfiUuct?O6e*#ePE1^P+ zl1T-ogwZUF#L92eTqqpP(N$_k=dMZ^>7E@Pp;MVz?BYv@t zo>&kIoL64D=1GFJu8*h88jobekwE;nDOwFw5!$6lW&K8<0x|lb>KEO+W1eI6Tz6IwU>p#9EAL#f;8+o z0$3hnxq+Dx>pN<7p6nuM?9F=-B$V~0&bCNok5To|+=bcyKq`jJTd^(gxENf4zjGLKptiS>hX+q`2G@bEyRmPiQ@) zZAA+uirN>_Wn`}vIFBIbJ3w=Z5E`?oLr@4@6&PSZv5^J^M5b#V+sX$Qs}|32J)bj_P~3rZ>S^*eWSQQ z(%XcB`uytv_y!a9_90|4UDKpF@{p4%gC-O@djhF_4ZhN6e7!pm4mR$5VN{E^DF(uZ zi3zR+L%s(-W1ZvH`uVE0W>K_%euqqJPYk#LG5Kru^NfAHxX;Nq}!nVUB=yugIU zkjNV#gUjhCbE2MwBd46+7#cJJn8;mRw-_rnF8D}BAv43TVQq^-FGyvO1du6^mQF?o zK(8H@5KSF}KI-`*Wd>*iAdrPM9P1X52QyKiu$cssxzR|_)smrMtAu#@WQ;IKvr4jv zJa7o0*lHk5fBAehJzjc&fuXjOya{4Vf*>NtAxRpT)AX>XaAG-n4wQ{!GinBbGQfG* zi3dtILA>TC zfRl(o#L&hx#)i=-AP&A3D5i050sx;VZp{`QFn}?Qf7dIiq?O4lj%$*TVi_Gj3tsj& zs|!Fz*U8K{gIghTP8C9BAb^sD*fTbCj4I03*W9wNqF}N~r6M=7#@|2Uc!7wf8rrdB zOct{r0;&!mp)|y1Ov%L3U4{kZTV}@ta}J$5=82a~x^^0%?wnpcEM}$^29=Bz;k|{1 zvpy?8eI_=1H+JmlQB892}7(8UVc*2Udm9Y6#F73)s>Vyfmslv#%hs1=V2E z?n!BoC)(jI9)SB}lX}Js8Wr7}xQT_`9`%5qfxysS;A?a!R*+toF2YptP>F7elC(j* dWyyLF90l!<@wcO+AV2?VMhKY;(Xaohj^ diff --git a/man/checkField.Rd b/man/checkField.Rd index 253849d8..3d856609 100644 --- a/man/checkField.Rd +++ b/man/checkField.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkFieldSettings.R +% Please edit documentation in R/checkField.R \name{checkField} \alias{checkField} \title{Check that a setting parameter has a matching data field} diff --git a/man/checkFieldSettings.Rd b/man/checkFieldSettings.Rd deleted file mode 100644 index e8c48684..00000000 --- a/man/checkFieldSettings.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/checkField.R -\name{checkFieldSettings} -\alias{checkFieldSettings} -\title{Check that a setting parameter has a matching data field} -\usage{ -checkFieldSettings(fieldKey, settings, data) -} -\arguments{ -\item{fieldKey}{a list (like those provided by \code{getSettingKeys())} defining the position of parameter in the settings object.} - -\item{settings}{The settings list used to generate a chart like \code{eDISH()}} - -\item{data}{A data frame to check for the specified field} -} -\value{ -A list containing the results of the check following the format specified in \code{validateSettings()[["checkList"]]} -} -\description{ -Checks that a single parameter from the settings list matches a field value in a specified data set -} -\details{ -This function compares settings with field values as part of the \code{validateSettings()} function. More specifically, the function checks whether the \code{fieldKey} in a \code{settings} object matches a column/field combination in \code{"data"}. The function makes 2 major assumptions about the structure of the settings object. First, it assumes that the first value in fieldKey is "settingName_values" and there is a corresponding "settingName_col" setting that defines the column to search for field-level data. Second, it expects that the value specified by key/settings is a list, and that each value in the list is a field of the variable above. -} -\examples{ -testSettings<-generateSettings(standard="AdAM") -fields<-list("measure_values","TB") -safetyGraphics:::checkFieldSettings(fieldKey=fields,settings=testSettings, data=adlbc) - -} -\keyword{internal} diff --git a/tests/testthat/test_validateSettings.R b/tests/testthat/test_validateSettings.R index 3598c553..9d8ccceb 100644 --- a/tests/testthat/test_validateSettings.R +++ b/tests/testthat/test_validateSettings.R @@ -48,14 +48,18 @@ test_that("field checks fail when expected",{ expect_equal(nrow(failedChecks), 1) expect_equal(failedChecks[1,"description"]%>%as.character,"field value from setting found in data") expect_equal(failedChecks[1,'text_key']%>%as.character,"measure_values--ALP") + - # TODO: support vectorized fields/columns #170 - # a vector of values are each checked independently. - # invalidFieldSettings$baseline[["values"]] <- c("not a filter",test2="still not a filter") - # fieldFailed2<-validateSettings(data=adlbc,settings=invalidFieldSettings) - # failedChecks2 = fieldFailed2[["checkList"]]%>%keep(~!.x[["valid"]]) - # expect_false(fieldFailed[["valid"]]) - # expect_length(failedChecks2, 3) + # a vector of values are each checked independently. + invalidFieldSettings <- validSettings + invalidFieldSettings$baseline[["value_col"]]<- "PARAM" + invalidFieldSettings$baseline[["values"]] <- list("not a filter","still not a filter") + + expect_false(safetyGraphics::checkField(list("baseline","values",1), settings=invalidFieldSettings, data=adlbc )$valid) + + fieldFailed2<-validateSettings(data=adlbc,settings=invalidFieldSettings) + expect_false(fieldFailed2[["valid"]]) + expect_equal(fieldFailed2$checks%>%filter(!valid)%>%nrow,2) #2 fields fail }) test_that("required setting checks fail when expected",{ From eb995c25b3508091a03f59320ca3b7e0226ab444 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 21 Feb 2019 19:59:23 -0800 Subject: [PATCH 5/7] clean checks --- DESCRIPTION | 2 +- R/trimData.R | 4 ++-- R/validateSettings.R | 4 ++-- man/trimData.Rd | 2 +- tests/testthat/test_validateSettings.R | 2 +- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b2c8c4d1..8627616e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: safetyGraphics Title: Create Interactive Graphics Related to Clinical Trial Safety -Version: 0.8.0 +Version: 0.8.1 Authors@R: c( person("Jeremy", "Wildfire", email = "jeremy_wildfire@rhoworld.com", role = c("cre","aut")), person("Becca", "Krouse", role="aut"), diff --git a/R/trimData.R b/R/trimData.R index 8650bba2..d1012315 100644 --- a/R/trimData.R +++ b/R/trimData.R @@ -12,7 +12,7 @@ #' #' @importFrom dplyr filter #' @importFrom purrr map -#' @importFrom rlang parse_expr +#' @importFrom rlang parse_expr .data #' #' @keywords internal @@ -22,7 +22,7 @@ trimData <- function(data, settings){ ## Remove columns not in settings ## col_names <- colnames(data) - settings_keys <- safetyGraphics::getSettingsMetadata(cols="text_key", filter_expr=column_mapping==TRUE) %>% + settings_keys <- safetyGraphics::getSettingsMetadata(cols="text_key", filter_expr=.data$column_mapping==TRUE) %>% str_split("--") settings_values <- map(settings_keys, function(x) {return(getSettingValue(x, settings))}) diff --git a/R/validateSettings.R b/R/validateSettings.R index c04b6eee..59b982e5 100644 --- a/R/validateSettings.R +++ b/R/validateSettings.R @@ -47,10 +47,10 @@ validateSettings <- function(data, settings, chart="eDish"){ #Check that non-null setting columns are found in the data allKeys <- getSettingsMetadata(charts=chart, filter_expr = .data$column_mapping, cols = c("text_key","setting_type")) - dataKeys <- allKeys %>% filter(setting_type !="vector") %>% pull(text_key) %>% textKeysToList() + dataKeys <- allKeys %>% filter(.data$setting_type !="vector") %>% pull(.data$text_key) %>% textKeysToList() # Add items in vectors to list individually - dataVectorKeys <- allKeys %>% filter(setting_type =="vector") %>% pull(text_key) %>% textKeysToList() + dataVectorKeys <- allKeys %>% filter(.data$setting_type =="vector") %>% pull(.data$text_key) %>% textKeysToList() for(key in dataVectorKeys){ current<-getSettingValue(key, settings=settings) if (length(current) > 0 ) { diff --git a/man/trimData.Rd b/man/trimData.Rd index 8f4dc1ef..12af5292 100644 --- a/man/trimData.Rd +++ b/man/trimData.Rd @@ -19,7 +19,7 @@ Removes unnecessary rows and columns from data based on current settings } \examples{ testSettings <- generateSettings(standard="adam") -safetyGraphics:::trimData(data=adlbc, settings=testSettings) +safetyGraphics:::trimData(data=adlbc, settings=testSettings) } \keyword{internal} diff --git a/tests/testthat/test_validateSettings.R b/tests/testthat/test_validateSettings.R index 9d8ccceb..1d5d6b00 100644 --- a/tests/testthat/test_validateSettings.R +++ b/tests/testthat/test_validateSettings.R @@ -55,7 +55,7 @@ test_that("field checks fail when expected",{ invalidFieldSettings$baseline[["value_col"]]<- "PARAM" invalidFieldSettings$baseline[["values"]] <- list("not a filter","still not a filter") - expect_false(safetyGraphics::checkField(list("baseline","values",1), settings=invalidFieldSettings, data=adlbc )$valid) + expect_false(safetyGraphics:::checkField(list("baseline","values",1), settings=invalidFieldSettings, data=adlbc )$valid) fieldFailed2<-validateSettings(data=adlbc,settings=invalidFieldSettings) expect_false(fieldFailed2[["valid"]]) From 12f34990065ad25d7feaef1b2807689a6bcd1deb Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 21 Feb 2019 20:24:01 -0800 Subject: [PATCH 6/7] deal with vectors in trimData(). fix #188 --- R/trimData.R | 30 ++++++++++++++++++++++++------ tests/testthat/test_trimData.R | 5 +++++ 2 files changed, 29 insertions(+), 6 deletions(-) diff --git a/R/trimData.R b/R/trimData.R index d1012315..6e8289c2 100644 --- a/R/trimData.R +++ b/R/trimData.R @@ -4,6 +4,7 @@ #' #' @param data a data frame to trim #' @param settings the settings list used to determine which rows and columns to drop +#' @param chart the chart being created #' @return A dataframe with unnecessary columns and rows removed #' #' @examples @@ -17,15 +18,32 @@ #' @keywords internal -trimData <- function(data, settings){ +trimData <- function(data, settings, chart="edish"){ ## Remove columns not in settings ## - col_names <- colnames(data) - settings_keys <- safetyGraphics::getSettingsMetadata(cols="text_key", filter_expr=.data$column_mapping==TRUE) %>% - str_split("--") - - settings_values <- map(settings_keys, function(x) {return(getSettingValue(x, settings))}) + + 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){ + current<-getSettingValue(key, settings=settings) + if (length(current) > 0 ) { + for (i in 1:length(current)){ + newKey <- key + newKey[[1+length(newKey)]]<-i + sub <- current[[i]] + if(typeof(sub)=="list"){ + newKey[[1+length(newKey)]]<-"value_col" + } + dataKeys[[1+length(dataKeys)]]<-newKey + } + } + } + + settings_values <- map(dataKeys, function(x) {return(getSettingValue(x, settings))}) common_cols <- intersect(col_names,settings_values) diff --git a/tests/testthat/test_trimData.R b/tests/testthat/test_trimData.R index 9acef804..aab56744 100644 --- a/tests/testthat/test_trimData.R +++ b/tests/testthat/test_trimData.R @@ -11,6 +11,9 @@ analysisFlag_settings <- settings analysisFlag_settings[['analysisFlag']][['value_col']] <- 'TRTA' analysisFlag_settings[['analysisFlag']][['values']] <- list("Placebo","Xanomeline High Dose") +filter_settings <- settings +filter_settings[['filters']]<-list("SEX", "AGEGR1") + both_settings <- baseline_settings both_settings[['analysisFlag']][['value_col']] <- 'TRTA' both_settings[['analysisFlag']][['values']] <- list("Placebo","Xanomeline High Dose") @@ -21,6 +24,8 @@ test_that("columns are removed",{ expect_length(trimData(adlbc, baseline_settings), 6) expect_length(trimData(adlbc, analysisFlag_settings), 7) expect_length(trimData(adlbc, both_settings), 7) + expect_length(trimData(adlbc, filter_settings), 8) + }) test_that("rows are removed",{ From 8ed63d5ab7e7406c48c964fe86cef7fff1c9d4eb Mon Sep 17 00:00:00 2001 From: jwildfire Date: Thu, 21 Feb 2019 20:31:13 -0800 Subject: [PATCH 7/7] update trimData example so log isn't so long --- R/trimData.R | 2 +- man/trimData.Rd | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/trimData.R b/R/trimData.R index 6e8289c2..f50fe288 100644 --- a/R/trimData.R +++ b/R/trimData.R @@ -9,7 +9,7 @@ #' #' @examples #' testSettings <- generateSettings(standard="adam") -#' safetyGraphics:::trimData(data=adlbc, settings=testSettings) +#' trimmed<-safetyGraphics:::trimData(data=adlbc, settings=testSettings) #' #' @importFrom dplyr filter #' @importFrom purrr map diff --git a/man/trimData.Rd b/man/trimData.Rd index 12af5292..c0f8223a 100644 --- a/man/trimData.Rd +++ b/man/trimData.Rd @@ -4,12 +4,14 @@ \alias{trimData} \title{Removes unnecessary rows and columns} \usage{ -trimData(data, settings) +trimData(data, settings, chart = "edish") } \arguments{ \item{data}{a data frame to trim} \item{settings}{the settings list used to determine which rows and columns to drop} + +\item{chart}{the chart being created} } \value{ A dataframe with unnecessary columns and rows removed @@ -19,7 +21,7 @@ Removes unnecessary rows and columns from data based on current settings } \examples{ testSettings <- generateSettings(standard="adam") -safetyGraphics:::trimData(data=adlbc, settings=testSettings) +trimmed<-safetyGraphics:::trimData(data=adlbc, settings=testSettings) } \keyword{internal}