From 4970ef03a26c249d92e8a2e397fcac43e7bedbab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ald=C3=A9ric=20Fraslin?= Date: Thu, 2 Jan 2025 17:28:59 +0100 Subject: [PATCH 1/3] Creation de fichiers R pour premiers tests --- R/standardisation_modeles.R | 27 +++++++++++++++++++++++++++ R/test_standardisation.R | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+) create mode 100644 R/standardisation_modeles.R create mode 100644 R/test_standardisation.R diff --git a/R/standardisation_modeles.R b/R/standardisation_modeles.R new file mode 100644 index 0000000..df1f4dd --- /dev/null +++ b/R/standardisation_modeles.R @@ -0,0 +1,27 @@ +#' Results table from a Cox Model +#' +#' @param cox_surv an object of class coxph +#' @param arm name of the treatment column in `df_surv`. Case-insensitive. Can be set to `NULL`. +#' @param digits significant digits +#' @param pval which test to get the p-value from, defaults to wald +#' +#' @return a flextable +#' @importFrom broom.helpers tidy_plus_plus +#' @importFrom dplyr arrange case_match case_when cur_group filter left_join mutate rename_with select summarise +#' @importFrom glue glue +#' @importFrom survival coxph +#' @importFrom stringr str_remove str_starts str_subset +#' @importFrom flextable align bg bold flextable fontsize hline_bottom merge_h padding set_header_df set_table_properties +#' @importFrom tidyselect matches +#' @export +#' +#' @examples +#' tm = grstat_example() +#' attach(tm, warn.conflicts=FALSE) +#' +#' ae_table_grade(df_ae=ae, df_enrol=enrolres, arm=NULL) %>% +#' as_flextable(header_show_n=TRUE) +#' +#' ae_table_grade(df_ae=ae, df_enrol=enrolres, arm="ARM") %>% +#' as_flextable(header_show_n=TRUE) +#' diff --git a/R/test_standardisation.R b/R/test_standardisation.R new file mode 100644 index 0000000..28a1d47 --- /dev/null +++ b/R/test_standardisation.R @@ -0,0 +1,32 @@ +library(survival) +library(MASS) +library(flextable) +library(dplyr) + +df_surv <- VA +df_surv <- df_surv %>% mutate(tmtarm = ifelse(treat == 1, "ARM A", "ARM B")) + +# Fit a stratified model +res_cox <- coxph(Surv(stime, status) ~ tmtarm + age + cell, data = df_surv) +tmtvar <- 'tmtarm' +oth_vars <- c('age', 'cell') + +df_cox <- broom.helpers::tidy_plus_plus(res_cox, exponentiate = T, conf.int = T) %>% + select(c('var_label', 'label', 'n_obs', 'n_event', 'estimate', 'statistic', 'p.value', 'conf.low', 'conf.high')) %>% + mutate(HR = ifelse(is.na(conf.low), '', glue::glue("{round(estimate, 2)} [{round(conf.low, 2)} ; {round(conf.high, 2)}]"))) %>% + select(-c('estimate', 'conf.low', 'conf.high')) + +as_flextable(df_cox) +#exponentiate the coefficient ? exponentiate = 1 +#conf.int ? default to FALSE +#conf.level : default to 0.95 +par = list() + +report_coxph = function(fit, label){ + a = broom::tidy(fit, exponentiate=TRUE, conf.int=TRUE) %>% + filter(term=="armTTT") %>% + mutate(across(-term, ~round(.x, 2))) + # a$estimate + # fit$xlevels + glue("The Hazard Ratio of treatment for {label} was {a$estimate} [95%CI {a$conf.low}; {a$conf.high}] (adjusted p-value: {a$p.value})") +} \ No newline at end of file From c72870bac57022410074c1f1961cf45c90ac86ee Mon Sep 17 00:00:00 2001 From: AckaFun Date: Fri, 3 Jan 2025 15:27:22 +0100 Subject: [PATCH 2/3] Mise au propre notamment suppression de test_standardisation --- NAMESPACE | 4 ++++ R/standardisation_modeles.R | 45 +++++++++++++++++++++++++----------- R/test_standardisation.R | 32 ------------------------- man/report_coxph.Rd | 17 ++++++++++++++ man/xx.Rd | 17 ++++++++++++++ tests/testthat/test-models.R | 20 ++++++++++++++++ 6 files changed, 89 insertions(+), 46 deletions(-) delete mode 100644 R/test_standardisation.R create mode 100644 man/report_coxph.Rd create mode 100644 man/xx.Rd create mode 100644 tests/testthat/test-models.R diff --git a/NAMESPACE b/NAMESPACE index 1696c9c..80f3c30 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,8 +13,11 @@ export(butterfly_plot) export(fct_yesno) export(gr_new_project) export(grstat_example) +export(report_coxph) export(tibble) export(waterfall_plot) +export(xx) +importFrom(broom.helpers,tidy_plus_plus) importFrom(cli,cli_abort) importFrom(cli,cli_inform) importFrom(cli,cli_vec) @@ -144,6 +147,7 @@ importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_wider_spec) importFrom(tidyr,replace_na) importFrom(tidyr,separate_wider_regex) +importFrom(tidyr,unite) importFrom(tidyr,unnest) importFrom(tidyselect,everything) importFrom(tidyselect,matches) diff --git a/R/standardisation_modeles.R b/R/standardisation_modeles.R index df1f4dd..0601e99 100644 --- a/R/standardisation_modeles.R +++ b/R/standardisation_modeles.R @@ -1,27 +1,44 @@ #' Results table from a Cox Model #' -#' @param cox_surv an object of class coxph -#' @param arm name of the treatment column in `df_surv`. Case-insensitive. Can be set to `NULL`. -#' @param digits significant digits -#' @param pval which test to get the p-value from, defaults to wald +#' @param fit +#' @param label #' #' @return a flextable #' @importFrom broom.helpers tidy_plus_plus #' @importFrom dplyr arrange case_match case_when cur_group filter left_join mutate rename_with select summarise #' @importFrom glue glue -#' @importFrom survival coxph #' @importFrom stringr str_remove str_starts str_subset #' @importFrom flextable align bg bold flextable fontsize hline_bottom merge_h padding set_header_df set_table_properties -#' @importFrom tidyselect matches +#' @importFrom tidyr unite #' @export +xx=function(fit){ + df_cox <- tidy_plus_plus(fit, exponentiate = T, conf.int = T) %>% + unite('n', n_event, n_obs, sep='/', remove=T) %>% + mutate(p_new = format.pval(p.value, digits = 3, eps = 0.001, na.form = ''), + HR = ifelse(is.na(conf.low), + '1.00', + glue("{format(round(estimate, 2), nsmall = 2)} [{round(conf.low, 2)} ; {round(conf.high, 2)}]"))) %>% + select(var_label, label, n, HR, p.value, p_new) + return(df_cox) +} + + +#' Title #' -#' @examples -#' tm = grstat_example() -#' attach(tm, warn.conflicts=FALSE) -#' -#' ae_table_grade(df_ae=ae, df_enrol=enrolres, arm=NULL) %>% -#' as_flextable(header_show_n=TRUE) +#' @param fit +#' @param label #' -#' ae_table_grade(df_ae=ae, df_enrol=enrolres, arm="ARM") %>% -#' as_flextable(header_show_n=TRUE) +#' @return a string +#' @export #' +#' @examples +report_coxph = function(fit, label){ + a = broom::tidy(fit, exponentiate=TRUE, conf.int=TRUE) %>% + filter(term=="armTTT") %>% + mutate(across(-term, ~round(.x, 2))) + # a$estimate + # fit$xlevels + glue("The Hazard Ratio of treatment for {label} was {a$estimate} [95%CI {a$conf.low}; {a$conf.high}] (adjusted p-value: {a$p.value})") +} + + diff --git a/R/test_standardisation.R b/R/test_standardisation.R deleted file mode 100644 index 28a1d47..0000000 --- a/R/test_standardisation.R +++ /dev/null @@ -1,32 +0,0 @@ -library(survival) -library(MASS) -library(flextable) -library(dplyr) - -df_surv <- VA -df_surv <- df_surv %>% mutate(tmtarm = ifelse(treat == 1, "ARM A", "ARM B")) - -# Fit a stratified model -res_cox <- coxph(Surv(stime, status) ~ tmtarm + age + cell, data = df_surv) -tmtvar <- 'tmtarm' -oth_vars <- c('age', 'cell') - -df_cox <- broom.helpers::tidy_plus_plus(res_cox, exponentiate = T, conf.int = T) %>% - select(c('var_label', 'label', 'n_obs', 'n_event', 'estimate', 'statistic', 'p.value', 'conf.low', 'conf.high')) %>% - mutate(HR = ifelse(is.na(conf.low), '', glue::glue("{round(estimate, 2)} [{round(conf.low, 2)} ; {round(conf.high, 2)}]"))) %>% - select(-c('estimate', 'conf.low', 'conf.high')) - -as_flextable(df_cox) -#exponentiate the coefficient ? exponentiate = 1 -#conf.int ? default to FALSE -#conf.level : default to 0.95 -par = list() - -report_coxph = function(fit, label){ - a = broom::tidy(fit, exponentiate=TRUE, conf.int=TRUE) %>% - filter(term=="armTTT") %>% - mutate(across(-term, ~round(.x, 2))) - # a$estimate - # fit$xlevels - glue("The Hazard Ratio of treatment for {label} was {a$estimate} [95%CI {a$conf.low}; {a$conf.high}] (adjusted p-value: {a$p.value})") -} \ No newline at end of file diff --git a/man/report_coxph.Rd b/man/report_coxph.Rd new file mode 100644 index 0000000..b65d2b5 --- /dev/null +++ b/man/report_coxph.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardisation_modeles.R +\name{report_coxph} +\alias{report_coxph} +\title{Title} +\usage{ +report_coxph(fit, label) +} +\arguments{ +\item{label}{} +} +\value{ +a string +} +\description{ +Title +} diff --git a/man/xx.Rd b/man/xx.Rd new file mode 100644 index 0000000..ddc456c --- /dev/null +++ b/man/xx.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardisation_modeles.R +\name{xx} +\alias{xx} +\title{Results table from a Cox Model} +\usage{ +xx(fit) +} +\arguments{ +\item{label}{} +} +\value{ +a flextable +} +\description{ +Results table from a Cox Model +} diff --git a/tests/testthat/test-models.R b/tests/testthat/test-models.R new file mode 100644 index 0000000..01fb38a --- /dev/null +++ b/tests/testthat/test-models.R @@ -0,0 +1,20 @@ +# On ne lance pas les fonctions on charge le package avec ctrl+shift+l +# Enlever les librarys d'ici + +test_that("shit works", { + # expect_equal(2 * 2, 4) + library(flextable) + library(tidyverse) + + df_surv <- MASS::VA %>% mutate(tmtarm = ifelse(treat == 1, "ARM A", "ARM B")) %>% + crosstable::apply_labels(tmtarm='Treatment Arm', age = 'Age (in years)', cell = 'Cell type') + + res_cox <- survival::coxph(Surv(stime, status) ~ tmtarm + age + cell, data = df_surv) + + df_cox <- xx(res_cox) + + as_flextable(df_cox) + +}) + +test_that("report") From 37af7db2227d60b3346a0d5b4f1628a1df69c4ce Mon Sep 17 00:00:00 2001 From: FRASLIN Alderic Date: Thu, 16 Apr 2026 12:08:17 +0200 Subject: [PATCH 3/3] one two one two MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Mise à jour des avancées sur les sorties de modèle --- NAMESPACE | 4 +- R/standardisation_modeles.R | 109 +++++++++++++++++++++++++++------ man/{xx.Rd => cox_regtable.Rd} | 10 +-- man/regtable.Rd | 21 +++++++ man/report_coxph.Rd | 12 ++-- tests/testthat/test-models.R | 20 +++--- 6 files changed, 135 insertions(+), 41 deletions(-) rename man/{xx.Rd => cox_regtable.Rd} (57%) create mode 100644 man/regtable.Rd diff --git a/NAMESPACE b/NAMESPACE index 80f3c30..0214c47 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method(as_flextable,ae_table_soc) +S3method(as_flextable,regtable) export("%>%") export(ae_plot_grade) export(ae_plot_grade_n) @@ -10,13 +11,13 @@ export(ae_table_grade) export(ae_table_soc) export(as_flextable) export(butterfly_plot) +export(cox_regtable) export(fct_yesno) export(gr_new_project) export(grstat_example) export(report_coxph) export(tibble) export(waterfall_plot) -export(xx) importFrom(broom.helpers,tidy_plus_plus) importFrom(cli,cli_abort) importFrom(cli,cli_inform) @@ -65,6 +66,7 @@ importFrom(flextable,hline_bottom) importFrom(flextable,merge_h) importFrom(flextable,padding) importFrom(flextable,set_header_df) +importFrom(flextable,set_header_labels) importFrom(flextable,set_table_properties) importFrom(forcats,as_factor) importFrom(forcats,fct_infreq) diff --git a/R/standardisation_modeles.R b/R/standardisation_modeles.R index 0601e99..bf098e3 100644 --- a/R/standardisation_modeles.R +++ b/R/standardisation_modeles.R @@ -1,43 +1,116 @@ #' Results table from a Cox Model #' -#' @param fit -#' @param label +#' @param fit an object of class coxph, output of the survival::coxph function #' -#' @return a flextable +#' @return an object of class regtable #' @importFrom broom.helpers tidy_plus_plus #' @importFrom dplyr arrange case_match case_when cur_group filter left_join mutate rename_with select summarise #' @importFrom glue glue #' @importFrom stringr str_remove str_starts str_subset -#' @importFrom flextable align bg bold flextable fontsize hline_bottom merge_h padding set_header_df set_table_properties #' @importFrom tidyr unite #' @export -xx=function(fit){ - df_cox <- tidy_plus_plus(fit, exponentiate = T, conf.int = T) %>% +#' +cox_regtable = function(fit){ + rtn = tidy_plus_plus(fit, exponentiate = T, conf.int = T) %>% unite('n', n_event, n_obs, sep='/', remove=T) %>% + #On crée une p-value avec 3 chiffres sign. ou <0.001 mutate(p_new = format.pval(p.value, digits = 3, eps = 0.001, na.form = ''), HR = ifelse(is.na(conf.low), '1.00', - glue("{format(round(estimate, 2), nsmall = 2)} [{round(conf.low, 2)} ; {round(conf.high, 2)}]"))) %>% - select(var_label, label, n, HR, p.value, p_new) - return(df_cox) + glue("{format(round(estimate, 2), nsmall = 2)} [{round(conf.low, 2)};{round(conf.high, 2)}]"))) %>% + select(var_label, label, n, HR, p_new) %>% + group_by(var_label) %>% + mutate(rep = row_number()) %>% + ungroup() %>% + mutate(var_label = ifelse(rep > 1, '', var_label), + label = ifelse(label == var_label, '', label)) %>% + select(-rep) %>% + add_class("regtable") + + attr(rtn, "header") = + c( + var_label = 'Variable', + label = '', + n = 'Number of events/N', + HR = 'HR [95% CI]', + p_new = 'p-value' + ) + return(rtn) +} + +#' Turns a `regtable` object into a formatted `flextable` +#' +#' @param x a dataframe, resulting of `cox_regtable()` +#' @param padding_v a numeric of lenght up to 2, giving the vertical padding of body (1) and header (2) +#' @param ... unused +#' +#' @return a formatted flextable +#' @rdname regtable +#' @export +#' +#' @importFrom dplyr case_match lag lead transmute +#' @importFrom flextable align bg bold flextable fontsize hline_bottom merge_h padding set_header_labels set_table_properties +#' @importFrom purrr map map_int +#' @importFrom rlang check_dots_empty set_names +#' @importFrom stringr str_detect str_replace_all +#' @importFrom tibble as_tibble_col +#' @importFrom tidyr separate_wider_regex +as_flextable.regtable = function(x, + ..., + padding_v = 10){ + check_dots_empty() + table_reg_header = attr(x, "header") + + + header_df = names(x) %>% + as_tibble_col("col_keys") %>% + separate_wider_regex(col_keys, c(h1 = ".*", "_", h2 = ".*"), too_few="align_start", cols_remove=FALSE) %>% + transmute( + col_keys + ) + + + rtn = x %>% + flextable() %>% + set_header_labels(values = table_reg_header) %>% + hline_bottom(part="header") %>% + merge_h(part="header") %>% + align(i=1, part="header", align="center") %>% + align(j=seq('Variable'), part="all", align="right") %>% + padding(padding.top=0, padding.bottom=0) %>% + set_table_properties(layout="autofit") %>% + fontsize(size=12, part="all") %>% + bold(part="header") + if (length(padding_v) >= 1) { + rtn = padding(rtn, padding.top=padding_v[1], padding.bottom=padding_v[1], part="body") + } + if (length(padding_v) == 2) { + rtn = padding(rtn, padding.top=padding_v[2], padding.bottom=padding_v[2], part="header") + } + + rtn } -#' Title + +#' Result sentence #' -#' @param fit -#' @param label +#' @param fit an object of class coxph, output of the survival::coxph function +#' @param label a string corresponding to the label for treatment +#' @param arm a string corresponding to the treatment arm variable name in the coxph #' #' @return a string #' @export -#' -#' @examples -report_coxph = function(fit, label){ +report_coxph = function(fit, label, arm){ + a = broom::tidy(fit, exponentiate=TRUE, conf.int=TRUE) %>% - filter(term=="armTTT") %>% + filter(substr(term, 1, nchar(arm))==arm) %>% mutate(across(-term, ~round(.x, 2))) - # a$estimate - # fit$xlevels + + if(nrow(a) == 0){ + cli_abort("({.val {arm}}) is not present in given fit.") + } + glue("The Hazard Ratio of treatment for {label} was {a$estimate} [95%CI {a$conf.low}; {a$conf.high}] (adjusted p-value: {a$p.value})") } diff --git a/man/xx.Rd b/man/cox_regtable.Rd similarity index 57% rename from man/xx.Rd rename to man/cox_regtable.Rd index ddc456c..60907ae 100644 --- a/man/xx.Rd +++ b/man/cox_regtable.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/standardisation_modeles.R -\name{xx} -\alias{xx} +\name{cox_regtable} +\alias{cox_regtable} \title{Results table from a Cox Model} \usage{ -xx(fit) +cox_regtable(fit) } \arguments{ -\item{label}{} +\item{fit}{an object of class coxph, output of the survival::coxph function} } \value{ -a flextable +an object of class regtable } \description{ Results table from a Cox Model diff --git a/man/regtable.Rd b/man/regtable.Rd new file mode 100644 index 0000000..96cbcdc --- /dev/null +++ b/man/regtable.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardisation_modeles.R +\name{as_flextable.regtable} +\alias{as_flextable.regtable} +\title{Turns a \code{regtable} object into a formatted \code{flextable}} +\usage{ +\method{as_flextable}{regtable}(x, ..., padding_v = 10) +} +\arguments{ +\item{x}{a dataframe, resulting of \code{cox_regtable()}} + +\item{...}{unused} + +\item{padding_v}{a numeric of lenght up to 2, giving the vertical padding of body (1) and header (2)} +} +\value{ +a formatted flextable +} +\description{ +Turns a \code{regtable} object into a formatted \code{flextable} +} diff --git a/man/report_coxph.Rd b/man/report_coxph.Rd index b65d2b5..27f6911 100644 --- a/man/report_coxph.Rd +++ b/man/report_coxph.Rd @@ -2,16 +2,20 @@ % Please edit documentation in R/standardisation_modeles.R \name{report_coxph} \alias{report_coxph} -\title{Title} +\title{Result sentence} \usage{ -report_coxph(fit, label) +report_coxph(fit, label, arm) } \arguments{ -\item{label}{} +\item{fit}{an object of class coxph, output of the survival::coxph function} + +\item{label}{a string corresponding to the label for treatment} + +\item{arm}{a string corresponding to the treatment arm variable name in the coxph} } \value{ a string } \description{ -Title +Result sentence } diff --git a/tests/testthat/test-models.R b/tests/testthat/test-models.R index 01fb38a..05fceda 100644 --- a/tests/testthat/test-models.R +++ b/tests/testthat/test-models.R @@ -1,20 +1,14 @@ # On ne lance pas les fonctions on charge le package avec ctrl+shift+l # Enlever les librarys d'ici -test_that("shit works", { - # expect_equal(2 * 2, 4) - library(flextable) - library(tidyverse) - df_surv <- MASS::VA %>% mutate(tmtarm = ifelse(treat == 1, "ARM A", "ARM B")) %>% - crosstable::apply_labels(tmtarm='Treatment Arm', age = 'Age (in years)', cell = 'Cell type') +test_that("cox_regtable() works", { + local_reproducible_output(width=125) - res_cox <- survival::coxph(Surv(stime, status) ~ tmtarm + age + cell, data = df_surv) + lung = survival::lung + fit = coxph(Surv(time, status) ~ as.factor(ph.ecog) + age, data=lung) - df_cox <- xx(res_cox) + ald = cox_regtable(fit) + expect_s3_class(ald, "regtable") + }) - as_flextable(df_cox) - -}) - -test_that("report")