diff --git a/NAMESPACE b/NAMESPACE index 1696c9c..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,11 +11,14 @@ 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) +importFrom(broom.helpers,tidy_plus_plus) importFrom(cli,cli_abort) importFrom(cli,cli_inform) importFrom(cli,cli_vec) @@ -62,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) @@ -144,6 +149,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 new file mode 100644 index 0000000..bf098e3 --- /dev/null +++ b/R/standardisation_modeles.R @@ -0,0 +1,117 @@ +#' Results table from a Cox Model +#' +#' @param fit an object of class coxph, output of the survival::coxph function +#' +#' @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 tidyr unite +#' @export +#' +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_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 +} + + + +#' Result sentence +#' +#' @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 +report_coxph = function(fit, label, arm){ + + a = broom::tidy(fit, exponentiate=TRUE, conf.int=TRUE) %>% + filter(substr(term, 1, nchar(arm))==arm) %>% + mutate(across(-term, ~round(.x, 2))) + + 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/cox_regtable.Rd b/man/cox_regtable.Rd new file mode 100644 index 0000000..60907ae --- /dev/null +++ b/man/cox_regtable.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardisation_modeles.R +\name{cox_regtable} +\alias{cox_regtable} +\title{Results table from a Cox Model} +\usage{ +cox_regtable(fit) +} +\arguments{ +\item{fit}{an object of class coxph, output of the survival::coxph function} +} +\value{ +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 new file mode 100644 index 0000000..27f6911 --- /dev/null +++ b/man/report_coxph.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standardisation_modeles.R +\name{report_coxph} +\alias{report_coxph} +\title{Result sentence} +\usage{ +report_coxph(fit, label, arm) +} +\arguments{ +\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{ +Result sentence +} diff --git a/tests/testthat/test-models.R b/tests/testthat/test-models.R new file mode 100644 index 0000000..05fceda --- /dev/null +++ b/tests/testthat/test-models.R @@ -0,0 +1,14 @@ +# On ne lance pas les fonctions on charge le package avec ctrl+shift+l +# Enlever les librarys d'ici + + +test_that("cox_regtable() works", { + local_reproducible_output(width=125) + + lung = survival::lung + fit = coxph(Surv(time, status) ~ as.factor(ph.ecog) + age, data=lung) + + ald = cox_regtable(fit) + expect_s3_class(ald, "regtable") + }) +