Baptiste Nusaibah validation #11
Conversation
There was a problem hiding this comment.
Très bon début c'est super !
Il faut qu'on discute de l'output.
A terme, il faut que ça ait la structure d'un test de package, donc avec la syntaxe de testthat que je vous avais présentée.
https://github.com/Oncostat/grstat/blob/main/tests/testthat/test-ae-tables.R
Cette syntaxe n'a pas de nuance, soit le test passe, soit il échoue.
Proposition :
- utiliser
expect_xxx()pour tester les différences de N et pct (diff majeure) - utiliser
message()pour signaler les différences de style (diff mineure), genre les informations manquantes dans une tables mais pas dans l'autre
Par contre c'est difficile de lire le code sans voir l'application vu que les data sont private.
Ce serait compliqué de faire ce qu'il y a dans #9 pour pouvoir tout faire sur GitHub ?
There was a problem hiding this comment.
ce seront des fonctions de testing, elles ne doivent pas aller dans R/
Utilise usethis::use_test_helper()
Tu peux aussi aller voir la doc de testthat: https://cran.r-project.org/web/packages/testthat/vignettes/special-files.html
|
|
||
| if (ncol(tabR)!=ncol(tabSAS)){stop("Different number of arm")} | ||
| if (all(dim(tabR)==dim(tabSAS))){ | ||
| print("Check: same dimension of tables") |
There was a problem hiding this comment.
programmation défensive: on ne print pas si tout va bien, on warn s'il y a un problème
| 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")], |
There was a problem hiding this comment.
je n'aime vraiment pas les indices, je trouve que c'est à risque d'erreur
Cf mon commentaire sur Teams
| mutate(grade = replace_na(grade, 0)) %>% | ||
| group_by(grade) %>% | ||
| mutate(across(starts_with("N"), ~sum(., na.rm = T))) %>% | ||
| distinct(grade, .keep_all = T) %>% |
There was a problem hiding this comment.
On ne peut pas remplacer mutate+distinct par summarise ?
There was a problem hiding this comment.
je crois que c'est parce que je n'arrivais pas à keep toutes les variables dans la base avec summarize(.by=) quand il y avait plusieurs bras
| data <- colnames(data) %>% | ||
| imap( | ||
| ~data %>% select(all_of(.x)) %>% | ||
| separate(.x, into = c(paste0("N", .y), paste0("pct", .y)), sep = "\\(") | ||
| ) %>% | ||
| bind_cols() |
There was a problem hiding this comment.
https://tidyr.tidyverse.org/reference/separate_wider_delim.html
On doit pouvoir s'en sortir sans boucle avec separate_wider_regex(), pas évident mais l'exemple aide beaucoup.
| 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) | ||
| } |
There was a problem hiding this comment.
Je vais avoir besoin de lancer le code pour trouver comment appliquer purrr
| mutate(grade = replace_na(grade, 0)) %>% | ||
| group_by(grade) %>% |
There was a problem hiding this comment.
mutate(.by=grade), plus concis et ne nécessite pas de ungroup()
| if (nrow(tabR)!=nrow(tabSAS)){stop("Different number of grade levels") | ||
| } |
There was a problem hiding this comment.
soit sur une ligne, sans les {},
soit sur 3 lignes
jamais sur 2
NusaibahIbr
changed the title
| 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*"))) | ||
| ) |
There was a problem hiding this comment.
Belle utilisation de imap() :-)
Il y a une nouvelle fonction detidyr qui ferait le taff aussi (à adapter à plusieurs bras, c'est juste pour l'exemple):
data %>%
separate_wider_regex(cols=-c(.id, label, variable, grade),
patterns=c(N="\\d+", " \\(", pct="\\d+", "%\\)"))
There was a problem hiding this comment.
Super Nusaibah, merci beaucoup !
Par contre il y a des erreurs dans les outputs donc ce n'est malheureusement pas terminé 😕.
Désolé de t'embêter encore !
Pour simplifier le process, je t'ai créé un dossier \rsas\_test_nusaibah\ avec tous les inputs/outputs/tests standardisés. Tu peux lancer le rproj et sourcer (ctrl shift s) le fichier test.nusaibah.R directement.
Le dossier fonctions_validationR contient tes fonctions de validations sans modification de ma part (je crois, en tout cas pas dans compare_xxx, mais remplace par tes propres fichiers pour être sûr).
Tu peux modifier ce que tu veux comme bon te semble, je n'y touche plus.
La fonction add_errors() ajoute une erreur standard à la 2ème ligne des tableaux R. Ca devrait correspondre au grade 1 dans AEGRADE, mais l'output donne le grade 0 pour les pourcentages.
Dans AESOC, il y a un problème de jointure quand on renseigne les termes and plus des SOC, je t'ai mis la ligne en code-review.
Je reste évidemment dispo si besoin qu'on en discute :-) !
|
|
||
| if (nrow(indice)!=0){ | ||
|
|
||
| tab =rbind.fill(as.data.frame(tab),indice%>% |
There was a problem hiding this comment.
La fonction rbind.fill() vient du package plyr qui n'est pas importé dans grstat et ne devrait vraiment plus être utilisé aujourd'hui (package non maintenu). Je te conseillerais même de désinstaller plyr pour éviter de l'utiliser par erreur. Je crois qu'on peut remplacer par bind_rows().
| df=tabR%>%arrange(soc)%>% | ||
| pivot_longer(-c("soc"),names_to = "grade",values_to = "count")%>% | ||
| mutate(table="R")%>% | ||
| full_join(tabSAS%>% #instead of full |
There was a problem hiding this comment.
Ce full join émet un warning :
Avis dans full_join(., tabSAS %>% pivot_longer(-c("soc"), names_to = "grade", :
Detected an unexpected many-to-many relationship between `x` and `y`.
ℹ Row 1 of `x` matches multiple rows in `y`.
ℹ Row 1 of `y` matches multiple rows in `x`.
ℹ If a many-to-many relationship is expected, set `relationship = "many-to-many"` to
silence this warning.
Il est émit quand term est renseigné, et je crois qu'il fautdrait écrire pivot_longer(-any_of(c("soc", "term"), ...), ou quelque chose du genre (et dans by aussi).
J'ai l'impression que le problème d'output vient de là.
Add of functions for validation of function ae_table_grade