From 81e7390ba36622e8abb4d04c36134307f6ea6bd0 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 22 Feb 2019 07:47:43 -0800 Subject: [PATCH 1/8] update data standard tracking --- R/detectStandard.R | 25 ++++++----- R/evaluateStandard.R | 3 +- R/getSettingsMetadata.R | 11 ++++- data-raw/csv_to_rda.R | 5 ++- data-raw/settingsMetadata.csv | 52 +++++++++++----------- data-raw/standardsMetadata.csv | 26 +++++++++++ data/settingsMetadata.rda | Bin 1952 -> 1773 bytes data/standardsMetadata.rda | Bin 0 -> 702 bytes tests/testthat/test_detectStandard.R | 48 ++++++++++---------- tests/testthat/test_getSettingsMetadata.R | 19 +++++--- 10 files changed, 118 insertions(+), 71 deletions(-) create mode 100644 data-raw/standardsMetadata.csv create mode 100644 data/standardsMetadata.rda diff --git a/R/detectStandard.R b/R/detectStandard.R index 6a7acf5a..412f4070 100644 --- a/R/detectStandard.R +++ b/R/detectStandard.R @@ -27,22 +27,25 @@ detectStandard <- function(data, includeFields=TRUE, domain="labs"){ # Create placeholder list, with Standard = None. + available_standards <- standardsMetadata %>% select(-text_key) %>% names standard_list <- list() standard_list[["details"]] = list() - standard_list[["details"]][["ADaM"]]<-evaluateStandard(data,standard="ADaM", includeFields=includeFields, domain=domain) - standard_list[["details"]][["SDTM"]]<-evaluateStandard(data,standard="SDTM", includeFields=includeFields, domain=domain) + for(standard in available_standards){ + standard_list[["details"]][[standard]]<-evaluateStandard(data,standard=standard, includeFields=includeFields, domain=domain) + } # Determine the final standard - if(standard_list[["details"]][["SDTM"]][["match"]] == "Full"){ - standard_list[["standard"]]<- "SDTM" - } else if(standard_list[["details"]][["ADaM"]][["match"]] == "Full"){ - standard_list[["standard"]]<- "ADaM" - } else if(standard_list[["details"]][["SDTM"]][["match"]] == "Partial" | - standard_list[["details"]][["ADaM"]][["match"]] == "Partial"){ + # TODO: write a general algorithm to do this ... + if(standard_list[["details"]][["sdtm"]][["match"]] == "Full"){ + standard_list[["standard"]]<- "sdtm" + } else if(standard_list[["details"]][["adam"]][["match"]] == "Full"){ + standard_list[["standard"]]<- "adam" + } else if(standard_list[["details"]][["sdtm"]][["match"]] == "Partial" | + standard_list[["details"]][["adam"]][["match"]] == "Partial"){ standard_list[["standard"]] <- ifelse( - length(standard_list[["details"]][["ADaM"]][["valid_count"]]) > - length(standard_list[["details"]][["SDTM"]][["valid_count"]]), - "ADaM" , "SDTM" #SDTM if they are equal + length(standard_list[["details"]][["adam"]][["valid_count"]]) > + length(standard_list[["details"]][["sdtm"]][["valid_count"]]), + "adam" , "sdtm" #SDTM if they are equal ) } else { diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index ae820df5..6bf954de 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -26,8 +26,7 @@ evaluateStandard <- function(data, standard, includeFields=TRUE, domain="labs"){ is.data.frame(data), is.character(standard), is.logical(includeFields), - is.character(domain), - tolower(standard) %in% c("adam","sdtm") + is.character(domain) ) standard<-tolower(standard) diff --git a/R/getSettingsMetadata.R b/R/getSettingsMetadata.R index 14257138..fed8578b 100644 --- a/R/getSettingsMetadata.R +++ b/R/getSettingsMetadata.R @@ -5,6 +5,7 @@ #' @param charts optional vector of chart names used to filter the metadata. Exact matches only (case-insensitive). All rows returned by default. #' @param text_keys optional vector of keys used to filter the metadata. Partial matches for any of the strings are returned (case-insensitive). All rows returned by default. #' @param filter_expr optional filter expression used to subset the data. +#' @param add_standards should data standard info stored in standardsMetadata be included #' @param cols optional vector of columns to return from the metadata. All columns returned by default. #' @param metadata metadata data frame to be queried #' @@ -27,9 +28,15 @@ #' #' @export -getSettingsMetadata<-function(charts=NULL, text_keys=NULL, cols=NULL, filter_expr=NULL, metadata = safetyGraphics::settingsMetadata){ +getSettingsMetadata<-function(charts=NULL, text_keys=NULL, cols=NULL, filter_expr=NULL, add_standards=TRUE, metadata = safetyGraphics::settingsMetadata){ - md <- metadata + md <- metadata %>% mutate(text_key=as.character(text_key)) + + if(add_standards){ + ms<-standardsMetadata %>% mutate(text_key=as.character(text_key)) + md<-md%>%left_join(ms, by="text_key") + } + all_columns <- names(md) #filter the metadata based on the charts option (if any) diff --git a/data-raw/csv_to_rda.R b/data-raw/csv_to_rda.R index 9449676f..de6c8b5f 100644 --- a/data-raw/csv_to_rda.R +++ b/data-raw/csv_to_rda.R @@ -3,5 +3,8 @@ library(usethis) ablbc <- read.csv("data-raw/adlbc.csv") usethis::use_data(adlbc, overwrite = TRUE) -settingsMetadata<- read.csv("data-raw/settingsMetadata.csv") +settingsMetadata <- read.csv("data-raw/settingsMetadata.csv") 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 diff --git a/data-raw/settingsMetadata.csv b/data-raw/settingsMetadata.csv index ce95c2f3..e56da6c2 100644 --- a/data-raw/settingsMetadata.csv +++ b/data-raw/settingsMetadata.csv @@ -1,26 +1,26 @@ -chart_edish,text_key,label,description,setting_type,setting_required,column_mapping,column_type,field_mapping,field_column_key,adam,sdtm -TRUE,id_col,ID column,Unique subject identifier variable name.,character,TRUE,TRUE,character,FALSE,,USUBJID,USUBJID -TRUE,value_col,Value column,Lab result variable name.,character,TRUE,TRUE,numeric,FALSE,,AVAL,STRESN -TRUE,measure_col,Measure column,Lab measure variable name,character,TRUE,TRUE,character,FALSE,,PARAM,TEST -TRUE,normal_col_low,Lower Limit of Normal column,Lower limit of normal variable name,character,TRUE,TRUE,numeric,FALSE,,A1LO,STNRLO -TRUE,normal_col_high,Upper Limit of Normal column,Upper limit of normal variable name,character,TRUE,TRUE,numeric,FALSE,,A1HI,STNRHI -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,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 -TRUE,measure_values--ALP,Alkaline Phosphatase value,Value used for Alkaline Phosphatase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col,Alkaline Phosphatase (U/L),Alkaline phosphatase (ALP) -TRUE,baseline--value_col,Baseline column,An optional list defining which column represent the baseline visit(s) of the study.,character,FALSE,TRUE,NA,FALSE,,, -TRUE,baseline--values,Baseline values,An optional list defining which values (one or more) represent the baseline visit(s) of the study.,vector,FALSE,FALSE,NA,TRUE,baseline--value_col,, -TRUE,analysisFlag--value_col,Analysis Flag column,An optional list defining which column should be used in eDish and mDish analyses.,character,FALSE,TRUE,NA,FALSE,,, -TRUE,analysisFlag--values,Analysis Flag values,An optional list defining which values should be used in eDish and mDish analyses.,vector,FALSE,FALSE,NA,TRUE,analysisFlag--value_col,, -TRUE,x_options,X axis options,"Specifies variable options for the x-axis using the key values from measure_values (e.g. 'ALT'). When multiple options are specified, a control allowing the user to interactively change the x variable is shown. ",vector,FALSE,FALSE,NA,FALSE,,, -TRUE,y_options,Y axis options,"Specifies variable options for the y-axis using the key values from measure_values (e.g. 'TB'). When multiple options are specified, a control allowing the user to interactively change the y variable is shown. ",vector,FALSE,FALSE,NA,FALSE,,, -TRUE,visit_window,Default Visit Window in Days ,Default visit window used to highlight eDish points where x and y measures occurred within the specified number of days. Editable by user after render. ,numeric,FALSE,FALSE,NA,FALSE,,, -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 +chart_edish,text_key,label,description,setting_type,setting_required,column_mapping,column_type,field_mapping,field_column_key +TRUE,id_col,ID column,Unique subject identifier variable name.,character,TRUE,TRUE,character,FALSE, +TRUE,value_col,Value column,Lab result variable name.,character,TRUE,TRUE,numeric,FALSE, +TRUE,measure_col,Measure column,Lab measure variable name,character,TRUE,TRUE,character,FALSE, +TRUE,normal_col_low,Lower Limit of Normal column,Lower limit of normal variable name,character,TRUE,TRUE,numeric,FALSE, +TRUE,normal_col_high,Upper Limit of Normal column,Upper limit of normal variable name,character,TRUE,TRUE,numeric,FALSE, +TRUE,studyday_col,Study Day column,Visit day variable name,character,TRUE,TRUE,numeric,FALSE, +TRUE,visit_col,Visit column,Visit variable name,character,FALSE,TRUE,character,FALSE, +TRUE,visitn_col,Visit Number column,Visit number variable name,character,FALSE,TRUE,numeric,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 +TRUE,measure_values--AST,Aspartate Aminotransferase value,Value used for Aspartate Aminotransferase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col +TRUE,measure_values--TB,Total Bilirubin value,Value used for Total Bilirubin in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col +TRUE,measure_values--ALP,Alkaline Phosphatase value,Value used for Alkaline Phosphatase in the specified measure column,character,TRUE,FALSE,NA,TRUE,measure_col +TRUE,baseline--value_col,Baseline column,An optional list defining which column represent the baseline visit(s) of the study.,character,FALSE,TRUE,NA,FALSE, +TRUE,baseline--values,Baseline values,An optional list defining which values (one or more) represent the baseline visit(s) of the study.,vector,FALSE,FALSE,NA,TRUE,baseline--value_col +TRUE,analysisFlag--value_col,Analysis Flag column,An optional list defining which column should be used in eDish and mDish analyses.,character,FALSE,TRUE,NA,FALSE, +TRUE,analysisFlag--values,Analysis Flag values,An optional list defining which values should be used in eDish and mDish analyses.,vector,FALSE,FALSE,NA,TRUE,analysisFlag--value_col +TRUE,x_options,X axis options,"Specifies variable options for the x-axis using the key values from measure_values (e.g. 'ALT'). When multiple options are specified, a control allowing the user to interactively change the x variable is shown. ",vector,FALSE,FALSE,NA,FALSE, +TRUE,y_options,Y axis options,"Specifies variable options for the y-axis using the key values from measure_values (e.g. 'TB'). When multiple options are specified, a control allowing the user to interactively change the y variable is shown. ",vector,FALSE,FALSE,NA,FALSE, +TRUE,visit_window,Default Visit Window in Days ,Default visit window used to highlight eDish points where x and y measures occurred within the specified number of days. Editable by user after render. ,numeric,FALSE,FALSE,NA,FALSE, +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 diff --git a/data-raw/standardsMetadata.csv b/data-raw/standardsMetadata.csv new file mode 100644 index 00000000..6f0567ce --- /dev/null +++ b/data-raw/standardsMetadata.csv @@ -0,0 +1,26 @@ +text_key,adam,sdtm +id_col,USUBJID,USUBJID +value_col,AVAL,STRESN +measure_col,PARAM,TEST +normal_col_low,A1LO,STNRLO +normal_col_high,A1HI,STNRHI +studyday_col,ADY,DY +visit_col,VISIT,VISIT +visitn_col,VISITNUM,VISITNUM +filters,, +group_cols,, +measure_values--ALT,Alanine Aminotransferase (U/L),"Aminotransferase, alanine (ALT)" +measure_values--AST,Aspartate Aminotransferase (U/L),"Aminotransferase, aspartate (AST)" +measure_values--TB,Bilirubin (umol/L),Total Bilirubin +measure_values--ALP,Alkaline Phosphatase (U/L),Alkaline phosphatase (ALP) +baseline--value_col,, +baseline--values,, +analysisFlag--value_col,, +analysisFlag--values,, +x_options,, +y_options,, +visit_window,, +r_ratio_filter,, +r_ratio_cut,, +showTitle,, +warningText,, \ No newline at end of file diff --git a/data/settingsMetadata.rda b/data/settingsMetadata.rda index c70c9c65635c9e1653236e721fe5a9073d45f8ee..828fbac52b60f34547fcf13deddec721ad53629a 100644 GIT binary patch literal 1773 zcmVYrqPrPfHE`y0BF-dG&IvksPzH0Jwt|o0BAHC z0|Wrj(@cP9Xwx7DAZP%|;7A$(0iXZ?00000XaE2X8UO*H&}a-014B(R0imNzfEa56L$A$>M; z&3S>;oPckqG=m-aOJ_xl@E?5HXNsOGrB9H7A;P{c4TT!8cH2pBg~8+erzqLST?DCxQqX4>Kgt zBuxzsA@Q&dMjxH~Z2&E;AR7c=(gYtn7wTu7h*J|t6KM%--NhxG88uiykVzsDUDHY7-QX6WzBudO%b-|cwbn*D- zj#nPY<LJZ@7C~dq7 zWi-r#HaquA`b#3Jmz^Nw#N^orUlDT}Ety(1eAM~TFjj}8bxaBrXr0*kg98T0P?@@+ zNyQ5GZpTnOP{VpbrXVSn8Ge$ZShxV>3l{wC%Y;e*$jF@?G!O;5W(g#dm%e*|H#0T5 zqN;_grB@XneST3zp%peV)|$~}*m+?SM~^!7sU)YZHg+;YBzh0J zhU72t_yAQPe$8aF3_TXfA@IER*>^WihPYBq-BHZpRC+hYP}3>94Dij1#kLdw!M_B_)ZZZr$gAnu#CE(bFm}I->NONT&CRGMZD0KNsrRr_@iI-irARKJk z_mx3@B_P;P(IGX?R69ePIOv48TemThVD}ABK_%>WBit7#q+CT2pctjCcWE5p;<3_a zHg0EQ0tPgOKtTtS(op6{#6i={afT+10H!h*S0&8_lI8Jg|;mS!6BAF5W5z{VXZgF&v!-N=C7vjRIvr^Dz<@ z78g5h5SOxo8LQdOFqcu-NFXyKzv0y~3CD<;3#{JF!}iEQ`Ga`_CkGL*=s3<&c!@ZK zn3@>In9$lK1Oegau|+eBj36h-8?&OrrZ5Iky6W`OO6e<{w@N{fW;%WLz3i}74Fqj` zIY$s{WG)khP?<;|B%wA8&d!mASz6l*tksaRNu>mEWlf&nq2d^dVX3PYM8Rr1N+8@! z&X|nk%+4l~@)(#AZF<}d%sMpinkHUl=V7W2^Na_LjO5CV7BN@{1{NC5el~zh6D1Yk z6hX+7Vq-2)#Ihj}mTN}bdqTVkZG5O5iEyyy@5G`(yO_$eYp Pzxcb7DZ+$>^&lR==-pa26v01XC)hJldv4FgRMG&D3c13+R1 zfXDy?O#lr5$N&HaIMC40&rBsMR(mYm@vEN5TY(x0QsKQy<1C}cix?fgu zr98U6Pmc_(r_X)a#VsfFQgp_UdlH{JCiLa43?Ia--JBG6104Ni0zF`D39%-?6KM%C zAWO^Of(C=%WS9vlp^2oQGeSAod(ZPQ1BIlL8$)RT*a3SI0e>bh(Ec_cCId)Gv;c1A z*e^pp0rGB!it-I{am%b!7BKmjYwh+g&1pP|UO%kMB=Cw;=?m*RQcQoWyvDN3_0FN6 z=Sz;jVt6PTx+BQk+_xGP3QQHO0MBr)wOopjhIZK~-aR$|?<42Gvq2ZDHGaQ4S8ciMW%&m#F$;n%OnWni}QmnP1j#PBm`hpJ*! zV!U+lt_KEY7ZlqC`4mj3L7?Bv8}5Njrn!)5hZh3rt)YbD$l`_5;_51r%pj&GAbeRm zQlNQR<07rMXnVnHmT7}A#F3uE&{2a0+1oYzQ~j^b9wrHcTrZf!z4Z)oZp73Sd%tVx z38iTpWWGX4iNz*`M}0%_i)`T!Hg2p6INw!`PI z!a4=JA>}SSip*f)Sg~S{gG53CGZ5&{(Qq&vJA-Lhr&myzFVb+BJp(W>8Fw^BDb}qO zY4RCYX%>YZM`0ZPa~%{YtQRPxMLIz)K@_6p9$3cz^3Ca)owaHa6P$50w+a zn54EBg~1#|{2_uhZ8(Bh9@*Hy%!v9=B~IDy!X}RvYt)G(r?ED6*&&iV=iNhk7mNP@ zRUm%FWU?53n_`6cuB499zz~rGK-g&_$FtRMWs0|Fe9rXLXSg?+<0mL>wobh;oHp2X z1*a6h% z?9^Ou3AxmQhZkf!DBOw`OBJ{;q{_)&EjyGeInRKc%ZiaKFOYSCT||>NAj#MmUR^U_ z_g+vqJovVIA=xruKR6uWa1ue+^1?Y6IDSWDG>xBZ9jOhVZ4F3)ZZ28*EOol+%)_=1 zbO*Y|`hq~0v~~y@Tdh#Ht%O!0uvfTAZ&sU55!RBMLfz!Pcgj3uaYKEW`JZ85T>JkS2ONwLJdiK)}(qle`IHOoAXH#}P>y*wgr!Q?M}{od-%r z!I`xKK$&1Y#v($(;d8dp2s_9jmv^%mOQ<^3fPl#!w{Kj?Cmr%+F2Tah;Qg`?egNSh zHbF@o1kQtuA96_;=xTgxCGLS$?LTnkEIz|;`YisUVSIsb4B+`)_Y_YrC z{O=Gk6vJayEQx~HW9zD*;0hB=Mr6#KO(o(mFCyD^xEq*s>f@RwT{7v|YJ<9Qc<`~B zm{b~8Fjt2g3k_y`Hh@b56&2$OAmvH1F_#oDEFA7gk_`a87zb91pwp4t6|EdT9amcX7VPiCW&WpEwzvrOC{!ZO3JP!T8@)0WTtBzq4&n7c#NZ< zQB>pK^hMsS=@;v$tt}8FfK(~z-?(_jZY$4#J=$0 zRmDw=p?>*L@4n3026OC@(K8>M@@^9mTs;EWR|r7^LP24EAg~stsmk{mFk&7sC1J!w zO1gSY94$K6tRsla#B&$VUZm`|kBgy+z-7uj`nBDoLInLu-e|W?Y{QT<%?eK#FvAf5 zP}7uw@l?uZHbf|w#*G=13yT?%3#hJoWwWXC@6%0QH!>?D3Ph5qNeCHBP%H@v@uvKB z_fs%a+07{=(_6ApThUUn(p5DLSjvF9Ay61ZPKs7m5?TVfsHQQSSs|IlB;`V@YPfk2 zeP|aQDcI5w)qsJ;6tTc54-fN#G2me+8S0EBB1z3cb_HvBG;5?gS0R>IbU9%FxW_UR z8>#w}n2l=Rg0oeSiH7vRkW+M$Lsg@4ZDc#uv6ahgy~~9!JPdA=!F8nqlr&~Q@x~}i kA1GuOJ{!{wa*UF#eW$l?(GQw9 Date: Fri, 22 Feb 2019 08:37:41 -0800 Subject: [PATCH 2/8] automate standard adjudication --- R/detectStandard.R | 46 ++++++++++++++++--------- R/evaluateStandard.R | 17 ++++----- data-raw/standardsMetadata.csv | 20 +++++------ data/standardsMetadata.rda | Bin 702 -> 696 bytes man/getSettingsMetadata.Rd | 5 ++- tests/testthat/test_detectStandard.R | 37 ++++++++++---------- tests/testthat/test_evaluateStandard.R | 10 +++--- 7 files changed, 77 insertions(+), 58 deletions(-) diff --git a/R/detectStandard.R b/R/detectStandard.R index 412f4070..357cfd77 100644 --- a/R/detectStandard.R +++ b/R/detectStandard.R @@ -26,31 +26,45 @@ detectStandard <- function(data, includeFields=TRUE, domain="labs"){ ) - # Create placeholder list, with Standard = None. + # Create placeholder list, with Standard = none. available_standards <- standardsMetadata %>% select(-text_key) %>% names standard_list <- list() standard_list[["details"]] = list() + standard_list[["standard"]] = "none" + standard_list[["standard_percent"]] = 0 + for(standard in available_standards){ + # evaluate the current standard and save the result standard_list[["details"]][[standard]]<-evaluateStandard(data,standard=standard, includeFields=includeFields, domain=domain) + + # if the current standard is a better match, use it as the overall standard + # if there is a tie, don't change the standard - this means the column order in standardMetadata breaks ties! + current_percent <- standard_list[["details"]][[standard]][["match_percent"]] + overall_percent <- standard_list[["standard_percent"]] + if(current_percent > overall_percent){ + standard_list[["standard"]] <- standard + standard_list[["standard_percent"]] <- current_percent + } } # Determine the final standard + # TODO: write a general algorithm to do this ... - if(standard_list[["details"]][["sdtm"]][["match"]] == "Full"){ - standard_list[["standard"]]<- "sdtm" - } else if(standard_list[["details"]][["adam"]][["match"]] == "Full"){ - standard_list[["standard"]]<- "adam" - } else if(standard_list[["details"]][["sdtm"]][["match"]] == "Partial" | - standard_list[["details"]][["adam"]][["match"]] == "Partial"){ - standard_list[["standard"]] <- ifelse( - length(standard_list[["details"]][["adam"]][["valid_count"]]) > - length(standard_list[["details"]][["sdtm"]][["valid_count"]]), - "adam" , "sdtm" #SDTM if they are equal - ) - - } else { - standard_list[["standard"]]<-"None" - } + # if(standard_list[["details"]][["sdtm"]][["match"]] == "Full"){ + # standard_list[["standard"]]<- "sdtm" + # } else if(standard_list[["details"]][["adam"]][["match"]] == "Full"){ + # standard_list[["standard"]]<- "adam" + # } else if(standard_list[["details"]][["sdtm"]][["match"]] == "Partial" | + # standard_list[["details"]][["adam"]][["match"]] == "Partial"){ + # standard_list[["standard"]] <- ifelse( + # length(standard_list[["details"]][["adam"]][["valid_count"]]) > + # length(standard_list[["details"]][["sdtm"]][["valid_count"]]), + # "adam" , "sdtm" #SDTM if they are equal + # ) + # + # } else { + # standard_list[["standard"]]<-"None" + # } return(standard_list) } diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index 6bf954de..fc778cf8 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -42,7 +42,8 @@ evaluateStandard <- function(data, standard, includeFields=TRUE, domain="labs"){ mutate(type = ifelse(.data$column_mapping, "column", "field")) %>% rowwise %>% mutate(field_column_name = ifelse(.data$field_mapping, getSettingsMetadata(cols=standard, text_keys=.data$field_column_key),"")) %>% - mutate(valid = ifelse(.data$column_mapping, + mutate( + valid = ifelse(.data$column_mapping, hasColumn(data=data, columnName=.data$standard_val), hasField(data=data, columnName=.data$field_column_name, fieldValue=.data$standard_val) )) %>% @@ -53,20 +54,20 @@ evaluateStandard <- function(data, standard, includeFields=TRUE, domain="labs"){ standardChecks <- standardChecks %>% filter(.data$type != "field") } - # compare_summary[["checks"]] <- split(standardChecks, seq(nrow(standardChecks)))%>%map(~as.list(.)) #coerce to list of lists? - compare_summary[["checks"]] <- standardChecks #or just keep the tibble ... + compare_summary[["checks"]] <- standardChecks # count valid/invalid data elements + compare_summary[["total_count"]] <- standardChecks %>% nrow() compare_summary[["valid_count"]] <- standardChecks %>% filter(.data$valid) %>% nrow() compare_summary[["invalid_count"]] <- standardChecks %>% filter(!.data$valid) %>% nrow() - - + compare_summary[["match_percent"]] <- compare_summary[["valid_count"]] / compare_summary[["total_count"]] + if (compare_summary[["invalid_count"]]==0) { - compare_summary[["match"]] <- "Full" + compare_summary[["match"]] <- "full" } else if(compare_summary[["valid_count"]]>0) { - compare_summary[["match"]] <- "Partial" + compare_summary[["match"]] <- "partial" } else { - compare_summary[["match"]] <- "None" + compare_summary[["match"]] <- "none" } return(compare_summary) diff --git a/data-raw/standardsMetadata.csv b/data-raw/standardsMetadata.csv index 6f0567ce..b51715e9 100644 --- a/data-raw/standardsMetadata.csv +++ b/data-raw/standardsMetadata.csv @@ -1,18 +1,18 @@ -text_key,adam,sdtm +text_key,sdtm,adam id_col,USUBJID,USUBJID -value_col,AVAL,STRESN -measure_col,PARAM,TEST -normal_col_low,A1LO,STNRLO -normal_col_high,A1HI,STNRHI -studyday_col,ADY,DY +value_col,STRESN,AVAL +measure_col,TEST,PARAM +normal_col_low,STNRLO,A1LO +normal_col_high,STNRHI,A1HI +studyday_col,DY,ADY visit_col,VISIT,VISIT visitn_col,VISITNUM,VISITNUM filters,, group_cols,, -measure_values--ALT,Alanine Aminotransferase (U/L),"Aminotransferase, alanine (ALT)" -measure_values--AST,Aspartate Aminotransferase (U/L),"Aminotransferase, aspartate (AST)" -measure_values--TB,Bilirubin (umol/L),Total Bilirubin -measure_values--ALP,Alkaline Phosphatase (U/L),Alkaline phosphatase (ALP) +measure_values--ALT,"Aminotransferase, alanine (ALT)",Alanine Aminotransferase (U/L) +measure_values--AST,"Aminotransferase, aspartate (AST)",Aspartate Aminotransferase (U/L) +measure_values--TB,Total Bilirubin,Bilirubin (umol/L) +measure_values--ALP,Alkaline phosphatase (ALP),Alkaline Phosphatase (U/L) baseline--value_col,, baseline--values,, analysisFlag--value_col,, diff --git a/data/standardsMetadata.rda b/data/standardsMetadata.rda index 3a5f3ecb83829670b99119275f241ee6a35a9dc3..4aaca682f6f4f6172187518a484082bcf6d37a7e 100644 GIT binary patch delta 623 zcmV-#0+9W_1-JzcLRx4!F+o`-Q&}`NRi=>+9yD3HI)W04WSSbDrqdxkC#Yl^4FEJ` z3{4Fh42DloN)SwndY)*M^*>5&Pf&V+>NL;*$N-UF9Dk}kA&?pX00000007Vc36(wI z7K&7$;`C8gqk3>@$(h*6(Il)Uc-Y}BwU8G>CFP8ijT|K!Zb=t1PP&{-`{P2$45Ma6 zQoD?-wN!;dMTWh0Nb*YqME=T?O|S@s0Z`a!iH$`_n`awrmyf0(0u$8%RS>3I?!4!7 z(=zD!=OI*_m#*FSdrZ*JwB?J}bJcl^wlnm;UgypJ_cv2EDw+|KBLO6T7V9952aws? zi418Hxak-!Wn17{)yV>$L{*5r=y)|G=r+uFfl8bDwmh{R*-OSbazTw-w<^NuxM zo3MBtPt=jeh440X6Ci1Sl%H_%_Mt>{Cu>AH(NxZ9Jqi=dBg4ZpdrV8A5b#Br$k$$1 zS;ajRbS`98MihY+P>K&Sj{qykiSeHlH1^W4r@5jc7~{9DPh0d~m#C^(EWlI+)Cz#Y zi6SXkSW@bNnN(A7+dtLd^I4G+ZkxygRj6&+)6n9u=}42!TG`-wDPMQ`@U(z2Ksl<6 zP_Z&O=1d#ie3}%{9gC35EH!U~!s8mykljDjTw*n=ehSS-LIxZ%0wFzwQT!H-%ej#5 zQl?iH)q9JDFFVX^C4%Wmgyv_h1H%X*9DHGrTAHAz9psB*`kh0WdB_Tfl8;VvSECTExEa;8n#j$kfWqe2AzN#1C;O>D!EGtGYrPZ%)65dcurl!5V7%4ar2D3`{K8Iuc(8IcR9 zu6kv&sq^pCOWn2KNzFob1#5XUYot3@A(mKlIbi^}$1)Qesrr+cjcVV5vsI9ZhV;OYQ*@F; zRikokWINTdmCJ0s%Y`pI3~rObb)^E7G-g2Y#wbf4C}bBt8`BMPjFPQ=r?+p>51KgR P|Ha&qP81|1!f(p};sqOO diff --git a/man/getSettingsMetadata.Rd b/man/getSettingsMetadata.Rd index 78809723..ac090a96 100644 --- a/man/getSettingsMetadata.Rd +++ b/man/getSettingsMetadata.Rd @@ -5,7 +5,8 @@ \title{Get metadata about chart settings} \usage{ getSettingsMetadata(charts = NULL, text_keys = NULL, cols = NULL, - filter_expr = NULL, metadata = safetyGraphics::settingsMetadata) + filter_expr = NULL, add_standards = TRUE, + metadata = safetyGraphics::settingsMetadata) } \arguments{ \item{charts}{optional vector of chart names used to filter the metadata. Exact matches only (case-insensitive). All rows returned by default.} @@ -16,6 +17,8 @@ getSettingsMetadata(charts = NULL, text_keys = NULL, cols = NULL, \item{filter_expr}{optional filter expression used to subset the data.} +\item{add_standards}{should data standard info stored in standardsMetadata be included} + \item{metadata}{metadata data frame to be queried} } \value{ diff --git a/tests/testthat/test_detectStandard.R b/tests/testthat/test_detectStandard.R index dfd75bae..931500b4 100644 --- a/tests/testthat/test_detectStandard.R +++ b/tests/testthat/test_detectStandard.R @@ -5,53 +5,54 @@ test_that("a list with the expected properties and structure is returned",{ a<- detectStandard(data.frame()) expect_is(a,"list") - expect_named(a,c("details","standard")) + expect_named(a,c("details","standard","standard_percent")) expect_is(a[["standard"]],"character") - expect_match(a[["standard"]],"sdtm|adam|None") + expect_match(a[["standard"]],"sdtm|adam|none") expect_is(a[["details"]],"list") - expect_named(a[["details"]],c("adam","sdtm")) + expect_named(a[["details"]],c("sdtm","adam")) + expect_equal(a[["standard_percent"]],0) }) test_that("correct standards are identified",{ expect_equal(detectStandard(adlbc)[["standard"]],"adam") - expect_equal(detectStandard(adlbc)[["details"]][["adam"]][["match"]], "Full") - expect_equal(detectStandard(adlbc)[["details"]][["sdtm"]][["match"]], "Partial") + expect_equal(detectStandard(adlbc)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(adlbc)[["details"]][["sdtm"]][["match"]], "partial") adam_params <- c("Alanine Aminotransferase (U/L)","Aspartate Aminotransferase (U/L)","Bilirubin (umol/L)","Alkaline Phosphatase (U/L)") adam_test_data<-data.frame(USUBJID="001",AVAL=10,PARAM=adam_params, VISIT="Visit 1",VISITNUM=1,ADY=0,A1LO=0,A1HI=20) expect_equal(detectStandard(adam_test_data)[["standard"]],"adam") - expect_equal(detectStandard(adam_test_data)[["details"]][["adam"]][["match"]], "Full") - expect_equal(detectStandard(adam_test_data)[["details"]][["sdtm"]][["match"]], "Partial") + expect_equal(detectStandard(adam_test_data)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(adam_test_data)[["details"]][["sdtm"]][["match"]], "partial") sdtm_params<-c("Aminotransferase, alanine (ALT)","Aminotransferase, aspartate (AST)","Total Bilirubin","Alkaline phosphatase (ALP)") sdtm_test_data<-data.frame(USUBJID="001",STRESN=10,TEST=sdtm_params,VISIT="Visit 1",VISITNUM=1,DY=0,STNRLO=0,STNRHI=20) expect_equal(detectStandard(sdtm_test_data)[["standard"]],"sdtm") - expect_equal(detectStandard(sdtm_test_data)[["details"]][["adam"]][["match"]], "Partial") - expect_equal(detectStandard(sdtm_test_data)[["details"]][["sdtm"]][["match"]], "Full") + expect_equal(detectStandard(sdtm_test_data)[["details"]][["adam"]][["match"]], "partial") + expect_equal(detectStandard(sdtm_test_data)[["details"]][["sdtm"]][["match"]], "full") empty_test_data<-data.frame("") - expect_equal(detectStandard(empty_test_data)[["standard"]],"None") - expect_equal(detectStandard(empty_test_data)[["details"]][["adam"]][["match"]], "None") - expect_equal(detectStandard(empty_test_data)[["details"]][["sdtm"]][["match"]], "None") + expect_equal(detectStandard(empty_test_data)[["standard"]],"none") + expect_equal(detectStandard(empty_test_data)[["details"]][["adam"]][["match"]], "none") + expect_equal(detectStandard(empty_test_data)[["details"]][["sdtm"]][["match"]], "none") case_sensitive_test_data<-data.frame(usubjid="001",AVAL=10,PARAM=adam_params, VISIT="Visit 1",VISITNUM=1,ADY=0,A1LO=0,A1HI=20) expect_equal(detectStandard(case_sensitive_test_data)[["standard"]],"adam") - expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["adam"]][["match"]], "Full") - expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["sdtm"]][["match"]], "Partial") + expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(case_sensitive_test_data)[["details"]][["sdtm"]][["match"]], "partial") #NOTE: sdtm takes precedence over adam sdtm_and_adam_test_data<-cbind(adam_test_data,sdtm_test_data) expect_equal(detectStandard(sdtm_and_adam_test_data)[["standard"]],"sdtm") - expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["adam"]][["match"]], "Full") - expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["sdtm"]][["match"]], "Full") + expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["adam"]][["match"]], "full") + expect_equal(detectStandard(sdtm_and_adam_test_data)[["details"]][["sdtm"]][["match"]], "full") #NOTE: sdtm takes precedence over adam in partial matches as well sdtm_and_adam_partial_test_data<-data.frame(USUBJID="001",VISIT="Visit 1") expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["standard"]],"sdtm") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["adam"]][["match"]],"Partial") - expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["sdtm"]][["match"]],"Partial") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["adam"]][["match"]],"partial") + expect_equal(detectStandard(sdtm_and_adam_partial_test_data)[["details"]][["sdtm"]][["match"]],"partial") }) diff --git a/tests/testthat/test_evaluateStandard.R b/tests/testthat/test_evaluateStandard.R index 72dd5ec8..09f337a1 100644 --- a/tests/testthat/test_evaluateStandard.R +++ b/tests/testthat/test_evaluateStandard.R @@ -2,16 +2,16 @@ context("Tests for the evaluateStandard() function") library(safetyGraphics) test_that("basic test cases evaluate as expected",{ - expect_equal(evaluateStandard(data=adlbc, standard="adam")[["match"]],"Full") - expect_equal(evaluateStandard(data=adlbc, standard="sdtm")[["match"]],"Partial") - expect_equal(evaluateStandard(data=data.frame(), standard="sdtm")[["match"]],"None") + expect_equal(evaluateStandard(data=adlbc, standard="adam")[["match"]],"full") + expect_equal(evaluateStandard(data=adlbc, standard="sdtm")[["match"]],"partial") + expect_equal(evaluateStandard(data=data.frame(), standard="sdtm")[["match"]],"none") }) test_that("a list with the expected properties and structure is returned",{ a<- evaluateStandard(data=data.frame(),standard="adam") expect_is(a,"list") - expect_named(a,c('standard', 'checks', 'valid_count', 'invalid_count', 'match')) + expect_named(a,c('standard', 'checks', 'total_count','valid_count', 'invalid_count','match_percent', 'match')) expect_is(a[["standard"]],"character") expect_is(a[["match"]],"character") expect_is(a[["checks"]],"tbl") @@ -34,7 +34,7 @@ test_that("expected number of checks (in)valid",{ test_that("field level data is ignored when useFields=false",{ noFields<-evaluateStandard(data=adlbc, standard="adam", includeFields=FALSE) - expect_equal(noFields[["match"]],"Full") + expect_equal(noFields[["match"]],"full") expect_equal(noFields[["valid_count"]],6) }) From bfa4aecbb986cbbdaf0ffd953a2dce6f18d08ee5 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 22 Feb 2019 08:43:15 -0800 Subject: [PATCH 3/8] a few more tests. change standard order. --- R/standardsMetadata.R | 12 ++++++++++++ man/standardsMetadata.Rd | 21 +++++++++++++++++++++ tests/testthat/test_evaluateStandard.R | 3 +++ 3 files changed, 36 insertions(+) create mode 100644 R/standardsMetadata.R create mode 100644 man/standardsMetadata.Rd diff --git a/R/standardsMetadata.R b/R/standardsMetadata.R new file mode 100644 index 00000000..b7ad331a --- /dev/null +++ b/R/standardsMetadata.R @@ -0,0 +1,12 @@ +#' Standards Metadata +#' +#' Metadata about the data standards used to configure safetyGraphics charts. SpecificOne record per unique setting +#' +#' @format A data frame with 25 rows and 10 columns +#' \describe{ +#' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} +#' \item{--standard names--}{additional columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards.} +#' } +#' +#' @source Created for this package +"standardsMetadata" \ No newline at end of file diff --git a/man/standardsMetadata.Rd b/man/standardsMetadata.Rd new file mode 100644 index 00000000..63a6f2ea --- /dev/null +++ b/man/standardsMetadata.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardsMetadata.R +\docType{data} +\name{standardsMetadata} +\alias{standardsMetadata} +\title{Standards Metadata} +\format{A data frame with 25 rows and 10 columns +\describe{ + \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} + \item{--standard names--}{additional columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards.} +}} +\source{ +Created for this package +} +\usage{ +standardsMetadata +} +\description{ +Metadata about the data standards used to configure safetyGraphics charts. SpecificOne record per unique setting +} +\keyword{datasets} diff --git a/tests/testthat/test_evaluateStandard.R b/tests/testthat/test_evaluateStandard.R index 09f337a1..352fe5e6 100644 --- a/tests/testthat/test_evaluateStandard.R +++ b/tests/testthat/test_evaluateStandard.R @@ -28,6 +28,8 @@ test_that("expected number of checks (in)valid",{ a<-evaluateStandard(data=adlbc_edit, standard="sdtm") expect_equal(a[["valid_count"]],2) expect_equal(a[["invalid_count"]],8) + expect_equal(a[["total_count"]],10) + expect_equal(a[["match_percent"]],.2) expect_true(a[["checks"]]%>%filter(text_key=="measure_col")%>%select(valid)%>%unlist) }) @@ -35,6 +37,7 @@ test_that("expected number of checks (in)valid",{ test_that("field level data is ignored when useFields=false",{ noFields<-evaluateStandard(data=adlbc, standard="adam", includeFields=FALSE) expect_equal(noFields[["match"]],"full") + expect_equal(noFields[["match_percent"]],1) expect_equal(noFields[["valid_count"]],6) }) From da434877dd9357fd13508150508f7f29b5b25099 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 22 Feb 2019 08:57:10 -0800 Subject: [PATCH 4/8] update docs --- R/detectStandard.R | 8 ++++---- R/evaluateStandard.R | 2 +- man/detectStandard.Rd | 8 ++++---- man/evaluateStandard.Rd | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/detectStandard.R b/R/detectStandard.R index 357cfd77..1370f7cb 100644 --- a/R/detectStandard.R +++ b/R/detectStandard.R @@ -1,16 +1,16 @@ #' Detect the data standard used for a data set #' -#' This function attempts to detect the data CDISC clinical standard used in a given R data frame. +#' This function attempts to detect the clinical data standard used in a given R data frame. #' -#' This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data. Currently, "labs" is the only domain supported. +#' This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data by default. Additional standards can be added by modifying the \code{"standardMetadata"} data set included as part of this package. Currently, "labs" is the only domain supported. #' #' @param data A data frame in which to detect the data standard #' @param includeFields specifies whether to check the data set for field level data in addition to columns. Default: \code{TRUE}. #' @param domain The data domain for the data set provided. Default: \code{"labs"}. -#' @return A list containing the matching \code{"standard"} ("ADaM", "SDTM" or "None") and a list of \code{"details"} describing each standard considered. +#' @return A list containing the matching \code{"standard"} from \code{"standardMetadata"} and a list of \code{"details"} describing each standard considered. #' @examples -#' detectStandard(adlbc)[["standard"]] #AdAM +#' detectStandard(adlbc)[["standard"]] #adam #' detectStandard(iris)[["standard"]] #none #' #' \dontrun{ diff --git a/R/evaluateStandard.R b/R/evaluateStandard.R index fc778cf8..ffe13068 100644 --- a/R/evaluateStandard.R +++ b/R/evaluateStandard.R @@ -7,7 +7,7 @@ #' @param includeFields should field level data be evaluated? #' @param domain data domain. "labs" only for now. #' -#' @return a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "Full", "Partial" or "None". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "valid_checks" and "invalid_checks" provide counts of the specified checks. +#' @return a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "full", "partial" or "none". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "total_checks", "valid_checks" and "invalid_checks" provide counts of the specified checks. "match_percent" is calculated as valid_checks/total_checks. #' #' @examples #' safetyGraphics:::evaluateStandard(data=adlbc, standard="adam") # Match is TRUE diff --git a/man/detectStandard.Rd b/man/detectStandard.Rd index 8536045e..ec561f35 100644 --- a/man/detectStandard.Rd +++ b/man/detectStandard.Rd @@ -14,16 +14,16 @@ detectStandard(data, includeFields = TRUE, domain = "labs") \item{domain}{The data domain for the data set provided. Default: \code{"labs"}.} } \value{ -A list containing the matching \code{"standard"} ("ADaM", "SDTM" or "None") and a list of \code{"details"} describing each standard considered. +A list containing the matching \code{"standard"} from \code{"standardMetadata"} and a list of \code{"details"} describing each standard considered. } \description{ -This function attempts to detect the data CDISC clinical standard used in a given R data frame. +This function attempts to detect the clinical data standard used in a given R data frame. } \details{ -This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data. Currently, "labs" is the only domain supported. +This function compares the columns in the provided \code{"data"} with the required columns for a given data standard/domain combination. The function is designed to work with the SDTM and AdAM CDISC() standards for clinical trial data by default. Additional standards can be added by modifying the \code{"standardMetadata"} data set included as part of this package. Currently, "labs" is the only domain supported. } \examples{ -detectStandard(adlbc)[["standard"]] #AdAM +detectStandard(adlbc)[["standard"]] #adam detectStandard(iris)[["standard"]] #none \dontrun{ diff --git a/man/evaluateStandard.Rd b/man/evaluateStandard.Rd index ac1a38ab..ecbcde34 100644 --- a/man/evaluateStandard.Rd +++ b/man/evaluateStandard.Rd @@ -16,7 +16,7 @@ evaluateStandard(data, standard, includeFields = TRUE, domain = "labs") \item{domain}{data domain. "labs" only for now.} } \value{ -a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "Full", "Partial" or "None". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "valid_checks" and "invalid_checks" provide counts of the specified checks. +a list describing to what degree the data set matches the data standard. The "match" property describes compliance with the standard as "full", "partial" or "none". The "checks" property is a list of the data elements expected for the standard and whether they are "valid" in the given data set. "total_checks", "valid_checks" and "invalid_checks" provide counts of the specified checks. "match_percent" is calculated as valid_checks/total_checks. } \description{ Determines whether the required data elements in a data standard are found in a given data frame From 0e40f460bbbd36448a1ab616156c6e2ae101c02e Mon Sep 17 00:00:00 2001 From: jwildfire Date: Fri, 22 Feb 2019 09:06:12 -0800 Subject: [PATCH 5/8] clear checks --- R/detectStandard.R | 2 +- R/getSettingsMetadata.R | 4 ++-- R/settingsMetadata.R | 2 -- R/standardsMetadata.R | 7 ++++--- man/settingsMetadata.Rd | 2 -- man/standardsMetadata.Rd | 7 ++++--- 6 files changed, 11 insertions(+), 13 deletions(-) diff --git a/R/detectStandard.R b/R/detectStandard.R index 1370f7cb..da4a806c 100644 --- a/R/detectStandard.R +++ b/R/detectStandard.R @@ -27,7 +27,7 @@ detectStandard <- function(data, includeFields=TRUE, domain="labs"){ # Create placeholder list, with Standard = none. - available_standards <- standardsMetadata %>% select(-text_key) %>% names + available_standards <- safetyGraphics::standardsMetadata %>% select(-.data$text_key) %>% names standard_list <- list() standard_list[["details"]] = list() standard_list[["standard"]] = "none" diff --git a/R/getSettingsMetadata.R b/R/getSettingsMetadata.R index fed8578b..7ae8aec8 100644 --- a/R/getSettingsMetadata.R +++ b/R/getSettingsMetadata.R @@ -30,10 +30,10 @@ getSettingsMetadata<-function(charts=NULL, text_keys=NULL, cols=NULL, filter_expr=NULL, add_standards=TRUE, metadata = safetyGraphics::settingsMetadata){ - md <- metadata %>% mutate(text_key=as.character(text_key)) + md <- metadata %>% mutate(text_key=as.character(.data$text_key)) if(add_standards){ - ms<-standardsMetadata %>% mutate(text_key=as.character(text_key)) + ms<-safetyGraphics::standardsMetadata %>% mutate(text_key=as.character(.data$text_key)) md<-md%>%left_join(ms, by="text_key") } diff --git a/R/settingsMetadata.R b/R/settingsMetadata.R index d74a076a..e1f9f500 100644 --- a/R/settingsMetadata.R +++ b/R/settingsMetadata.R @@ -14,8 +14,6 @@ #' \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} #' \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{adam}{Settings values for the ADaM standard} -#' \item{sdtm}{Settings values for the SDTM standard} #' } #' #' @source Created for this package diff --git a/R/standardsMetadata.R b/R/standardsMetadata.R index b7ad331a..c1ffaac0 100644 --- a/R/standardsMetadata.R +++ b/R/standardsMetadata.R @@ -1,11 +1,12 @@ #' Standards Metadata #' -#' Metadata about the data standards used to configure safetyGraphics charts. SpecificOne record per unique setting +#' Metadata about the data standards used to configure safetyGraphics charts. One record per unique setting. Columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards. #' -#' @format A data frame with 25 rows and 10 columns +#' @format A data frame with 25 rows and 3 columns #' \describe{ #' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} -#' \item{--standard names--}{additional columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards.} +#' \item{adam}{Settings values for the ADaM standard} +#' \item{sdtm}{Settings values for the SDTM standard} #' } #' #' @source Created for this package diff --git a/man/settingsMetadata.Rd b/man/settingsMetadata.Rd index fa44dcd2..fb685da8 100644 --- a/man/settingsMetadata.Rd +++ b/man/settingsMetadata.Rd @@ -16,8 +16,6 @@ \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} \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{adam}{Settings values for the ADaM standard} - \item{sdtm}{Settings values for the SDTM standard} }} \source{ Created for this package diff --git a/man/standardsMetadata.Rd b/man/standardsMetadata.Rd index 63a6f2ea..601a48c0 100644 --- a/man/standardsMetadata.Rd +++ b/man/standardsMetadata.Rd @@ -4,10 +4,11 @@ \name{standardsMetadata} \alias{standardsMetadata} \title{Standards Metadata} -\format{A data frame with 25 rows and 10 columns +\format{A data frame with 25 rows and 3 columns \describe{ \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} - \item{--standard names--}{additional columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards.} + \item{adam}{Settings values for the ADaM standard} + \item{sdtm}{Settings values for the SDTM standard} }} \source{ Created for this package @@ -16,6 +17,6 @@ Created for this package standardsMetadata } \description{ -Metadata about the data standards used to configure safetyGraphics charts. SpecificOne record per unique setting +Metadata about the data standards used to configure safetyGraphics charts. One record per unique setting. Columns contain default setting values for clinical data standards, like the CDISC "adam" and "sdtm" standards. } \keyword{datasets} From 0df1f6e3bab61e8b305e9de075e7b62f25a72af5 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Mon, 25 Feb 2019 10:52:35 -0800 Subject: [PATCH 6/8] fix test --- R/settingsMetadata.R | 2 ++ man/settingsMetadata.Rd | 1 + tests/testthat/test_getRequiredSettings.R | 8 ++++---- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/R/settingsMetadata.R b/R/settingsMetadata.R index 61ddd66a..c1d109b5 100644 --- a/R/settingsMetadata.R +++ b/R/settingsMetadata.R @@ -15,6 +15,8 @@ #' \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} #' \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}{Category specifying where the setting should be located in shiny} + #' } #' #' @source Created for this package diff --git a/man/settingsMetadata.Rd b/man/settingsMetadata.Rd index 47dce006..ba3ab5ab 100644 --- a/man/settingsMetadata.Rd +++ b/man/settingsMetadata.Rd @@ -17,6 +17,7 @@ \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} \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}{Category specifying where the setting should be located in shiny} }} \source{ Created for this package diff --git a/tests/testthat/test_getRequiredSettings.R b/tests/testthat/test_getRequiredSettings.R index b5d8ef11..b1d463cc 100644 --- a/tests/testthat/test_getRequiredSettings.R +++ b/tests/testthat/test_getRequiredSettings.R @@ -6,13 +6,13 @@ defaultRequiredSettings <- list( list("id_col"), list("value_col"), list("measure_col"), - list("normal_col_low"), - list("normal_col_high"), - list("studyday_col"), list("measure_values","ALT"), list("measure_values","AST"), list("measure_values","TB"), - list("measure_values","ALP") + list("measure_values","ALP"), + list("normal_col_low"), + list("normal_col_high"), + list("studyday_col") ) From f6a77a1d38bc8b834ab30518ecffebb0d3b68499 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Mon, 25 Feb 2019 11:07:12 -0800 Subject: [PATCH 7/8] sync data module with standard refactor --- .../eDISH_app/modules/dataUpload/dataUpload.R | 102 +++++++++--------- .../modules/dataUpload/dataUploadUI.R | 18 ++-- 2 files changed, 60 insertions(+), 60 deletions(-) diff --git a/inst/eDISH_app/modules/dataUpload/dataUpload.R b/inst/eDISH_app/modules/dataUpload/dataUpload.R index 57f4de9c..781b1410 100644 --- a/inst/eDISH_app/modules/dataUpload/dataUpload.R +++ b/inst/eDISH_app/modules/dataUpload/dataUpload.R @@ -1,16 +1,16 @@ dataUpload <- function(input, output, session){ - + ns <- session$ns - + # initiate reactive values - list of uploaded data files # standard to imitate output of detectStandard.R - dd <- reactiveValues(data = list("Example data" = adlbc), current = 1, standard = list(list("standard" = "ADaM", "details" = list("ADaM"=list("match"="Full"))))) - + dd <- reactiveValues(data = list("Example data" = adlbc), current = 1, standard = list(list("standard" = "adam", "details" = list("adam"=list("match"="full"))))) + # modify reactive values when data is uploaded observeEvent(input$datafile,{ - + data_list <- list() - + ## data list for (i in 1:nrow(input$datafile)){ if (length(grep(".csv", input$datafile$name[i], ignore.case = TRUE)) > 0){ @@ -23,87 +23,87 @@ dataUpload <- function(input, output, session){ } # names names(data_list) <- input$datafile$name - + # append to existing reactiveValues list dd$data <- c(dd$data, data_list) - + # set dd$current to FALSE for previous & TRUE for current uploads dd$current <- c(rep(FALSE, length(dd$current)), rep(TRUE, length(data_list))) - + # run detectStandard on new data and save to dd$standard - + standard_list <- lapply(data_list, function(x){ detectStandard(x) }) - + #standard_list <- lapply(data_list, function(x){ detectStandard(x)$standard }) - + dd$standard <- c(dd$standard, standard_list) - + }) - - + + ### make a reactive combining dd$data & standard data_choices <- reactive({ - + req(dd$data) req(dd$standard) - + choices <- list() for (i in 1:length(dd$data)){ choices[[i]] <- names(dd$data)[i] } for (i in 1:length(dd$data)){ - + temp_standard <- dd$standard[[i]]$standard - - if(temp_standard == "None") { + standard_label <- ifelse(temp_standard=="adam","AdAM",ifelse(temp_standard=="sdtm","SDTM",temp_standard)) + if(temp_standard == "none") { names(choices)[i] <- paste0("

", names(dd$data)[i], " - No Standard Detected

") - } else if (dd$standard[[i]]$details[[temp_standard]]$match == "Full") { - names(choices)[i] <- paste0("

", names(dd$data)[i], " - ", dd$standard[[i]]$standard, "

") + } else if (dd$standard[[i]]$details[[temp_standard]]$match == "full") { + names(choices)[i] <- paste0("

", names(dd$data)[i], " - ", standard_label, "

") # If partial data spec match - give the fraction of variables matched } else { - + valid_count <- dd$standard[[i]]$details[[temp_standard]]$valid_count total_count <- dd$standard[[i]]$details[[temp_standard]]$invalid_count + valid_count - + fraction_cols <- paste0(valid_count, "/" ,total_count) names(choices)[i] <- paste0("

", names(dd$data)[i], " - ", "Partial ", - dd$standard[[i]]$standard, " (", fraction_cols, " data settings)", "

") + standard_label, " (", fraction_cols, " data settings)", "

") } } return(choices) }) - + # update radio buttons to display dataset names and standards for selection observeEvent(input$datafile, { req(data_choices()) vals <- data_choices() names(vals) <- NULL names <- lapply(names(data_choices()), HTML) - + prev_sel <- lapply(reactiveValuesToList(input), unclass)$select_file # retain previous selection - + updateRadioButtons(session, "select_file", choiceNames = names, choiceValues = vals, selected = prev_sel) - + }) - + # get selected dataset when selection changes data_selected <- eventReactive(input$select_file, { isolate({index <- which(names(dd$data)==input$select_file)[1]}) dd$data[[index]] }) - + # upon a dataset being uploaded and selected, generate data preview output$datapreview_header <- renderUI({ data_selected() isolate(data_name <- input$select_file) h3(paste("Data Preview for", data_name)) }) - + output$data_preview <- DT::renderDataTable({ DT::datatable(data = data_selected(), caption = isolate(input$select_file), @@ -112,54 +112,54 @@ dataUpload <- function(input, output, session){ class="compact", extensions = "Scroller", options = list(scrollY=400, scrollX=TRUE)) }) - - + + # upon a dataset being selected, grab its standard standard <- eventReactive(data_selected(), { index <- which(names(dd$data)==input$select_file)[1] dd$standard[[index]] }) - + # upon a dataset being selected, use generateSettings() to produce a settings obj settings <- eventReactive(c(data_selected(), standard()), { - + current_standard <- standard()$standard - - if (! current_standard=="None"){ - partial <- ifelse(standard()$details[[current_standard]]$match == "Partial", TRUE, FALSE) - + + if (! current_standard=="none"){ + partial <- ifelse(standard()$details[[current_standard]]$match == "partial", TRUE, FALSE) + if (partial) { - partial_keys <- standard()$details[[current_standard]]$checks %>% + partial_keys <- standard()$details[[current_standard]]$checks %>% filter(valid==TRUE) %>% - select(text_key) %>% + select(text_key) %>% pull() - + generateSettings(standard=current_standard, chart="eDish", partial=partial, partial_keys = partial_keys) - + } else { generateSettings(standard=current_standard, chart="eDish") - } + } } else { generateSettings(standard=current_standard, chart="eDish") } }) - + # run validateSettings(data, standard, settings) and return a status status <- reactive({ req(data_selected()) req(settings()) - validateSettings(data_selected(), + validateSettings(data_selected(), settings(), - chart="eDish") + chart="eDish") }) - + exportTestValues(status = { status() }) ### return selected data, settings, and status to server return(list(data_selected = reactive(data_selected()), settings = reactive(settings()), status = reactive(status()))) - -} \ No newline at end of file + +} diff --git a/inst/eDISH_app/modules/dataUpload/dataUploadUI.R b/inst/eDISH_app/modules/dataUpload/dataUploadUI.R index e214b5b8..3b8683bd 100644 --- a/inst/eDISH_app/modules/dataUpload/dataUploadUI.R +++ b/inst/eDISH_app/modules/dataUpload/dataUploadUI.R @@ -1,21 +1,21 @@ dataUploadUI <- function(id){ - + ns <- NS(id) - - tagList( + + tagList( fluidRow( column(3, wellPanel( - h3("Data upload"), + h3("Data upload"), fileInput(ns("datafile"), "Upload a csv or sas7bdat file",accept = c(".sas7bdat", ".csv"), multiple = TRUE), - radioButtons(ns("select_file"),"Select file for eDISH chart", + radioButtons(ns("select_file"),"Select file for eDISH chart", choiceNames = list(HTML("

Example data - ADaM

")), choiceValues = "Example data") ) ), - column(6, + column(6, fluidRow( - wellPanel( + wellPanel( uiOutput(ns("datapreview_header")), div(DT::dataTableOutput(ns("data_preview")), style = "font-size: 75%") ) @@ -23,5 +23,5 @@ dataUploadUI <- function(id){ ) ) ) - -} \ No newline at end of file + +} From 67119379ddcee3c52612264065d32607b337f2f3 Mon Sep 17 00:00:00 2001 From: jwildfire Date: Mon, 25 Feb 2019 11:15:01 -0800 Subject: [PATCH 8/8] clear check --- R/settingsMetadata.R | 4 +--- man/settingsMetadata.Rd | 3 +-- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/R/settingsMetadata.R b/R/settingsMetadata.R index c1d109b5..92882d95 100644 --- a/R/settingsMetadata.R +++ b/R/settingsMetadata.R @@ -8,15 +8,13 @@ #' \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} #' \item{label}{Label} #' \item{description}{Description} -#' \item{setting_cat}{Setting category (data, measure, appearance)} #' \item{setting_type}{Expected type for setting value. Should be "character", "vector", "numeric" or "logical"} #' \item{setting_required}{Flag indicating if the setting is required} #' \item{column_mapping}{Flag indicating if the setting corresponds to a column in the associated data} #' \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} #' \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}{Category specifying where the setting should be located in shiny} - +#' \item{setting_cat}{Setting category (data, measure, appearance)} #' } #' #' @source Created for this package diff --git a/man/settingsMetadata.Rd b/man/settingsMetadata.Rd index ba3ab5ab..7574fe69 100644 --- a/man/settingsMetadata.Rd +++ b/man/settingsMetadata.Rd @@ -10,14 +10,13 @@ \item{text_key}{Text key indicating the setting name. \code{'--'} delimiter indicates a nested setting} \item{label}{Label} \item{description}{Description} - \item{setting_cat}{Setting category (data, measure, appearance)} \item{setting_type}{Expected type for setting value. Should be "character", "vector", "numeric" or "logical"} \item{setting_required}{Flag indicating if the setting is required} \item{column_mapping}{Flag indicating if the setting corresponds to a column in the associated data} \item{column_type}{Expected type for the data column values. Should be "character","logical" or "numeric"} \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}{Category specifying where the setting should be located in shiny} + \item{setting_cat}{Setting category (data, measure, appearance)} }} \source{ Created for this package