Baptiste Nusaibah validation

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: grstat
 Type: Package
 Title: Clinical Research Tools
-Version: 0.1.0.9004
+Version: 0.1.0.9006
 Authors@R: c(
       person("Dan", "Chaltiel", role = c("aut", "cre"),
              email = "[email protected]",

R/validation fonctions AE_table_grade/compair_grade.R

@@ -0,0 +1,24 @@
+
+compair_grade <- function(tabR,tabSAS){
+
+  if (nrow(tabR)!=nrow(tabSAS)){stop("Different number of grade levels")
+  }
+
+  if (ncol(tabR)!=ncol(tabSAS)){stop("Different number of arm")}
+  if (all(dim(tabR)==dim(tabSAS))){
+    print("Check: same dimension of tables")
+    df=tabR%>%arrange(grade)%>%full_join(tabSAS,by="grade",suffix = c(".r",".sas"))
+    indice=which(df[,paste0(tabR%>%select(-grade)%>%colnames(),paste=".r")]!=df[,paste0(tabSAS%>%select(-grade)%>%colnames(),paste=".sas")],
+                 arr.ind=TRUE)
+    indice[,"col"]=indice[,"col"]+1 # parce qu'on avait retiré le grade
+  }
+  if (nrow(indice)!=0){
+    print(indice)
+    warning(paste0("Comparison result: Warning! Different outputs.\n",
+                   nrow(indice)," mismatching between the two tables. Above, the indices."))
+
+  }else{
+    warning("Comparison result: same outputs")
+  }
+
+}

R/validation fonctions AE_table_grade/group_grades_zeroNA.R

@@ -0,0 +1,23 @@
+#fonction grouping figures of missing grades and grades 0 for R function ae_table_grade
+group_grades_zeroNA <- function(data, round = 0){
+
+  #suming N of missing grades and grades 0
+  data <- data %>%
+    mutate(grade = replace_na(grade, 0)) %>% 
+    group_by(grade) %>% 
+    mutate(across(starts_with("N"), ~sum(., na.rm = T))) %>% 
+    distinct(grade, .keep_all = T) %>% 
+    ungroup()
+
+  #recalculating pct
+  ngroups <- (ncol(data) - 1) / 2
+  for(i in 1:ngroups){
+    npatients <- sum(data[, paste0("N", i)])
+    data[data$grade == 0, paste0("pct", i)] <- round(data[data$grade == 0, paste0("N", i)] * 100 / npatients, round)
+  }
+
+  data <- data %>% arrange(grade)
+
+  return(data)
+
+}

R/validation fonctions AE_table_grade/separate_n_pct.R

@@ -0,0 +1,20 @@
+#fonction separating each column N(pct) into 2 columns N and pct
+separate_n_pct <- function(data){
+
+  #separation of 1 character column into 2 character columns
+  data <- colnames(data) %>% 
+    imap(
+      ~data %>% select(all_of(.x)) %>% 
+        separate(.x, into = c(paste0("N", .y), paste0("pct", .y)), sep = "\\(")
+    ) %>% 
+    bind_cols()
+
+  #extraction of figures into numeric columns
+  data <- data %>% 
+    mutate(
+      across(everything(), ~as.numeric(str_extract(.x, "\\d+\\.?\\d*")))
+    )
+
+  return(data)
+
+}

R/validation fonctions AE_table_grade/validate_ae_table_grade.R

@@ -0,0 +1,31 @@
+#fonction comparing R and SAS outputs
+validate_ae_table_grade <- function(R_output, 
+                                    SAS_output, 
+                                    round = 0 #rounding of recalculated percentages in group_grades_zeroNA()
+                                    ){
+
+  #formatting grade from character to numeric
+  R_output <- R_output %>% 
+    mutate(grade = ifelse(variable == "No declared AE", 0, as.numeric(str_extract(variable, "\\d"))))
+  SAS_output <- SAS_output %>% 
+    mutate(grade = as.numeric(str_extract(max_aegr1, "\\d")))
+
+  #separating each column N(pct) into 2 columns N and pct
+  R_separated <- R_output %>% select(grade) %>% 
+    bind_cols(
+      separate_n_pct(R_output %>% select(-c(.id, label, variable, grade)))
+    )
+  SAS_separated <- SAS_output %>% select(grade) %>% 
+    bind_cols(
+      separate_n_pct(SAS_output %>% select(-c(max_aegr1, grade)))
+    )
+
+  #missing figure with macro SAS <=> 0 with R package
+  SAS_separated <- SAS_separated %>% 
+    replace(is.na(.), 0)
+
+  #grouping figures of missing grades and grades 0 for R function
+  R_separated <- group_grades_zeroNA(R_separated, round = round)
+
+  return(list(R = R_separated, SAS = SAS_separated)) 
+}