├── docs └── _config.yml ├── LICENSE ├── .DS_Store ├── R ├── .DS_Store ├── utils-gems.R ├── zzz_globals.R ├── get_operating_system.R ├── aesthetics.R ├── samplev.R ├── zzz_imports.R ├── format_cea_table.R ├── check_list_elements.R ├── v_names_states.R ├── within_cycle_corrections.R ├── rate_conversion.R ├── check_transition_probabilities.R ├── plot_psa_distributions.R └── visualization.R ├── man ├── .DS_Store ├── get_os.Rd ├── get_DARTH_cols.Rd ├── plot_tc.Rd ├── plot_te.Rd ├── plot_trace.Rd ├── get_v_names_states.Rd ├── prob_to_odds.Rd ├── labfun.Rd ├── odds_to_prob.Rd ├── surv_to_haz.Rd ├── check_PFS_OS.Rd ├── format_table_cea.Rd ├── runMLE.cure.Rd ├── trans_prob.Rd ├── cumhaz_to_haz.Rd ├── plot_trace_microsim.Rd ├── trans_to_surv.Rd ├── expected_surv.Rd ├── gen_data.Rd ├── plot_surv.Rd ├── plot_trace_strategy.Rd ├── samplev.Rd ├── calc_surv.Rd ├── hazard.fn.Rd ├── calc_sick.Rd ├── create_at_risk_table.Rd ├── number_ticks.Rd ├── rate_to_prob.Rd ├── prob_to_rate.Rd ├── find_interval_limits.Rd ├── trace.DES.Rd ├── plot_trace_microsim_shiny.Rd ├── plot_prevalence.Rd ├── surv_prob.Rd ├── plot_trace_PSM.Rd ├── calc_prevalence.Rd ├── prob_to_prob.Rd ├── check_list_elements.Rd ├── plot_proportion_sicker.Rd ├── boot.haz.Rd ├── calc_prop_sicker.Rd ├── update_param_list.Rd ├── check_transition_probability.Rd ├── normboot.haz.Rd ├── boot_haz_np.Rd ├── model.dist.Rd ├── fit.mstate.Rd ├── check_sum_of_transition_array.Rd ├── model.rmvnorm.Rd ├── all_partsurv.Rd ├── set_v_names_states.Rd ├── fit.models.cure.Rd ├── boot_hr.Rd ├── plot_psa.Rd ├── plot_evpi.Rd ├── gen_wcc.Rd ├── plot_exp_loss.Rd ├── plot_ceac.Rd ├── fit.fun.cure.Rd ├── fit.fun.Rd ├── plot_icers.Rd ├── add_common_aes.Rd ├── plot_psa_distributions.Rd └── partsurv.Rd ├── data_hund_icers.rds ├── NEWS.md ├── tests └── spelling.R ├── .Rbuildignore ├── inst └── WORDLIST ├── darthtools.Rproj ├── vignettes └── intro.Rmd ├── cran-comments.md ├── .gitignore ├── LICENSE.md ├── README.Rmd ├── README.md ├── DESCRIPTION ├── .github └── workflows │ └── rhub.yaml └── NAMESPACE /docs/_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-minimal -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2025 2 | COPYRIGHT HOLDER: DARTH Workgroup 3 | -------------------------------------------------------------------------------- /.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DARTH-git/darthtools/HEAD/.DS_Store -------------------------------------------------------------------------------- /R/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DARTH-git/darthtools/HEAD/R/.DS_Store -------------------------------------------------------------------------------- /man/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DARTH-git/darthtools/HEAD/man/.DS_Store -------------------------------------------------------------------------------- /data_hund_icers.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DARTH-git/darthtools/HEAD/data_hund_icers.rds -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # darthtools 0.3.0 2 | 3 | # darthtools 0.2.2 4 | 5 | # darthtools 0.2.1 6 | 7 | # darthtools 0.2.0 8 | 9 | # darthtools 0.1.0 10 | 11 | * Initial CRAN submission. 12 | -------------------------------------------------------------------------------- /tests/spelling.R: -------------------------------------------------------------------------------- 1 | if(requireNamespace('spelling', quietly = TRUE)) 2 | spelling::spell_check_test(vignettes = TRUE, error = FALSE, 3 | skip_on_cran = TRUE) 4 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^darthtools\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^\.github$ 5 | ^docs$ 6 | ^doc$ 7 | ^Meta$ 8 | ^data_hund_icers\.rds$ 9 | ^cran-comments\.md$ 10 | cran-comments.md 11 | ^^\\.github$$ 12 | ^LICENSE\.md$ 13 | -------------------------------------------------------------------------------- /R/utils-gems.R: -------------------------------------------------------------------------------- 1 | .gems_pmixsurv <- function(...) { 2 | if (!requireNamespace("gems", quietly = TRUE)) { 3 | stop("Package 'gems' is required for pmixsurv(). Please install it.", call. = FALSE) 4 | } 5 | utils::getFromNamespace("pmixsurv", "gems")(...) 6 | } 7 | -------------------------------------------------------------------------------- /man/get_os.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_operating_system.R 3 | \name{get_os} 4 | \alias{get_os} 5 | \title{Get operating system} 6 | \usage{ 7 | get_os() 8 | } 9 | \value{ 10 | A string with the operating system. 11 | } 12 | \description{ 13 | \code{get_os} gets the operating system. 14 | } 15 | -------------------------------------------------------------------------------- /man/get_DARTH_cols.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aesthetics.R 3 | \name{get_DARTH_cols} 4 | \alias{get_DARTH_cols} 5 | \title{Get DARTH colors} 6 | \usage{ 7 | get_DARTH_cols() 8 | } 9 | \value{ 10 | a string containing DARTH color codes 11 | } 12 | \description{ 13 | \code{get_DARTH_cols} retrieves the color codes for DARTH colors. 14 | } 15 | -------------------------------------------------------------------------------- /R/zzz_globals.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | utils::globalVariables(c( 3 | "times", "time", "v_names_states", "v_names_str", 4 | "n_cycles", "n_states", "n_str", "rx", 5 | "Cycle", "Strategy", "Sick", "Survival", 6 | "Prevalence", "Proportion.Sicker", 7 | "Interval", "Lower", "Upper", 8 | "Model", "mod", "color", "label", "est", 9 | "des_sim", "subject", "value", 10 | "Health State" 11 | )) 12 | -------------------------------------------------------------------------------- /man/plot_tc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_tc} 4 | \alias{plot_tc} 5 | \title{Plot density of total cost} 6 | \usage{ 7 | plot_tc(tc) 8 | } 9 | \arguments{ 10 | \item{tc}{total cost} 11 | } 12 | \value{ 13 | a plot of the density of total cost 14 | } 15 | \description{ 16 | \code{plot_tc} plots density of total cost. 17 | } 18 | -------------------------------------------------------------------------------- /man/plot_te.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_te} 4 | \alias{plot_te} 5 | \title{Plot density of total QALYs} 6 | \usage{ 7 | plot_te(te) 8 | } 9 | \arguments{ 10 | \item{te}{total QALYs} 11 | } 12 | \value{ 13 | a plot of the density of total QALYs 14 | } 15 | \description{ 16 | \code{plot_te} plots density of total QALYs 17 | } 18 | -------------------------------------------------------------------------------- /man/plot_trace.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_trace} 4 | \alias{plot_trace} 5 | \title{Plot cohort trace} 6 | \usage{ 7 | plot_trace(m_M) 8 | } 9 | \arguments{ 10 | \item{m_M}{a cohort trace matrix} 11 | } 12 | \value{ 13 | a ggplot object - plot of the cohort trace 14 | } 15 | \description{ 16 | \code{plot_trace} plots the cohort trace. 17 | } 18 | -------------------------------------------------------------------------------- /man/get_v_names_states.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/v_names_states.R 3 | \name{get_v_names_states} 4 | \alias{get_v_names_states} 5 | \title{Get currently registered health-state names (if any).} 6 | \usage{ 7 | get_v_names_states() 8 | } 9 | \value{ 10 | Character vector or NULL if unset. 11 | } 12 | \description{ 13 | Get currently registered health-state names (if any). 14 | } 15 | -------------------------------------------------------------------------------- /man/prob_to_odds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rate_conversion.R 3 | \name{prob_to_odds} 4 | \alias{prob_to_odds} 5 | \title{Convert a probability to an odds} 6 | \usage{ 7 | prob_to_odds(p) 8 | } 9 | \arguments{ 10 | \item{p}{a scalar of vector of probabilities} 11 | } 12 | \value{ 13 | a scalar or vector of odds 14 | } 15 | \description{ 16 | \code{prob_to_odds} convert a probability to an odds. 17 | } 18 | -------------------------------------------------------------------------------- /man/labfun.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{labfun} 4 | \alias{labfun} 5 | \title{used to automatically label continuous scales} 6 | \usage{ 7 | labfun(x) 8 | } 9 | \arguments{ 10 | \item{x}{axis breaks} 11 | } 12 | \value{ 13 | a character vector giving a label for each input value 14 | } 15 | \description{ 16 | used to automatically label continuous scales 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/odds_to_prob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rate_conversion.R 3 | \name{odds_to_prob} 4 | \alias{odds_to_prob} 5 | \title{Convert a odds to a probability} 6 | \usage{ 7 | odds_to_prob(odds) 8 | } 9 | \arguments{ 10 | \item{odds}{a scalar of vector of odds} 11 | } 12 | \value{ 13 | a scalar or vector of probabilities 14 | } 15 | \description{ 16 | \code{odds_to_prob} convert an odds to a probability. 17 | } 18 | -------------------------------------------------------------------------------- /man/surv_to_haz.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{surv_to_haz} 4 | \alias{surv_to_haz} 5 | \title{Convert survival probabilities to hazard rates.} 6 | \usage{ 7 | surv_to_haz(surv) 8 | } 9 | \arguments{ 10 | \item{surv}{vector of survival probabilities.} 11 | } 12 | \value{ 13 | vector of hazard rates 14 | } 15 | \description{ 16 | \code{surv_to_haz} convert survival probabilities to hazard rates. 17 | } 18 | -------------------------------------------------------------------------------- /man/check_PFS_OS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{check_PFS_OS} 4 | \alias{check_PFS_OS} 5 | \title{Print a warning message if PFS > OS} 6 | \usage{ 7 | check_PFS_OS(Sick) 8 | } 9 | \arguments{ 10 | \item{Sick}{vector (or matrix) of PFS - OS probabilities} 11 | } 12 | \value{ 13 | a warning message if PFS > OS 14 | } 15 | \description{ 16 | \code{check_PFS_OS} prints a warning message if PFS > OS. 17 | } 18 | -------------------------------------------------------------------------------- /man/format_table_cea.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/format_cea_table.R 3 | \name{format_table_cea} 4 | \alias{format_table_cea} 5 | \title{Format CEA table} 6 | \usage{ 7 | format_table_cea(table_cea) 8 | } 9 | \arguments{ 10 | \item{table_cea}{a dataframe object - table with CEA results} 11 | } 12 | \value{ 13 | a dataframe object - formatted CEA table 14 | } 15 | \description{ 16 | \code{format_table_cea} formats the CEA table. 17 | } 18 | -------------------------------------------------------------------------------- /man/runMLE.cure.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{runMLE.cure} 4 | \alias{runMLE.cure} 5 | \title{run MLE on cure models} 6 | \usage{ 7 | runMLE.cure(x, exArgs) 8 | } 9 | \arguments{ 10 | \item{x}{Data or model object used to estimate the cure model by MLE.} 11 | 12 | \item{exArgs}{Named list of additional arguments passed to the optimizer/fitting routine.} 13 | } 14 | \description{ 15 | run MLE on cure models 16 | } 17 | -------------------------------------------------------------------------------- /man/trans_prob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{trans_prob} 4 | \alias{trans_prob} 5 | \title{Calculate transition probabilities.} 6 | \usage{ 7 | trans_prob(surv) 8 | } 9 | \arguments{ 10 | \item{surv}{vector of survival probabilities.} 11 | } 12 | \value{ 13 | vector of transition probabilities 14 | } 15 | \description{ 16 | \code{trans_prob} calculates transition probabilities using survival probabilities. 17 | } 18 | -------------------------------------------------------------------------------- /man/cumhaz_to_haz.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{cumhaz_to_haz} 4 | \alias{cumhaz_to_haz} 5 | \title{Converts cumulative hazards to hazard rates} 6 | \usage{ 7 | cumhaz_to_haz(cumhaz) 8 | } 9 | \arguments{ 10 | \item{cumhaz}{vector of cumulative hazards} 11 | } 12 | \value{ 13 | vector of hazard rates 14 | } 15 | \description{ 16 | \code{cumhaz_to_haz} converts cumulative hazards to hazard rates across time points. 17 | } 18 | -------------------------------------------------------------------------------- /man/plot_trace_microsim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_trace_microsim} 4 | \alias{plot_trace_microsim} 5 | \title{Plot cohort trace of a microsimulation model} 6 | \usage{ 7 | plot_trace_microsim(m_M) 8 | } 9 | \arguments{ 10 | \item{m_M}{a cohort trace matrix} 11 | } 12 | \value{ 13 | a plot of the cohort trace 14 | } 15 | \description{ 16 | \code{plot_trace_microsim} plots cohort trace of a microsimulation model. 17 | } 18 | -------------------------------------------------------------------------------- /man/trans_to_surv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{trans_to_surv} 4 | \alias{trans_to_surv} 5 | \title{Convert transition probabilities back to survival probabilities.} 6 | \usage{ 7 | trans_to_surv(t.p) 8 | } 9 | \arguments{ 10 | \item{t.p}{vector of transition probabilities.} 11 | } 12 | \value{ 13 | vector of survival probabilities 14 | } 15 | \description{ 16 | \code{trans_to_surv} convert transition probabilities back to survival probabilities. 17 | } 18 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | CEA 2 | CEAC 3 | Chhatwal 4 | DES 5 | Decis 6 | ELC 7 | EVPI 8 | Elbasha 9 | GBP 10 | Gompertz 11 | ICER 12 | ICERs 13 | INLA 14 | Mak 15 | PFS 16 | PSA 17 | Parmar 18 | Pharmacoeconomics 19 | QALY 20 | QALYs 21 | RStudio 22 | Royston 23 | Surv 24 | WCC 25 | Workgroup 26 | flexsurv 27 | genf 28 | gengamma 29 | geoms 30 | ggplot 31 | gompertz 32 | greyscale 33 | greystart 34 | hmc 35 | llogis 36 | lnorm 37 | loglogistic 38 | microsimulation 39 | mle 40 | nd 41 | psa 42 | rx 43 | survHE 44 | vc 45 | weibull 46 | weibullPH 47 | workgroup 48 | -------------------------------------------------------------------------------- /darthtools.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 863fb7d9-f877-4a96-a999-b7f63f8008e6 3 | 4 | RestoreWorkspace: Default 5 | SaveWorkspace: Default 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | StripTrailingWhitespace: Yes 18 | 19 | BuildType: Package 20 | PackageUseDevtools: Yes 21 | PackageInstallArgs: --no-multiarch --with-keep.source 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /man/expected_surv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{expected_surv} 4 | \alias{expected_surv} 5 | \title{Calculate expected survival.} 6 | \usage{ 7 | expected_surv(time, surv) 8 | } 9 | \arguments{ 10 | \item{time}{vector of time to estimate probabilities.} 11 | 12 | \item{surv}{vector of survival probabilities.} 13 | } 14 | \value{ 15 | expected survival. 16 | } 17 | \description{ 18 | \code{expected_surv} calculates expected survival (area under survival curve). 19 | } 20 | -------------------------------------------------------------------------------- /man/gen_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{gen_data} 4 | \alias{gen_data} 5 | \title{Generate data for partitioned survival models (PFS and OS data).} 6 | \usage{ 7 | gen_data(n_pat, n_years) 8 | } 9 | \arguments{ 10 | \item{n_pat}{number of patients.} 11 | 12 | \item{n_years}{follow-up period in years.} 13 | } 14 | \value{ 15 | generated survival data. 16 | } 17 | \description{ 18 | \code{gen_data} generates survival data for overall survival (OS) and progression-free survival (PFS). 19 | } 20 | -------------------------------------------------------------------------------- /man/plot_surv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_surv} 4 | \alias{plot_surv} 5 | \title{Plot survival curve} 6 | \usage{ 7 | plot_surv(l_m_M, v_names_death_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_death_states}{Character vector of state names considered as “dead”.} 13 | } 14 | \value{ 15 | a ggplot object - plot of the survival curve 16 | } 17 | \description{ 18 | \code{plot_surv} plots the survival probability curve. 19 | } 20 | -------------------------------------------------------------------------------- /man/plot_trace_strategy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_trace_strategy} 4 | \alias{plot_trace_strategy} 5 | \title{Plot cohort trace per strategy} 6 | \usage{ 7 | plot_trace_strategy(l_m_M) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | } 12 | \value{ 13 | a ggplot object - plot of the cohort trace for each strategy split by health state. 14 | } 15 | \description{ 16 | \code{plot_trace} plots the cohort trace for each strategy, split by health state. 17 | } 18 | -------------------------------------------------------------------------------- /R/get_operating_system.R: -------------------------------------------------------------------------------- 1 | #' Get operating system 2 | #' 3 | #' \code{get_os} gets the operating system. 4 | #' @return 5 | #' A string with the operating system. 6 | #' @export 7 | get_os <- function(){ 8 | sysinf <- Sys.info() 9 | if (!is.null(sysinf)){ 10 | os <- sysinf['sysname'] 11 | if (os == 'Darwin') 12 | os <- "MacOSX" 13 | } else { ## mystery machine 14 | os <- .Platform$OS.type 15 | if (grepl("^darwin", R.version$os)) 16 | os <- "osx" 17 | if (grepl("linux-gnu", R.version$os)) 18 | os <- "linux" 19 | } 20 | tolower(os) 21 | } 22 | -------------------------------------------------------------------------------- /R/aesthetics.R: -------------------------------------------------------------------------------- 1 | #' Get DARTH colors 2 | #' 3 | #' \code{get_DARTH_cols} retrieves the color codes for DARTH colors. 4 | #' 5 | #' @return a string containing DARTH color codes 6 | #' @export 7 | get_DARTH_cols <- function() { 8 | # DARTH colors 9 | DARTHgreen <- '#009999' 10 | DARTHyellow <- '#FDAD1E' 11 | DARTHblue <- '#006699' 12 | DARTHlightgreen <- '#00adad' 13 | DARTHgray <- '#666666' 14 | DARTHcols <- c("H" = DARTHgreen, "S1" = DARTHblue, 15 | "S2" = DARTHyellow, "D" = DARTHgray) 16 | 17 | return(DARTHcols) 18 | } 19 | -------------------------------------------------------------------------------- /vignettes/intro.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "darthtools: Introduction" 3 | author: "Fernando Alarid-Escudero, Eline Krijkamp, Petros Pechlivanoglou, Hawre Jalal, Alan Yang, Eva Enns, and the DARTH workgroup" 4 | output: rmarkdown::html_vignette 5 | vignette: > 6 | %\VignetteIndexEntry{darthtools: Introduction} 7 | %\VignetteEngine{knitr::rmarkdown} 8 | %\VignetteEncoding{UTF-8} 9 | --- 10 | 11 | ```{r setup, include=FALSE} 12 | knitr::opts_chunk$set(collapse = TRUE, comment = "#>") 13 | ``` 14 | 15 | ```{r} 16 | # a tiny example to prove vignette builds 17 | packageVersion("darthtools") 18 | ``` 19 | -------------------------------------------------------------------------------- /man/samplev.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/samplev.R 3 | \name{samplev} 4 | \alias{samplev} 5 | \title{Vectorized categorical distribution} 6 | \usage{ 7 | samplev(m_Probs, m = 1) 8 | } 9 | \arguments{ 10 | \item{m_Probs}{matrix with probabilities for n_i individual and n_states 11 | states} 12 | 13 | \item{m}{number of time cycles to sample} 14 | } 15 | \value{ 16 | v_cat: An n_i x 1 matrix filled with sampled health state(s) per 17 | individual 18 | } 19 | \description{ 20 | \code{samplev} sample states for multiple individuals simultaneously. 21 | } 22 | -------------------------------------------------------------------------------- /man/calc_surv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{calc_surv} 4 | \alias{calc_surv} 5 | \title{Calculate survival probabilities} 6 | \usage{ 7 | calc_surv(l_m_M, v_names_death_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_death_states}{Character vector of state names considered as “dead”.} 13 | } 14 | \value{ 15 | a dataframe containing survival probabilities for each strategy 16 | } 17 | \description{ 18 | \code{calc_surv} calculates the survival probabilities. 19 | } 20 | -------------------------------------------------------------------------------- /man/hazard.fn.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{hazard.fn} 4 | \alias{hazard.fn} 5 | \title{Calculates hazards} 6 | \usage{ 7 | hazard.fn(x, t, start, ...) 8 | } 9 | \arguments{ 10 | \item{x}{Fitted model object or function describing the hazard.} 11 | 12 | \item{t}{Numeric vector of times at which to evaluate the hazard.} 13 | 14 | \item{start}{Optional start time for interval-based calculations.} 15 | 16 | \item{...}{Additional arguments passed to underlying methods.} 17 | } 18 | \description{ 19 | Calculates hazards 20 | } 21 | -------------------------------------------------------------------------------- /man/calc_sick.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{calc_sick} 4 | \alias{calc_sick} 5 | \title{Calculate state proportions} 6 | \usage{ 7 | calc_sick(l_m_M, v_names_sick_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_sick_states}{Character vector of state names considered as “sick”.} 13 | } 14 | \value{ 15 | a dataframe containing proportions in specified states for each strategy 16 | } 17 | \description{ 18 | \code{calc_surv} calculates the proportions of the cohort in specified states 19 | } 20 | -------------------------------------------------------------------------------- /man/create_at_risk_table.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{create_at_risk_table} 4 | \alias{create_at_risk_table} 5 | \title{Function to create at-risk table.} 6 | \usage{ 7 | create_at_risk_table(survival_time, Years, AtRisk) 8 | } 9 | \arguments{ 10 | \item{survival_time}{vector of survival times.} 11 | 12 | \item{Years}{vector of time intervals.} 13 | 14 | \item{AtRisk}{vector of number of patients at risk.} 15 | } 16 | \value{ 17 | at-risk table (dataframe). 18 | } 19 | \description{ 20 | \code{create_at_risk_table} creates at-risk table. 21 | } 22 | -------------------------------------------------------------------------------- /man/number_ticks.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{number_ticks} 4 | \alias{number_ticks} 5 | \title{Number of ticks for \code{ggplot2} plots} 6 | \usage{ 7 | number_ticks(n) 8 | } 9 | \arguments{ 10 | \item{n}{integer giving the desired number of ticks on axis of 11 | \code{ggplot2} plots. Non-integer values are rounded down.} 12 | } 13 | \value{ 14 | a vector of axis-label breaks 15 | } 16 | \description{ 17 | Function for determining number of ticks on axis of \code{ggplot2} plots. 18 | } 19 | \section{Details}{ 20 | 21 | Based on function \code{pretty}. 22 | } 23 | 24 | -------------------------------------------------------------------------------- /man/rate_to_prob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rate_conversion.R 3 | \name{rate_to_prob} 4 | \alias{rate_to_prob} 5 | \title{Convert a rate to a probability} 6 | \usage{ 7 | rate_to_prob(r, t = 1) 8 | } 9 | \arguments{ 10 | \item{r}{rate} 11 | 12 | \item{t}{number of cycles per base time unit (frequency)} 13 | } 14 | \value{ 15 | a scalar or vector with probabilities 16 | } 17 | \description{ 18 | \code{rate_to_prob} convert a rate to a probability. 19 | } 20 | \examples{ 21 | # Annual rate to monthly probability 22 | r_year <- 0.3 23 | p_month <- rate_to_prob(r = r_year, t = 12) 24 | p_month 25 | } 26 | -------------------------------------------------------------------------------- /man/prob_to_rate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rate_conversion.R 3 | \name{prob_to_rate} 4 | \alias{prob_to_rate} 5 | \title{Convert a probability to a rate} 6 | \usage{ 7 | prob_to_rate(p, t = 1) 8 | } 9 | \arguments{ 10 | \item{p}{probability} 11 | 12 | \item{t}{time/frequency} 13 | } 14 | \value{ 15 | a scalar or vector with rates 16 | } 17 | \description{ 18 | \code{prob_to_rate} checks if a probability is between 0 and 1 and convert it to a rate. 19 | } 20 | \examples{ 21 | # Annual probability to monthly rate 22 | p_year <- 0.3 23 | r_month <- prob_to_rate(p = p_year, t = 1/12) 24 | r_month 25 | } 26 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | - Local: macOS Sequoia, R 4.5.1 3 | - win-builder: devel / release / oldrelease (all OK) 4 | - R-hub: windows, macOS-arm64, linux (all OK) 5 | 6 | ## R CMD check results 7 | 0 errors | 0 warnings | 0 notes 8 | *(On local, `--as-cran` sometimes shows a NOTE: “CRAN incoming feasibility: New submission”. 9 | This is not a new submission but an update of the existing package.)* 10 | 11 | ## Notes for CRAN 12 | - This is an **update release** of the existing CRAN package **darthtools**, not a new submission. 13 | - License remains MIT + file LICENSE. 14 | - Updated code requires R (>= 4.1.0) due to use of base pipe (`|>`). 15 | -------------------------------------------------------------------------------- /man/find_interval_limits.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{find_interval_limits} 4 | \alias{find_interval_limits} 5 | \title{Determine which rows the upper and lower values of each interval are (in the survival data set).} 6 | \usage{ 7 | find_interval_limits(start_time, surv_time) 8 | } 9 | \arguments{ 10 | \item{start_time}{start time.} 11 | 12 | \item{surv_time}{survival times.} 13 | } 14 | \value{ 15 | matrix of limits. 16 | } 17 | \description{ 18 | \code{find_interval_limits} determines which rows the upper and lower values of each interval are (in the survival data set). 19 | } 20 | -------------------------------------------------------------------------------- /man/trace.DES.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{trace.DES} 4 | \alias{trace.DES} 5 | \title{Compute Markov trace out of a multi-state model using DES.} 6 | \usage{ 7 | trace.DES(msm_sim = des_sim, tmat, n_i, times) 8 | } 9 | \arguments{ 10 | \item{msm_sim}{multi-state model.} 11 | 12 | \item{tmat}{matrix of transition history.} 13 | 14 | \item{n_i}{number of individuals.} 15 | 16 | \item{times}{time horizon the extrapolation is done over.} 17 | } 18 | \value{ 19 | Matrix of Markov trace 20 | } 21 | \description{ 22 | \code{trace.DES} computes Markov trace out of a multi-state model using DES. 23 | } 24 | -------------------------------------------------------------------------------- /man/plot_trace_microsim_shiny.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_trace_microsim_shiny} 4 | \alias{plot_trace_microsim_shiny} 5 | \title{Plot cohort trace of a microsimulation model for the Shiny App} 6 | \usage{ 7 | plot_trace_microsim_shiny(m_M, input_list = NULL) 8 | } 9 | \arguments{ 10 | \item{m_M}{a cohort trace matrix} 11 | 12 | \item{input_list}{List of Shiny inputs controlling the microsimulation trace plot.} 13 | } 14 | \value{ 15 | a plot of the cohort trace for Shiny App 16 | } 17 | \description{ 18 | \code{plot_trace_microsim_shiny} plots cohort trace of a microsimulation model for the Shiny App. 19 | } 20 | -------------------------------------------------------------------------------- /man/plot_prevalence.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_prevalence} 4 | \alias{plot_prevalence} 5 | \title{Plot prevalence curve} 6 | \usage{ 7 | plot_prevalence(l_m_M, v_names_sick_states, v_names_dead_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_sick_states}{Character vector of state names considered as “sick”.} 13 | 14 | \item{v_names_dead_states}{Character vector of state names considered as “dead”.} 15 | } 16 | \value{ 17 | a ggplot object - plot of the prevalence curve 18 | } 19 | \description{ 20 | \code{plot_prevalence} plots the prevalence curve for specified health states. 21 | } 22 | -------------------------------------------------------------------------------- /man/surv_prob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{surv_prob} 4 | \alias{surv_prob} 5 | \title{Calculate survival probabilities.} 6 | \usage{ 7 | surv_prob(model, times = NULL, PA = FALSE, rx = 1) 8 | } 9 | \arguments{ 10 | \item{model}{survival model.} 11 | 12 | \item{times}{time horizon to calculate survival probabilities.} 13 | 14 | \item{PA}{run probabilistic analysis.} 15 | 16 | \item{rx}{determines which treatment arm (same order as factor levels of treatment variable). 17 | Default = FALSE.} 18 | } 19 | \value{ 20 | vector of survival probabilities. 21 | } 22 | \description{ 23 | \code{surv_prob} calculates survival probabilities from survival models. 24 | } 25 | -------------------------------------------------------------------------------- /R/samplev.R: -------------------------------------------------------------------------------- 1 | #' Vectorized categorical distribution 2 | #' 3 | #' \code{samplev} sample states for multiple individuals simultaneously. 4 | #' 5 | #' @param m_Probs matrix with probabilities for n_i individual and n_states 6 | #' states 7 | #' @param m number of time cycles to sample 8 | #' @return v_cat: An n_i x 1 matrix filled with sampled health state(s) per 9 | #' individual 10 | #' @export 11 | samplev <- function(m_Probs, m = 1) { 12 | lev <- dimnames(m_Probs)[[2]] # extract the names of the health states considered for sampling 13 | n_samp <- nrow(m_Probs) 14 | u <- runif(n_samp, min = 0, max = 1) 15 | v_sum_p <- matrixStats::rowCumsums(m_Probs) 16 | v_cat <- lev[max.col(v_sum_p >= u, ties.method = "first")] 17 | return(v_cat) 18 | } 19 | -------------------------------------------------------------------------------- /man/plot_trace_PSM.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_trace_PSM} 4 | \alias{plot_trace_PSM} 5 | \title{Plot Markov trace from a partitioned survival model.} 6 | \usage{ 7 | plot_trace_PSM(time, partsurv.model, PA = F, v_names_states) 8 | } 9 | \arguments{ 10 | \item{time}{numeric vector of time to estimate probabilities.} 11 | 12 | \item{partsurv.model}{partitioned survival model.} 13 | 14 | \item{PA}{run probabilistic analysis.} 15 | 16 | \item{v_names_states}{vector of state names 17 | Default = FALSE.} 18 | } 19 | \value{ 20 | a plot of the cohort trace. 21 | } 22 | \description{ 23 | \code{plot_trace_PSM} plots Markov trace from a partitioned survival model. 24 | } 25 | -------------------------------------------------------------------------------- /man/calc_prevalence.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{calc_prevalence} 4 | \alias{calc_prevalence} 5 | \title{Calculate prevalence} 6 | \usage{ 7 | calc_prevalence(l_m_M, v_names_sick_states, v_names_dead_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_sick_states}{Character vector of state names considered as “sick”.} 13 | 14 | \item{v_names_dead_states}{Character vector of state names considered as “dead”.} 15 | } 16 | \value{ 17 | a dataframe containing prevalence of specified health states for each strategy 18 | } 19 | \description{ 20 | \code{plot_prevalence} calculate the prevalence for different health states. 21 | } 22 | -------------------------------------------------------------------------------- /man/prob_to_prob.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rate_conversion.R 3 | \name{prob_to_prob} 4 | \alias{prob_to_prob} 5 | \title{Convert a probability to a probability with a different frequency} 6 | \usage{ 7 | prob_to_prob(p, t = 1) 8 | } 9 | \arguments{ 10 | \item{p}{probability} 11 | 12 | \item{t}{number of cycles per base time unit (frequency)} 13 | } 14 | \value{ 15 | a scalar or vector of probabilities converted to a different frequency 16 | } 17 | \description{ 18 | \code{prob_to_prob} convert a probability to a probability with a different frequency. 19 | } 20 | \examples{ 21 | # Annual probability to monthly probability 22 | p_year <- 0.3 23 | p_month <- prob_to_prob(p = p_year, t = 12) 24 | p_month 25 | } 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # User-specific files 9 | .Ruserdata 10 | 11 | # Example code in package build process 12 | *-Ex.R 13 | 14 | # Output files from R CMD build 15 | /*.tar.gz 16 | 17 | # Output files from R CMD check 18 | /*.Rcheck/ 19 | 20 | # RStudio files 21 | .Rproj.user/ 22 | 23 | # produced vignettes 24 | vignettes/*.html 25 | vignettes/*.pdf 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | *_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # R Environment Variables 39 | .Renviron 40 | /doc/ 41 | /Meta/ 42 | -------------------------------------------------------------------------------- /man/check_list_elements.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_list_elements.R 3 | \name{check_list_elements} 4 | \alias{check_list_elements} 5 | \title{Check if the each item in the list contains information.} 6 | \usage{ 7 | check_list_elements(l_list, err_stop = TRUE, verbose = TRUE) 8 | } 9 | \arguments{ 10 | \item{l_list}{A list with parameter values.} 11 | 12 | \item{err_stop}{Logical variable to stop model run if set up as TRUE. 13 | Default = TRUE.} 14 | 15 | \item{verbose}{Logical variable to indicate print out of messages. 16 | Default = TRUE} 17 | } 18 | \value{ 19 | Information about the validity of the list 20 | } 21 | \description{ 22 | \code{check_list_elements} checks if item in the list contains a value 23 | } 24 | -------------------------------------------------------------------------------- /man/plot_proportion_sicker.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_proportion_sicker} 4 | \alias{plot_proportion_sicker} 5 | \title{Plot state-in-state proportion curve} 6 | \usage{ 7 | plot_proportion_sicker(l_m_M, v_names_sick_states, v_names_sicker_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_sick_states}{Character vector of state names considered as “sick”.} 13 | 14 | \item{v_names_sicker_states}{Character vector of state names considered “sicker” (more severe) than the base sick states.} 15 | } 16 | \value{ 17 | a ggplot object - plot of state-in-state proportion curve 18 | } 19 | \description{ 20 | \code{plot_prevalence} plots the 21 | } 22 | -------------------------------------------------------------------------------- /man/boot.haz.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{boot.haz} 4 | \alias{boot.haz} 5 | \title{Bootstrap hazards} 6 | \usage{ 7 | boot.haz(x, t, start = 0, X = NULL, newdata = NULL, B = 1000) 8 | } 9 | \arguments{ 10 | \item{x}{Fitted model object or input data used to estimate the hazard.} 11 | 12 | \item{t}{Numeric vector of times at which to compute the hazard.} 13 | 14 | \item{start}{Optional start time for interval-based calculations.} 15 | 16 | \item{X}{Optional design (covariate) matrix used for predictions.} 17 | 18 | \item{newdata}{Optional data.frame used for out-of-sample predictions.} 19 | 20 | \item{B}{Integer; number of bootstrap replications.} 21 | } 22 | \description{ 23 | Bootstrap hazards 24 | } 25 | -------------------------------------------------------------------------------- /R/zzz_imports.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @importFrom dplyr filter select arrange pull 3 | #' @importFrom magrittr %>% 4 | #' @importFrom rlang .data 5 | #' @importFrom abind abind 6 | #' @importFrom zoo rollmean 7 | #' @importFrom muhaz muhaz 8 | #' @importFrom flexsurv flexsurvreg normboot.flexsurvreg pgompertz pllogis hweibull 9 | #' @importFrom flexsurvcure flexsurvcure 10 | #' @importFrom survHE fit.models 11 | #' @importFrom survminer ggsurvplot 12 | #' @importFrom data.table rbindlist 13 | #' @importFrom msm msm prevalence.msm 14 | #' @importFrom graphics legend lines matlines matplot title 15 | #' @importFrom stats density model.frame model.matrix na.omit pexp pgamma plnorm pweibull quantile runif time 16 | #' @importFrom utils capture.output modifyList getFromNamespace globalVariables 17 | NULL 18 | -------------------------------------------------------------------------------- /man/calc_prop_sicker.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{calc_prop_sicker} 4 | \alias{calc_prop_sicker} 5 | \title{Calculate state-in-state proportions} 6 | \usage{ 7 | calc_prop_sicker(l_m_M, v_names_sick_states, v_names_sicker_states) 8 | } 9 | \arguments{ 10 | \item{l_m_M}{a list containing cohort trace matrices} 11 | 12 | \item{v_names_sick_states}{Character vector of state names considered as “sick”.} 13 | 14 | \item{v_names_sicker_states}{Character vector of state names considered “sicker” (more severe) than the base sick states.} 15 | } 16 | \value{ 17 | a dataframe containing state-in-state proportions of specified health states for each strategy 18 | } 19 | \description{ 20 | \code{plot_prevalence} calculates the proportion of a specified subset of states among a set of specified states 21 | } 22 | -------------------------------------------------------------------------------- /man/update_param_list.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{update_param_list} 4 | \alias{update_param_list} 5 | \alias{update_list_params} 6 | \title{Update parameters} 7 | \usage{ 8 | update_param_list(l_params_all, ...) 9 | 10 | update_list_params(l_params_all, params_updated) 11 | } 12 | \arguments{ 13 | \item{l_params_all}{List with all parameters of decision model} 14 | 15 | \item{...}{One or more update sets (list/named vector or a data.frame 16 | with columns \code{name} and \code{value}).} 17 | 18 | \item{params_updated}{Backward-compatible single update set.} 19 | } 20 | \value{ 21 | A list with all parameters updated. 22 | } 23 | \description{ 24 | \code{update_param_list} updates a model parameter list with one or more 25 | update sets. Later update sets override earlier ones on name conflicts. 26 | } 27 | -------------------------------------------------------------------------------- /man/check_transition_probability.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_transition_probabilities.R 3 | \name{check_transition_probability} 4 | \alias{check_transition_probability} 5 | \title{Check if transition array is valid} 6 | \usage{ 7 | check_transition_probability(a_P, err_stop = FALSE, verbose = FALSE) 8 | } 9 | \arguments{ 10 | \item{a_P}{A transition probability array/ matrix.} 11 | 12 | \item{err_stop}{Logical variable to stop model run if set up as TRUE. Default = FALSE.} 13 | 14 | \item{verbose}{Logical variable to indicate print out of messages. 15 | Default = FALSE} 16 | } 17 | \value{ 18 | This function stops if transition probability array is not valid and shows 19 | what are the entries that are not valid 20 | } 21 | \description{ 22 | \code{check_transition_probability} checks if transition probabilities are in [0, 1]. 23 | } 24 | -------------------------------------------------------------------------------- /man/normboot.haz.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{normboot.haz} 4 | \alias{normboot.haz} 5 | \title{Bootstrap hazards} 6 | \usage{ 7 | normboot.haz(x, t, start, newdata = NULL, X = NULL, fn, B) 8 | } 9 | \arguments{ 10 | \item{x}{Fitted model object or input data used to estimate the hazard.} 11 | 12 | \item{t}{Numeric vector of times at which to compute the hazard.} 13 | 14 | \item{start}{Optional start time for interval-based calculations.} 15 | 16 | \item{newdata}{Optional data.frame used for out-of-sample predictions.} 17 | 18 | \item{X}{Optional design (covariate) matrix used for predictions.} 19 | 20 | \item{fn}{Function or character string; statistic to compute within each bootstrap draw.} 21 | 22 | \item{B}{Integer; number of bootstrap replications.} 23 | } 24 | \description{ 25 | Bootstrap hazards 26 | } 27 | -------------------------------------------------------------------------------- /man/boot_haz_np.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{boot_haz_np} 4 | \alias{boot_haz_np} 5 | \title{Non-parametric hazard bootstrap 6 | \code{boot_haz_np} computes non-parametric bootstrap hazards from time-to-event data.} 7 | \usage{ 8 | boot_haz_np(surv_data, time, status, Rx, B) 9 | } 10 | \arguments{ 11 | \item{surv_data}{survival (time-to-event) data.} 12 | 13 | \item{time}{name of time variable in survival data (character variable).} 14 | 15 | \item{status}{name of status variable survival data (character variable).} 16 | 17 | \item{Rx}{treatment arm.} 18 | 19 | \item{B}{number of bootstrap samples.} 20 | } 21 | \value{ 22 | list of objects (time points, hazard, hazard CI, bootstrapped time points). 23 | } 24 | \description{ 25 | Non-parametric hazard bootstrap 26 | \code{boot_haz_np} computes non-parametric bootstrap hazards from time-to-event data. 27 | } 28 | -------------------------------------------------------------------------------- /man/model.dist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{model.dist} 4 | \alias{model.dist} 5 | \title{Calculate survival probabilities given a survival distribution and its parameter values.} 6 | \usage{ 7 | model.dist(dist.v, d.data, dat.x = 0, t) 8 | } 9 | \arguments{ 10 | \item{dist.v}{a character string specifying the name of the survival distribution.} 11 | 12 | \item{d.data}{a vector of parameter values of the survival distribution.} 13 | 14 | \item{dat.x}{a vector of covariate values that multiply the coefficients of the survival model. 15 | Default = 0 (baseline model i.e beta=0).} 16 | 17 | \item{t}{a vector of time points to calculate the survival probabilities at.} 18 | } 19 | \value{ 20 | A vector of survival probabilities. 21 | } 22 | \description{ 23 | \code{model.dist} calculates survival probabilities given a survival distribution and its parameter values. 24 | } 25 | -------------------------------------------------------------------------------- /man/fit.mstate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{fit.mstate} 4 | \alias{fit.mstate} 5 | \title{Fit multi-state model.} 6 | \usage{ 7 | fit.mstate( 8 | time, 9 | status, 10 | trans, 11 | data = data, 12 | add = FALSE, 13 | extrapolate = FALSE, 14 | times 15 | ) 16 | } 17 | \arguments{ 18 | \item{time}{numeric vector of time to estimate probabilities.} 19 | 20 | \item{status}{numeric vector of event status.} 21 | 22 | \item{trans}{matrix of transition history.} 23 | 24 | \item{data}{dataframe containing the time and status variables.} 25 | 26 | \item{add}{add superimposed curves to the KM plot. 27 | Default = FALSE.} 28 | 29 | \item{extrapolate}{extrapolate beyond model time horizon. 30 | Default = FALSE.} 31 | 32 | \item{times}{time horizon the extrapolation is done over.} 33 | } 34 | \value{ 35 | Multi-state model fit. 36 | } 37 | \description{ 38 | \code{fit.mstate} fits multi-state model. 39 | } 40 | -------------------------------------------------------------------------------- /R/format_cea_table.R: -------------------------------------------------------------------------------- 1 | #' Format CEA table 2 | #' 3 | #' \code{format_table_cea} formats the CEA table. 4 | #' 5 | #' @param table_cea a dataframe object - table with CEA results 6 | #' @return a dataframe object - formatted CEA table 7 | #' @export 8 | format_table_cea <- function(table_cea) { 9 | colnames(table_cea)[colnames(table_cea) 10 | %in% c("Cost", 11 | "Effect", 12 | "Inc_Cost", 13 | "Inc_Effect", 14 | "ICER")] <- 15 | 16 | c("Costs ($)", 17 | "QALYs", 18 | "Incremental Costs ($)", 19 | "Incremental QALYs", 20 | "ICER ($/QALY)") 21 | 22 | table_cea$`Costs ($)` <- comma(round(table_cea$`Costs ($)`, 0)) 23 | table_cea$`Incremental Costs ($)` <- comma(round(table_cea$`Incremental Costs ($)`, 0)) 24 | table_cea$QALYs <- round(table_cea$QALYs, 2) 25 | table_cea$`Incremental QALYs` <- round(table_cea$`Incremental QALYs`, 2) 26 | table_cea$`ICER ($/QALY)` <- comma(round(table_cea$`ICER ($/QALY)`, 0)) 27 | return(table_cea) 28 | } 29 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2025 DARTH Workgroup 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /man/check_sum_of_transition_array.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check_transition_probabilities.R 3 | \name{check_sum_of_transition_array} 4 | \alias{check_sum_of_transition_array} 5 | \title{Check if the sum of transition probabilities equal to one.} 6 | \usage{ 7 | check_sum_of_transition_array( 8 | a_P, 9 | n_rows = NULL, 10 | n_states = NULL, 11 | n_cycles, 12 | err_stop = TRUE, 13 | verbose = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{a_P}{A transition probability array/ matrix.} 18 | 19 | \item{n_rows}{Number of rows (individuals), appropriate for microsimulation models.} 20 | 21 | \item{n_states}{Number of health states in a Markov trace, appropriate for Markov models.} 22 | 23 | \item{n_cycles}{Number of cycles.} 24 | 25 | \item{err_stop}{Logical variable to stop model run if set up as TRUE. 26 | Default = TRUE.} 27 | 28 | \item{verbose}{Logical variable to indicate print out of messages. 29 | Default = TRUE} 30 | } 31 | \value{ 32 | The transition probability array and the cohort trace matrix. 33 | } 34 | \description{ 35 | \code{check_sum_of_transition_array} checks if each of the rows of the 36 | transition matrices sum to one. 37 | } 38 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | # darthtools 6 | 7 | [`darthtools`](https://github.com/DARTH-git/darthtools) is an R package that contains tools developed by the [Decision Analysis in R for Technologies in Health (DARTH)](https://darthworkgroup.com) workgroup to construct model-based cost-effectiveness analysis in R. 8 | 9 | # Preliminaries 10 | - Install [RStudio](https://www.rstudio.com/products/rstudio/download/) 11 | - Install `devtools` to install `darthtools` as a package and modify it to generate your own package 12 | ```{r, eval=FALSE} 13 | # Install release version from CRAN 14 | install.packages("devtools") 15 | 16 | # Or install development version from GitHub 17 | # devtools::install_github("r-lib/devtools") 18 | ``` 19 | 20 | # Usage and installation 21 | 22 | 1. Install the development version of `darthtools` from [GitHub](https://github.com) with: 23 | 24 | ```{r, eval=FALSE} 25 | devtools::install_github("DARTH-git/darthtools") 26 | ``` 27 | 28 | 2. Load all the functions and data from the repository by typing 29 | 30 | ```{r, eval=FALSE} 31 | library(darthtools) 32 | ``` 33 | 34 | The main website of the package could be found in: https://darth-git.github.io/darthtools/ 35 | -------------------------------------------------------------------------------- /man/model.rmvnorm.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{model.rmvnorm} 4 | \alias{model.rmvnorm} 5 | \title{Randomly draw parameter values of survival models from multivariate normal distribution.} 6 | \usage{ 7 | model.rmvnorm(dist.v, d.data, vc.data, n_sim, seed = 421) 8 | 9 | model.rmvnorm(dist.v, d.data, vc.data, n_sim, seed = 421) 10 | } 11 | \arguments{ 12 | \item{dist.v}{a character string specifying the name of the survival distribution.} 13 | 14 | \item{d.data}{a vector of mean parameter estimates of the survival distribution.} 15 | 16 | \item{vc.data}{variance-covariance matrix (a matrix) of parameter estimates of the survival distribution.} 17 | 18 | \item{n_sim}{number of random samples to draw. 19 | Default = 100.} 20 | 21 | \item{seed}{seed for random number generation. 22 | Default = 421.} 23 | } 24 | \value{ 25 | A matrix of drawn parameter values. 26 | 27 | A matrix of drawn parameter values. 28 | } 29 | \description{ 30 | \code{model.rmvnorm} randomly draws parameter values of survival models from multivariate normal distribution. 31 | 32 | \code{model.rmvnorm} randomly draws parameter values of survival models from multivariate normal distribution. 33 | } 34 | -------------------------------------------------------------------------------- /man/all_partsurv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{all_partsurv} 4 | \alias{all_partsurv} 5 | \title{Fit partitioned survival model on all combinations of chosen PFS and OS parametric survival functions.} 6 | \usage{ 7 | all_partsurv( 8 | pfs_survHE, 9 | os_survHE, 10 | choose_PFS, 11 | choose_OS, 12 | time = times, 13 | PA = FALSE, 14 | n_sim = 100, 15 | seed = 421 16 | ) 17 | } 18 | \arguments{ 19 | \item{pfs_survHE}{survHE obj fitting PFS.} 20 | 21 | \item{os_survHE}{survHE obj fitting OS.} 22 | 23 | \item{choose_PFS}{preferred PFS distribution.} 24 | 25 | \item{choose_OS}{preferred OS distribution.} 26 | 27 | \item{time}{numeric vector of time to estimate probabilities.} 28 | 29 | \item{PA}{run probabilistic analysis. 30 | Default = FALSE.} 31 | 32 | \item{n_sim}{number of PA simulations. 33 | Default = 100.} 34 | 35 | \item{seed}{seed for random number generation. 36 | Default = 421.} 37 | } 38 | \value{ 39 | a list containing Markov trace, expected survival, survival probabilities, transition probabilities. 40 | } 41 | \description{ 42 | \code{all_partsurv} fits partitioned survival model on all combinations of chosen PFS and OS parametric survival functions. 43 | } 44 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # darthtools 3 | 4 | [`darthtools`](https://github.com/DARTH-git/darthtools) is an R package 5 | that contains tools developed by the [Decision Analysis in R for 6 | Technologies in Health (DARTH)](https://darthworkgroup.com) workgroup to 7 | construct model-based cost-effectiveness analysis in R. 8 | 9 | # Preliminaries 10 | 11 | - Install 12 | [RStudio](https://posit.co/download/rstudio-desktop/) 13 | - Install `devtools` to install `darthtools` as a package and modify 14 | it to generate your own package 15 | 16 | 17 | 18 | ``` r 19 | # Install release version from CRAN 20 | install.packages("devtools") 21 | 22 | # Or install development version from GitHub 23 | # devtools::install_github("r-lib/devtools") 24 | ``` 25 | 26 | # Usage and installation 27 | 28 | 1. Install the development version of `darthtools` from 29 | [GitHub](https://github.com) with: 30 | 31 | 32 | 33 | ``` r 34 | devtools::install_github("DARTH-git/darthtools") 35 | ``` 36 | 37 | 2. Load all the functions and data from the repository by typing 38 | 39 | 40 | 41 | ``` r 42 | library(darthtools) 43 | ``` 44 | 45 | The main website of the package could be found in: 46 | 47 | -------------------------------------------------------------------------------- /man/set_v_names_states.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/v_names_states.R 3 | \name{set_v_names_states} 4 | \alias{set_v_names_states} 5 | \title{Register health-state names (backward-compatible with \code{v_names_states}). 6 | Call this once (e.g., after creating a trace) to register the state names.} 7 | \usage{ 8 | set_v_names_states( 9 | state_names = NULL, 10 | x = NULL, 11 | time_cols = c("cycle", "Cycle", "time", "Time", "t", "Time_horizon") 12 | ) 13 | } 14 | \arguments{ 15 | \item{state_names}{Character vector of state names. If \code{NULL}, infer from \code{x}.} 16 | 17 | \item{x}{Optional data frame/matrix/trace to infer names from (wide: non-time columns; 18 | long: unique values in \code{state}/\code{State}).} 19 | 20 | \item{time_cols}{Character vector of time column names to exclude when inferring.} 21 | } 22 | \value{ 23 | Invisibly returns the resolved state-name vector. 24 | } 25 | \description{ 26 | Register health-state names (backward-compatible with \code{v_names_states}). 27 | Call this once (e.g., after creating a trace) to register the state names. 28 | } 29 | \examples{ 30 | set_v_names_states(state_names = c("PFS","PD","Death")) 31 | set_v_names_states(x = data.frame(cycle=0:2, PFS=c(1,.8,.6), PD=c(0,.1,.2), Death=c(0,.1,.2))) 32 | } 33 | -------------------------------------------------------------------------------- /R/check_list_elements.R: -------------------------------------------------------------------------------- 1 | #' Check if the each item in the list contains information. 2 | #' 3 | #' \code{check_list_elements} checks if item in the list contains a value 4 | #' 5 | #' @param l_list A list with parameter values. 6 | #' @param err_stop Logical variable to stop model run if set up as TRUE. 7 | #' Default = TRUE. 8 | #' @param verbose Logical variable to indicate print out of messages. 9 | #' Default = TRUE 10 | #' @return 11 | #' Information about the validity of the list 12 | #' @export 13 | check_list_elements <- function(l_list, 14 | err_stop = TRUE, 15 | verbose = TRUE) { 16 | 17 | # check if each component of the list is valid, not NULL, not NA etc. 18 | valid <- !is.null(l_list) & class(l_list) != "NULL" & class(l_list) != "logical" & class(l_list) == "list" & length(l_list) != 0 & sum(!is.na(l_list)) == length(l_list) & sum(!sapply(l_list, is.null)) == length(l_list) 19 | 20 | 21 | if (valid == TRUE) { 22 | print("This is a valid list") 23 | } else if (valid == FALSE & err_stop == TRUE) { 24 | stop("This is not a valid list. At least one element in the list does not contain information.") 25 | } else if (valid == FALSE & verbose == TRUE){ 26 | warning("This is not a valid list. At least one element in the list does not contain information.") 27 | } 28 | 29 | 30 | } # close the function 31 | -------------------------------------------------------------------------------- /man/fit.models.cure.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{fit.models.cure} 4 | \alias{fit.models.cure} 5 | \title{Fit parametric mixture cure survival models for health economic evaluations.} 6 | \usage{ 7 | fit.models.cure(formula = NULL, data, distr = NULL, method = "mle", ...) 8 | } 9 | \arguments{ 10 | \item{formula}{a formula specifying the model to be used, in the form Surv(time,event)~treatment\code{+covariates} for flexsurv.} 11 | 12 | \item{data}{A data frame containing the data to be used for the analysis. This must contain data for the 'event' variable. In case there is no censoring, then event is a column of 1s.} 13 | 14 | \item{distr}{a (vector of) string(s) containing the name(s) of the model(s) to be fitted. Available options are: flexsurv: "exponential","gamma","genf","gengamma","gompertz","weibull", "weibullPH","loglogistic","lognormal" INLA: "exponential","weibull","lognormal","loglogistic" hmc: "exponential","gamma","genf","gengamma","gompertz","weibull","weibullPH", "loglogistic","lognormal".} 15 | 16 | \item{method}{Character string specifying the fitting method (e.g., "mle").} 17 | 18 | \item{...}{Further arguments passed to the underlying cure-model fitting functions.} 19 | } 20 | \value{ 21 | A model object. 22 | } 23 | \description{ 24 | \code{fit.models.cure} fits parametric mixture cure survival models for health economic evaluations. 25 | } 26 | -------------------------------------------------------------------------------- /man/boot_hr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{boot_hr} 4 | \alias{boot_hr} 5 | \title{Bootstrap hazards ratios of two survival models 6 | \code{boot_hr} computes bootstrap hazard ratios (HR) of two survival models (model 1 vs. 2) or one survival model with multiple treatments (rx 1 vs. 2)} 7 | \usage{ 8 | boot_hr( 9 | surv_model1 = NULL, 10 | surv_model2 = NULL, 11 | rx1 = NULL, 12 | rx2 = NULL, 13 | rx = F, 14 | surv_model_rx = NULL, 15 | times, 16 | B = 100 17 | ) 18 | } 19 | \arguments{ 20 | \item{surv_model1}{first survival model.} 21 | 22 | \item{surv_model2}{second survival model.} 23 | 24 | \item{rx1}{first treatment arm (if rx = T).} 25 | 26 | \item{rx2}{second treatment arm (if rx = T).} 27 | 28 | \item{rx}{whether to model treatment arms within one model. 29 | Default = FALSE.} 30 | 31 | \item{surv_model_rx}{survival model (if rx = T), can only choose weibull or gamma models.} 32 | 33 | \item{times}{time horizon the extrapolation of the survival model is done over.} 34 | 35 | \item{B}{number of bootstrap samples.} 36 | } 37 | \value{ 38 | dataframe of hazard ratio statistics (2.5\% percentile, median, 97.5\% percentile, time points) 39 | } 40 | \description{ 41 | Bootstrap hazards ratios of two survival models 42 | \code{boot_hr} computes bootstrap hazard ratios (HR) of two survival models (model 1 vs. 2) or one survival model with multiple treatments (rx 1 vs. 2) 43 | } 44 | -------------------------------------------------------------------------------- /man/plot_psa.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_psa} 4 | \alias{plot_psa} 5 | \title{Plot the psa object} 6 | \usage{ 7 | plot_psa( 8 | x, 9 | center = TRUE, 10 | ellipse = TRUE, 11 | alpha = 0.2, 12 | txtsize = 12, 13 | col = c("full", "bw"), 14 | n_x_ticks = 6, 15 | n_y_ticks = 6, 16 | xbreaks = NULL, 17 | ybreaks = NULL, 18 | xlim = NULL, 19 | ylim = NULL, 20 | ... 21 | ) 22 | } 23 | \arguments{ 24 | \item{x}{the psa object} 25 | 26 | \item{center}{plot the mean cost and effectiveness for each strategy. defaults to TRUE} 27 | 28 | \item{ellipse}{plot an ellipse around each strategy. defaults to TRUE} 29 | 30 | \item{alpha}{opacity of the scatterplot points. 31 | 0 is completely transparent, 1 is completely opaque} 32 | 33 | \item{txtsize}{base text size} 34 | 35 | \item{col}{either none, full color, or black and white} 36 | 37 | \item{n_x_ticks, n_y_ticks}{number of axis ticks} 38 | 39 | \item{xbreaks, ybreaks}{vector of axis breaks. 40 | will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided.} 41 | 42 | \item{xlim, ylim}{vector of axis limits, or NULL, which sets limits automatically} 43 | 44 | \item{...}{further arguments to plot. 45 | This is not used by \code{dampack} but required for generic consistency.} 46 | } 47 | \value{ 48 | A \code{ggplot2} plot of the PSA, showing the distribution of each PSA sample and strategy 49 | on the cost-effectiveness plane. 50 | } 51 | \description{ 52 | Plot the psa object 53 | } 54 | -------------------------------------------------------------------------------- /man/plot_evpi.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_evpi} 4 | \alias{plot_evpi} 5 | \title{Plot of Expected Value of Perfect Information (EVPI)} 6 | \usage{ 7 | plot_evpi( 8 | x, 9 | txtsize = 12, 10 | currency = "$", 11 | effect_units = "QALY", 12 | n_y_ticks = 8, 13 | n_x_ticks = 20, 14 | xbreaks = NULL, 15 | ybreaks = NULL, 16 | xlim = c(0, NA), 17 | ylim = NULL, 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{x}{object of class \code{evpi}, produced by function 23 | \code{calc_evpi}} 24 | 25 | \item{txtsize}{base text size} 26 | 27 | \item{currency}{string with currency used in the cost-effectiveness analysis (CEA). 28 | Default: $, but it could be any currency symbol or word (e.g., GBP, EUR, peso)} 29 | 30 | \item{effect_units}{units of effectiveness. Default: QALY} 31 | 32 | \item{n_x_ticks, n_y_ticks}{number of axis ticks} 33 | 34 | \item{xbreaks, ybreaks}{vector of axis breaks. 35 | will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided.} 36 | 37 | \item{xlim, ylim}{vector of axis limits, or NULL, which sets limits automatically} 38 | 39 | \item{...}{further arguments to plot. 40 | This is not used by \code{dampack} but required for generic consistency.} 41 | } 42 | \value{ 43 | A \code{ggplot2} plot with the EVPI 44 | } 45 | \description{ 46 | Plots the \code{evpi} object created by \code{calc_evpi}. 47 | } 48 | \seealso{ 49 | \code{calc_evpi} 50 | } 51 | \keyword{expected} 52 | \keyword{information} 53 | \keyword{of} 54 | \keyword{perfect} 55 | \keyword{value} 56 | -------------------------------------------------------------------------------- /man/gen_wcc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/within_cycle_corrections.R 3 | \name{gen_wcc} 4 | \alias{gen_wcc} 5 | \title{Within-cycle correction (WCC)} 6 | \usage{ 7 | gen_wcc(n_cycles, method = c("Simpson1/3", "half-cycle", "none")) 8 | } 9 | \arguments{ 10 | \item{n_cycles}{number of cycles} 11 | 12 | \item{method}{The method to be used for within-cycle correction.} 13 | } 14 | \value{ 15 | A vector of length \code{n_cycles + 1} with within-cycle corrections 16 | } 17 | \description{ 18 | \code{gen_wcc} generates a vector of within-cycle corrections (WCC). 19 | } 20 | \details{ 21 | The default method is an implementation of Simpson's 1/3rd rule that 22 | generates a vector with the first and last entry with 1/3 and the odd and 23 | even entries with 4/3 and 2/3, respectively. 24 | 25 | Method "\code{half-cycle}" is the half-cycle correction method that 26 | generates a vector with the first and last entry with 1/2 and the rest equal 27 | to 1. 28 | 29 | Method "\code{none}" does not implement any within-cycle correction and 30 | generates a vector with ones. 31 | } 32 | \examples{ 33 | # Number of cycles 34 | n_cycles <- 10 35 | gen_wcc(n_cycles = n_cycles, method = "Simpson1/3") 36 | gen_wcc(n_cycles = n_cycles, method = "half-cycle") 37 | gen_wcc(n_cycles = n_cycles, method = "none") 38 | 39 | } 40 | \references{ 41 | \enumerate{ 42 | \item Elbasha EH, Chhatwal J. Myths and misconceptions of within-cycle 43 | correction: a guide for modelers and decision makers. Pharmacoeconomics. 44 | 2016;34(1):13-22. 45 | \item Elbasha EH, Chhatwal J. Theoretical foundations and practical 46 | applications of within-cycle correction methods. Med Decis Mak. 47 | 2016;36(1):115-131. 48 | } 49 | } 50 | -------------------------------------------------------------------------------- /man/plot_exp_loss.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_exp_loss} 4 | \alias{plot_exp_loss} 5 | \title{Plot of Expected Loss Curves (ELC)} 6 | \usage{ 7 | plot_exp_loss( 8 | x, 9 | log_y = TRUE, 10 | frontier = TRUE, 11 | points = TRUE, 12 | lsize = 1, 13 | txtsize = 12, 14 | currency = "$", 15 | effect_units = "QALY", 16 | n_y_ticks = 8, 17 | n_x_ticks = 20, 18 | xbreaks = NULL, 19 | ybreaks = NULL, 20 | xlim = c(0, NA), 21 | ylim = NULL, 22 | col = c("full", "bw"), 23 | ... 24 | ) 25 | } 26 | \arguments{ 27 | \item{x}{object of class \code{exp_loss}, produced by function 28 | \code{calc_exp_loss}} 29 | 30 | \item{log_y}{take the base 10 log of the y axis} 31 | 32 | \item{frontier}{indicate the frontier (also the expected value of perfect information). 33 | To only plot the EVPI see \code{calc_evpi}.} 34 | 35 | \item{points}{whether to plot points on the curve (TRUE) or not (FALSE)} 36 | 37 | \item{lsize}{line size. defaults to 1.} 38 | 39 | \item{txtsize}{base text size} 40 | 41 | \item{currency}{string with currency used in the cost-effectiveness analysis (CEA). 42 | Default: $, but it could be any currency symbol or word (e.g., GBP, EUR, peso)} 43 | 44 | \item{effect_units}{units of effectiveness. Default: QALY} 45 | 46 | \item{n_x_ticks, n_y_ticks}{number of axis ticks} 47 | 48 | \item{xbreaks, ybreaks}{vector of axis breaks. 49 | will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided.} 50 | 51 | \item{xlim, ylim}{vector of axis limits, or NULL, which sets limits automatically} 52 | 53 | \item{col}{either none, full color, or black and white} 54 | 55 | \item{...}{further arguments to plot. 56 | This is not used by \code{dampack} but required for generic consistency.} 57 | } 58 | \value{ 59 | A \code{ggplot2} object with the expected loss 60 | } 61 | \description{ 62 | Plot of Expected Loss Curves (ELC) 63 | } 64 | -------------------------------------------------------------------------------- /man/plot_ceac.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_ceac} 4 | \alias{plot_ceac} 5 | \title{Plot of Cost-Effectiveness Acceptability Curves (CEAC)} 6 | \usage{ 7 | plot_ceac( 8 | x, 9 | frontier = TRUE, 10 | points = TRUE, 11 | currency = "$", 12 | min_prob = 0, 13 | txtsize = 12, 14 | n_x_ticks = 10, 15 | n_y_ticks = 8, 16 | xbreaks = NULL, 17 | ybreaks = NULL, 18 | ylim = NULL, 19 | xlim = c(0, NA), 20 | col = c("full", "bw"), 21 | ... 22 | ) 23 | } 24 | \arguments{ 25 | \item{x}{object of class \code{ceac}.} 26 | 27 | \item{frontier}{whether to plot acceptability frontier (TRUE) or not (FALSE)} 28 | 29 | \item{points}{whether to plot points (TRUE) or not (FALSE)} 30 | 31 | \item{currency}{string with currency used in the cost-effectiveness analysis (CEA). 32 | Defaults to \code{$}, but can be any currency symbol or word (e.g., GBP, EUR, peso)} 33 | 34 | \item{min_prob}{minimum probability to show strategy in plot. 35 | For example, if the min_prob is 0.05, only strategies that ever 36 | exceed Pr(Cost Effective) = 0.05 will be plotted. Most useful in situations 37 | with many strategies.} 38 | 39 | \item{txtsize}{base text size} 40 | 41 | \item{n_x_ticks, n_y_ticks}{number of axis ticks} 42 | 43 | \item{xbreaks, ybreaks}{vector of axis breaks. 44 | will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided.} 45 | 46 | \item{xlim, ylim}{vector of axis limits, or NULL, which sets limits automatically} 47 | 48 | \item{col}{either none, full color, or black and white} 49 | 50 | \item{...}{further arguments to plot. 51 | This is not used by \code{dampack} but required for generic consistency.} 52 | } 53 | \value{ 54 | A \code{ggplot2} plot of the CEAC. 55 | } 56 | \description{ 57 | Plots the CEAC, using the object created by \code{ceac}. 58 | } 59 | \details{ 60 | \code{ceac} computes the probability of each of the strategies being 61 | cost-effective at each \code{wtp} value. 62 | } 63 | \keyword{internal} 64 | -------------------------------------------------------------------------------- /man/fit.fun.cure.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{fit.fun.cure} 4 | \alias{fit.fun.cure} 5 | \title{Fit multiple mixture cure models on survival data} 6 | \usage{ 7 | fit.fun.cure( 8 | time, 9 | status, 10 | covariate = F, 11 | rx = "rx", 12 | data = data, 13 | extrapolate = FALSE, 14 | times, 15 | legend_position = "bottom", 16 | xlow = min(times), 17 | xhigh = max(times), 18 | ylow = 0, 19 | yhigh = 1, 20 | risktable = F, 21 | mods = c("exp", "weibull", "gamma", "lnorm", "llogis", "gompertz", "gengamma") 22 | ) 23 | } 24 | \arguments{ 25 | \item{time}{numeric vector of time to estimate probabilities.} 26 | 27 | \item{status}{numeric vector of event status.} 28 | 29 | \item{covariate}{logical value indicating whether treatment is being used as a covariate in parametric survival models. 30 | Default = FALSE.} 31 | 32 | \item{rx}{numerical value indicating the treatment variable used as a covariate in parametric survival models.} 33 | 34 | \item{data}{dataframe containing the time and status variables.} 35 | 36 | \item{extrapolate}{extrapolate beyond model time horizon. 37 | Default = FALSE.} 38 | 39 | \item{times}{time horizon the extrapolation is done over.} 40 | 41 | \item{legend_position}{position of the legend. 42 | Default = "top".} 43 | 44 | \item{xlow}{time horizon the extrapolation is done over. 45 | Default = min(time).} 46 | 47 | \item{xhigh}{time horizon the extrapolation is done over. 48 | Default = max(time).} 49 | 50 | \item{ylow}{time horizon the extrapolation is done over. 51 | Default = 0.} 52 | 53 | \item{yhigh}{time horizon the extrapolation is done over. 54 | Default = 1.} 55 | 56 | \item{risktable}{time horizon the extrapolation is done over. 57 | Default = F.} 58 | 59 | \item{mods}{a vector of models to fit. 60 | Default = c("exp", "weibull", "gamma", "lnorm", "llogis", "gompertz", "gengamma").} 61 | } 62 | \value{ 63 | a list containing all survival model objects. 64 | } 65 | \description{ 66 | \code{fit.fun.cure} fits multiple mixture cure models to survival data using flexsurv. 67 | } 68 | -------------------------------------------------------------------------------- /man/fit.fun.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{fit.fun} 4 | \alias{fit.fun} 5 | \title{Fit multiple survival models on survival data} 6 | \usage{ 7 | fit.fun( 8 | time, 9 | status, 10 | covariate = F, 11 | rx = NULL, 12 | data, 13 | extrapolate = FALSE, 14 | times, 15 | k = 2, 16 | legend_position = "bottom", 17 | xlow = min(times), 18 | xhigh = max(times), 19 | ylow = 0, 20 | yhigh = 1, 21 | risktable = F, 22 | mods = c("exp", "weibull", "gamma", "lnorm", "llogis", "gompertz", "rps", "gengamma") 23 | ) 24 | } 25 | \arguments{ 26 | \item{time}{numeric vector of time to estimate probabilities.} 27 | 28 | \item{status}{numeric vector of event status.} 29 | 30 | \item{covariate}{logical value indicating whether treatment is being used as a covariate in parametric survival models. 31 | Default = FALSE.} 32 | 33 | \item{rx}{character value indicating the treatment variable used as a covariate in parametric survival models.} 34 | 35 | \item{data}{dataframe containing the time and status variables.} 36 | 37 | \item{extrapolate}{extrapolate beyond model time horizon. 38 | Default = FALSE.} 39 | 40 | \item{times}{time horizon the extrapolation is done over.} 41 | 42 | \item{k}{number of knots in Royston-Parmar spline model. 43 | Default = 2.} 44 | 45 | \item{legend_position}{position of the legend. 46 | Default = "bottom".} 47 | 48 | \item{xlow}{time horizon the extrapolation is done over. 49 | Default = min(time).} 50 | 51 | \item{xhigh}{time horizon the extrapolation is done over. 52 | Default = max(time).} 53 | 54 | \item{ylow}{time horizon the extrapolation is done over. 55 | Default = 0.} 56 | 57 | \item{yhigh}{time horizon the extrapolation is done over. 58 | Default = 1.} 59 | 60 | \item{risktable}{time horizon the extrapolation is done over. 61 | Default = F.} 62 | 63 | \item{mods}{a vector of models to fit. 64 | Choose from = c("exp", "weibull", "gamma", "lnorm", "llogis", "gompertz", "rps", "gengamma").} 65 | } 66 | \value{ 67 | a list containing all survival model objects. 68 | } 69 | \description{ 70 | \code{fit.fun} fits multiple survival models to survival data using survHE. 71 | } 72 | -------------------------------------------------------------------------------- /man/plot_icers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{plot_icers} 4 | \alias{plot_icers} 5 | \title{Plot of ICERs} 6 | \usage{ 7 | plot_icers( 8 | x, 9 | txtsize = 12, 10 | currency = "$", 11 | effect_units = "QALYs", 12 | label = c("frontier", "all", "none"), 13 | label_max_char = NULL, 14 | plot_frontier_only = FALSE, 15 | alpha = 1, 16 | n_x_ticks = 6, 17 | n_y_ticks = 6, 18 | xbreaks = NULL, 19 | ybreaks = NULL, 20 | xlim = NULL, 21 | ylim = NULL, 22 | xexpand = expansion(0.1), 23 | yexpand = expansion(0.1), 24 | max.iter = 20000, 25 | ... 26 | ) 27 | } 28 | \arguments{ 29 | \item{x}{Object of class \code{icers}.} 30 | 31 | \item{txtsize}{base text size} 32 | 33 | \item{currency}{string. with currency used in the cost-effectiveness analysis (CEA).} 34 | 35 | \item{effect_units}{string. unit of effectiveness} 36 | 37 | \item{label}{whether to label strategies on the efficient frontier, all strategies, or none. 38 | defaults to frontier.} 39 | 40 | \item{label_max_char}{max number of characters to label the strategies - if not NULL (the default) 41 | longer strategies are truncated to save space.} 42 | 43 | \item{plot_frontier_only}{only plot the efficient frontier} 44 | 45 | \item{alpha}{opacity of points} 46 | 47 | \item{n_x_ticks, n_y_ticks}{number of axis ticks} 48 | 49 | \item{xbreaks, ybreaks}{vector of axis breaks. 50 | will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided.} 51 | 52 | \item{xlim, ylim}{vector of axis limits, or NULL, which sets limits automatically} 53 | 54 | \item{xexpand, yexpand}{Padding around data. See \code{\link[ggplot2]{scale_continuous}} for details. 55 | The default behavior in ggplot2 is \code{expansion(0.05)}. See \code{\link[ggplot2]{expansion}} 56 | for how to modify this.} 57 | 58 | \item{max.iter}{Maximum number of iterations to try to resolve overlaps. 59 | Defaults to 10000.} 60 | 61 | \item{...}{further arguments to plot. 62 | This is not used by \code{dampack} but required for generic consistency.} 63 | } 64 | \value{ 65 | a ggplot2 object which can be modified by adding additional geoms 66 | } 67 | \description{ 68 | \code{plot.icers} plots the cost-effectiveness plane for a ICER object, calculated with \code{calculate_icers} 69 | } 70 | -------------------------------------------------------------------------------- /R/v_names_states.R: -------------------------------------------------------------------------------- 1 | v_names_states <- c("PFS", "PD", "Death") 2 | 3 | #' Register health-state names (backward-compatible with \code{v_names_states}). 4 | #' Call this once (e.g., after creating a trace) to register the state names. 5 | #' 6 | #' @param state_names Character vector of state names. If \code{NULL}, infer from \code{x}. 7 | #' @param x Optional data frame/matrix/trace to infer names from (wide: non-time columns; 8 | #' long: unique values in \code{state}/\code{State}). 9 | #' @param time_cols Character vector of time column names to exclude when inferring. 10 | #' @return Invisibly returns the resolved state-name vector. 11 | #' @examples 12 | #' set_v_names_states(state_names = c("PFS","PD","Death")) 13 | #' set_v_names_states(x = data.frame(cycle=0:2, PFS=c(1,.8,.6), PD=c(0,.1,.2), Death=c(0,.1,.2))) 14 | #' @export 15 | set_v_names_states <- function(state_names = NULL, x = NULL, 16 | time_cols = c("cycle","Cycle","time","Time","t","Time_horizon")) { 17 | # infer if not given 18 | if (is.null(state_names)) { 19 | if (is.null(x)) stop("Provide `state_names` or `x` to infer from.") 20 | df <- as.data.frame(x) 21 | nm <- names(df) 22 | if (!is.null(nm) && length(nm)) { 23 | # wide trace: use non-time columns 24 | state_names <- setdiff(nm, intersect(nm, time_cols)) 25 | } 26 | if (length(state_names) == 0) { 27 | # long trace: use state/State column 28 | cand <- intersect(nm, c("state","State")) 29 | if (length(cand)) state_names <- sort(unique(df[[cand[1]]])) 30 | } 31 | if (length(state_names) == 0) stop("Cannot infer state names from `x`; pass `state_names` explicitly.") 32 | } 33 | 34 | try(utils::assignInNamespace("v_names_states", state_names, ns = "darthtools"), 35 | silent = TRUE) 36 | # options 37 | options(darthtools.state_names = state_names) 38 | 39 | 40 | 41 | invisible(state_names) 42 | } 43 | 44 | #' Get currently registered health-state names (if any). 45 | #' @return Character vector or NULL if unset. 46 | #' @export 47 | get_v_names_states <- function() { 48 | out <- getOption("darthtools.state_names", NULL) 49 | if (is.null(out) && exists("v_names_states", inherits = TRUE)) { 50 | out <- get("v_names_states", inherits = TRUE) 51 | } 52 | out 53 | } 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /man/add_common_aes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/visualization.R 3 | \name{add_common_aes} 4 | \alias{add_common_aes} 5 | \title{Adds aesthetics to all plots to reduce code duplication} 6 | \usage{ 7 | add_common_aes( 8 | gplot, 9 | txtsize, 10 | scale_name = waiver(), 11 | col = c("none", "full", "bw"), 12 | col_aes = c("fill", "color"), 13 | lval = 50, 14 | greystart = 0.2, 15 | greyend = 0.8, 16 | continuous = c("none", "x", "y"), 17 | n_x_ticks = 6, 18 | n_y_ticks = 6, 19 | xbreaks = NULL, 20 | ybreaks = NULL, 21 | xlim = NULL, 22 | ylim = NULL, 23 | xtrans = "identity", 24 | ytrans = "identity", 25 | xexpand = waiver(), 26 | yexpand = waiver(), 27 | facet_lab_txtsize = NULL, 28 | ... 29 | ) 30 | } 31 | \arguments{ 32 | \item{gplot}{a ggplot object} 33 | 34 | \item{txtsize}{base text size} 35 | 36 | \item{scale_name}{how to name scale. Default inherits from variable name.} 37 | 38 | \item{col}{either none, full color, or black and white} 39 | 40 | \item{col_aes}{which aesthetics to modify with \code{col}} 41 | 42 | \item{lval}{color lightness - 0 to 100} 43 | 44 | \item{greystart}{between 0 and 1. used in greyscale only. smaller numbers are lighter} 45 | 46 | \item{greyend}{between 0 and 1, greater than greystart.} 47 | 48 | \item{continuous}{which axes are continuous and should be modified by this function} 49 | 50 | \item{n_x_ticks, n_y_ticks}{number of axis ticks} 51 | 52 | \item{xbreaks, ybreaks}{vector of axis breaks. 53 | will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided.} 54 | 55 | \item{xlim, ylim}{vector of axis limits, or NULL, which sets limits automatically} 56 | 57 | \item{xtrans, ytrans}{transformations for the axes. See \code{\link[ggplot2]{scale_continuous}} for details.} 58 | 59 | \item{xexpand, yexpand}{Padding around data. See \code{\link[ggplot2]{scale_continuous}} for details. 60 | The default behavior in ggplot2 is \code{expansion(0.05)}. See \code{\link[ggplot2]{expansion}} 61 | for how to modify this.} 62 | 63 | \item{facet_lab_txtsize}{text size for plot facet labels} 64 | 65 | \item{...}{further arguments to plot. 66 | This is not used by \code{dampack} but required for generic consistency.} 67 | } 68 | \value{ 69 | a \code{ggplot2} plot updated with a common aesthetic 70 | } 71 | \description{ 72 | Adds aesthetics to all plots to reduce code duplication 73 | } 74 | \keyword{internal} 75 | -------------------------------------------------------------------------------- /man/plot_psa_distributions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot_psa_distributions.R 3 | \name{plot_psa_distributions} 4 | \alias{plot_psa_distributions} 5 | \title{Plot sampled PSA parameter distributions} 6 | \usage{ 7 | plot_psa_distributions( 8 | df_psa_random, 9 | cap_quantiles = c(0.01, 0.99), 10 | base_size = 14, 11 | scale = 1.5, 12 | rel_min_height = 0.01, 13 | print_group_table = TRUE 14 | ) 15 | } 16 | \arguments{ 17 | \item{df_psa_random}{data frame of PSA draws (rows = draws, columns = parameters). 18 | Only numeric columns are used.} 19 | 20 | \item{cap_quantiles}{numeric length-2 vector (in (0,1)) giving lower/upper quantiles 21 | for optional capping, e.g., \code{c(0.01, 0.99)}. Use \code{NULL} to disable capping. 22 | Default = c(0.01, 0.99).} 23 | 24 | \item{base_size}{base font size for \code{theme_bw}. Default = 14.} 25 | 26 | \item{scale}{ridge height scaling for \code{geom_density_ridges}. Default = 1.5.} 27 | 28 | \item{rel_min_height}{minimum ridge height to display. Default = 0.01.} 29 | 30 | \item{print_group_table}{print \code{table(df_melt$Group)} for a quick check. Default = TRUE.} 31 | } 32 | \value{ 33 | a named list containing: 34 | \itemize{ 35 | \item \code{df_melt}: long-format data with \code{Parameter}, \code{value}, \code{Group} 36 | \item \code{group_table}: frequency table of groups 37 | \item \code{plots}: named list of ggplot objects for "Probabilities", "Utilities", 38 | "Costs", and "Other" (missing groups return \code{NULL}) 39 | } 40 | } 41 | \description{ 42 | \code{plot_psa_distributions} melts PSA draws, classifies parameters 43 | prefixes ("p_", "u_", "c_"), optionally caps extreme values by quantiles, and 44 | produces separate ridge-density plots per group (Probabilities / Utilities / Costs / Other). 45 | } 46 | \examples{ 47 | \donttest{ 48 | set.seed(1); n <- 1000 49 | df <- data.frame( 50 | p_event = rbeta(n, 2, 8), p_death = rbeta(n, 5, 3), 51 | u_base = rbeta(n, 20, 5), u_treated = pmin(pmax(rnorm(n, .82, .06), 0), 1), 52 | c_tx = rgamma(n, 2, 0.001), c_hosp = rgamma(n, 3, 0.005), 53 | other_noise = rnorm(n, 10, 1) 54 | ) 55 | 56 | # Separate panels: one plot per group; no global capping to keep axes sensible. 57 | out <- plot_psa_distributions(df, cap_quantiles = NULL) 58 | out$group_table 59 | 60 | # Print each panel (Probabilities / Utilities / Costs / Other if present) 61 | for (nm in c("Probabilities", "Utilities", "Costs", "Other")) { 62 | if (!is.null(out$plots[[nm]])) print(out$plots[[nm]]) 63 | } 64 | } 65 | } 66 | -------------------------------------------------------------------------------- /man/partsurv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/survival_functions.R 3 | \name{partsurv} 4 | \alias{partsurv} 5 | \title{Fit partitioned survival model to survival data} 6 | \usage{ 7 | partsurv( 8 | pfs_survHE = NULL, 9 | os_survHE = NULL, 10 | l_d.data = NULL, 11 | l_vc.data = NULL, 12 | par = FALSE, 13 | chol = FALSE, 14 | choose_PFS = NULL, 15 | choose_OS = NULL, 16 | times = NULL, 17 | v_names_states, 18 | PA = FALSE, 19 | n_sim = 100, 20 | seed = 421, 21 | warn = TRUE, 22 | dat.x = 0 23 | ) 24 | } 25 | \arguments{ 26 | \item{pfs_survHE}{survHE obj fitting PFS.} 27 | 28 | \item{os_survHE}{survHE obj fitting OS.} 29 | 30 | \item{l_d.data}{list of mean parameter estimates (list containing 2 numerical estimates, 1st being for PFS and 2nd being for OS).} 31 | 32 | \item{l_vc.data}{list of variance-covariance matrices (or their Cholesky decomposition) of parameter estimates (list containing 2 matrices, 1st being for PFS and 2nd being for OS).} 33 | 34 | \item{par}{set to TRUE if parameter mean estimates and their variance-covariance matrices are used instead of survHE objects. 35 | Default = FALSE} 36 | 37 | \item{chol}{set to TRUE if l_vc.data contains Cholesky decomposition of the variance-covariance matrices instead of the actual variance-covariance matrices. 38 | Default = FALSE} 39 | 40 | \item{choose_PFS}{chosen PFS distribution. Choose from: Exponential, Weibull (AFT), Gamma, log-Normal, log-Logistic, Gompertz, Exponential Cure, Weibull (AFT) Cure, Gamma Cure, log-Normal Cure, log-Logistic Cure, Gompertz Cure.} 41 | 42 | \item{choose_OS}{chosen OS distribution. Choose from: Exponential, Weibull (AFT), Gamma, log-Normal, log-Logistic, Gompertz, Exponential Cure, Weibull (AFT) Cure, Gamma Cure, log-Normal Cure, log-Logistic Cure, Gompertz Cure.} 43 | 44 | \item{times}{numeric vector of time to estimate probabilities.} 45 | 46 | \item{v_names_states}{vector of state names.} 47 | 48 | \item{PA}{run probabilistic analysis. 49 | Default = FALSE.} 50 | 51 | \item{n_sim}{number of PA simulations. 52 | Default = 100.} 53 | 54 | \item{seed}{seed for random number generation. 55 | Default = 421.} 56 | 57 | \item{warn}{prints a warning message whenever PFS > OS} 58 | 59 | \item{dat.x}{Optional data (e.g., cut points, knots, or interval mapping) defining the piecewise survival structure.} 60 | } 61 | \value{ 62 | a list containing Markov trace, expected survival, survival probabilities, transition probabilities. 63 | } 64 | \description{ 65 | \code{partsurv} fits partitioned survival model to survival data. 66 | } 67 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: darthtools 3 | Title: Decision Analysis Helper Tools for the 'DARTH' Workgroup 4 | Version: 0.3.0 5 | Authors@R: c( 6 | person("Fernando", "Alarid-Escudero", , "falarid@stanford.edu", role = c("aut", "cre"), 7 | comment = c(ORCID = "0000-0001-5076-1172")), 8 | person("Eline", "Krijkamp", , "e.krijkamp@erasmusmc.com", role = "aut", 9 | comment = c(ORCID = "0000-0003-3970-2205")), 10 | person("Petros", "Pechlivanoglou", , "petros.pechlivanoglou@sickkids.ca", role = "aut", 11 | comment = c(ORCID = "0000-0001-5090-7936")), 12 | person("Hawre", "Jalal", , "hjalal@pitt.edu", role = "aut", 13 | comment = c(ORCID = "0000-0002-8224-6834")), 14 | person("Alan", "Yang", , "alan.yang@sickkids.ca", role = "aut", 15 | comment = c(ORCID = "0000-0002-0344-6812")), 16 | person("Eva", "Enns", , "eenns@umn.edu", role = "aut", 17 | comment = c(ORCID = "0000-0003-0693-7358")), 18 | person("DARTH Workgroup", , , "darth.workgroup@gmail.com", role = "cph") 19 | ) 20 | Description: Tools for decision-analytic cost-effectiveness modeling in R. 21 | Provides functions to build and analyze cohort Markov, partitioned 22 | survival, and microsimulation models; utilities for survival modeling 23 | and probabilistic sensitivity analysis (PSA); and visualization of 24 | cost-effectiveness acceptability curves (CEAC), expected value of 25 | perfect information (EVPI), and expected loss curves (ELC). Developed 26 | by the Decision Analysis in R for Technologies in Health ('DARTH') 27 | workgroup. See . 28 | License: MIT + file LICENSE 29 | URL: https://darth-git.github.io/darthtools/, 30 | https://github.com/DARTH-git/darthtools/ 31 | BugReports: https://github.com/DARTH-git/darthtools/issues 32 | Depends: 33 | R (>= 3.5.0) 34 | Imports: 35 | abind, 36 | data.table, 37 | dplyr, 38 | ellipse, 39 | flexsurv, 40 | flexsurvcure, 41 | ggplot2, 42 | ggrepel, 43 | graphics, 44 | ggridges, 45 | reshape2, 46 | magrittr, 47 | matrixStats, 48 | msm, 49 | muhaz, 50 | mvtnorm, 51 | rlang, 52 | scales, 53 | stats, 54 | stringr, 55 | survHE, 56 | survival, 57 | survminer, 58 | tidyr, 59 | utils, 60 | zoo 61 | Suggests: 62 | gems, 63 | knitr, 64 | rhub, 65 | rmarkdown, 66 | spelling, 67 | urlchecker 68 | VignetteBuilder: 69 | knitr 70 | Encoding: UTF-8 71 | Language: en-US 72 | LazyData: true 73 | Roxygen: list(markdown = TRUE) 74 | RoxygenNote: 7.3.2 75 | -------------------------------------------------------------------------------- /R/within_cycle_corrections.R: -------------------------------------------------------------------------------- 1 | #' Within-cycle correction (WCC) 2 | #' 3 | #' \code{gen_wcc} generates a vector of within-cycle corrections (WCC). 4 | #' 5 | #' @param n_cycles number of cycles 6 | #' @param method The method to be used for within-cycle correction. 7 | #' 8 | #' @return A vector of length \code{n_cycles + 1} with within-cycle corrections 9 | #' 10 | #' @details 11 | #' The default method is an implementation of Simpson's 1/3rd rule that 12 | #' generates a vector with the first and last entry with 1/3 and the odd and 13 | #' even entries with 4/3 and 2/3, respectively. 14 | #' 15 | #' Method "\code{half-cycle}" is the half-cycle correction method that 16 | #' generates a vector with the first and last entry with 1/2 and the rest equal 17 | #' to 1. 18 | #' 19 | #' Method "\code{none}" does not implement any within-cycle correction and 20 | #' generates a vector with ones. 21 | #' 22 | #' @references 23 | #' \enumerate{ 24 | #' \item Elbasha EH, Chhatwal J. Myths and misconceptions of within-cycle 25 | #' correction: a guide for modelers and decision makers. Pharmacoeconomics. 26 | #' 2016;34(1):13-22. 27 | #' \item Elbasha EH, Chhatwal J. Theoretical foundations and practical 28 | #' applications of within-cycle correction methods. Med Decis Mak. 29 | #' 2016;36(1):115-131. 30 | #' } 31 | #' 32 | #' @examples 33 | #' # Number of cycles 34 | #' n_cycles <- 10 35 | #' gen_wcc(n_cycles = n_cycles, method = "Simpson1/3") 36 | #' gen_wcc(n_cycles = n_cycles, method = "half-cycle") 37 | #' gen_wcc(n_cycles = n_cycles, method = "none") 38 | #' 39 | #' @export 40 | gen_wcc <- function(n_cycles, method = c("Simpson1/3", "half-cycle", "none")){ 41 | if(n_cycles <= 0){ 42 | stop("Number of cycles should be positive") 43 | } 44 | 45 | method <- match.arg(method) 46 | 47 | n_cycles <- as.integer(n_cycles) 48 | 49 | if (method == "Simpson1/3"){ 50 | ## Vector with cycles 51 | v_cycles <- seq(1, n_cycles + 1) 52 | ## Generate 2/3 and 4/3 multipliers for even and odd entries, respectively 53 | v_wcc <- ((v_cycles %% 2)==0)*(2/3) + ((v_cycles %% 2)!=0)*(4/3) 54 | ## Substitute 1/3 in first and last entries 55 | v_wcc[1] <- v_wcc[n_cycles + 1] <- 1/3 56 | } 57 | if (method == "half-cycle"){ 58 | ## Initialize within-cycle correction vector 59 | v_wcc <- rep(1, n_cycles + 1) 60 | ## Within-cycle correction weights for first and last cycle 61 | v_wcc[1] <- v_wcc[n_cycles + 1] <- 0.5 62 | } 63 | if (method == "none"){ 64 | ## Initialize within-cycle correction vector 65 | v_wcc <- rep(1, n_cycles + 1) 66 | } 67 | return(v_wcc) 68 | } 69 | -------------------------------------------------------------------------------- /R/rate_conversion.R: -------------------------------------------------------------------------------- 1 | #' Convert a probability to a rate 2 | #' 3 | #' \code{prob_to_rate} checks if a probability is between 0 and 1 and convert it to a rate. 4 | #' 5 | #' @param p probability 6 | #' @param t time/frequency 7 | #' @return a scalar or vector with rates 8 | #' @examples 9 | #' # Annual probability to monthly rate 10 | #' p_year <- 0.3 11 | #' r_month <- prob_to_rate(p = p_year, t = 1/12) 12 | #' r_month 13 | #' @export 14 | prob_to_rate <- function(p, t = 1){ 15 | if ((sum(p > 1) > 0) | (sum(p < 0) > 0)){ 16 | stop("probability not between 0 and 1") 17 | } 18 | r = -(1/t)*log(1 - p) 19 | return(r) 20 | } 21 | 22 | #' Convert a rate to a probability 23 | #' 24 | #' \code{rate_to_prob} convert a rate to a probability. 25 | #' 26 | #' @param r rate 27 | #' @param t number of cycles per base time unit (frequency) 28 | #' @return a scalar or vector with probabilities 29 | #' @examples 30 | #' # Annual rate to monthly probability 31 | #' r_year <- 0.3 32 | #' p_month <- rate_to_prob(r = r_year, t = 12) 33 | #' p_month 34 | #' @export 35 | rate_to_prob <- function(r, t = 1){ 36 | if (any(r < 0, na.rm = TRUE)){ 37 | stop("`r` must be >= 0.") 38 | } 39 | if (any(t <= 0, na.rm = TRUE)){ 40 | stop("`t` must be > 0.") 41 | } 42 | p <- 1 - exp(- r / t) 43 | return(p) 44 | } 45 | 46 | #' Convert a probability to a probability with a different frequency 47 | #' 48 | #' \code{prob_to_prob} convert a probability to a probability with a different frequency. 49 | #' 50 | #' @param p probability 51 | #' @param t number of cycles per base time unit (frequency) 52 | #' @return a scalar or vector of probabilities converted to a different frequency 53 | #' @examples 54 | #' # Annual probability to monthly probability 55 | #' p_year <- 0.3 56 | #' p_month <- prob_to_prob(p = p_year, t = 12) 57 | #' p_month 58 | #' @export 59 | prob_to_prob <- function(p, t = 1){ 60 | if (any(p < 0 | p > 1, na.rm = TRUE)) { 61 | stop("`p` must be between 0 and 1.") 62 | } 63 | if (any(t <= 0, na.rm = TRUE)) { 64 | stop("`t` must be > 0.") 65 | } 66 | p_new <- 1-(1-p)^(1/t) 67 | return(p_new) 68 | } 69 | 70 | #' Convert a odds to a probability 71 | #' 72 | #' \code{odds_to_prob} convert an odds to a probability. 73 | #' 74 | #' @param odds a scalar of vector of odds 75 | #' @return a scalar or vector of probabilities 76 | #' @export 77 | odds_to_prob <- function(odds){ 78 | p <- odds / (odds + 1) 79 | return(p) 80 | } 81 | 82 | #' Convert a probability to an odds 83 | #' 84 | #' \code{prob_to_odds} convert a probability to an odds. 85 | #' 86 | #' @param p a scalar of vector of probabilities 87 | #' @return a scalar or vector of odds 88 | #' @export 89 | prob_to_odds <- function(p){ 90 | odds <- p / (1 - p) 91 | return(odds) 92 | } 93 | 94 | -------------------------------------------------------------------------------- /.github/workflows/rhub.yaml: -------------------------------------------------------------------------------- 1 | # R-hub's generic GitHub Actions workflow file. It's canonical location is at 2 | # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml 3 | # You can update this file to a newer version using the rhub2 package: 4 | # 5 | # rhub::rhub_setup() 6 | # 7 | # It is unlikely that you need to modify this file manually. 8 | 9 | name: R-hub 10 | run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" 11 | 12 | on: 13 | workflow_dispatch: 14 | inputs: 15 | config: 16 | description: 'A comma separated list of R-hub platforms to use.' 17 | type: string 18 | default: 'linux,windows,macos' 19 | name: 20 | description: 'Run name. You can leave this empty now.' 21 | type: string 22 | id: 23 | description: 'Unique ID. You can leave this empty now.' 24 | type: string 25 | 26 | jobs: 27 | setup: 28 | runs-on: ubuntu-latest 29 | outputs: 30 | containers: ${{ steps.rhub-setup.outputs.containers }} 31 | platforms: ${{ steps.rhub-setup.outputs.platforms }} 32 | 33 | steps: 34 | # NO NEED TO CHECKOUT HERE 35 | - uses: r-hub/actions/setup@v1 36 | with: 37 | config: ${{ github.event.inputs.config }} 38 | id: rhub-setup 39 | 40 | linux-containers: 41 | needs: setup 42 | if: ${{ needs.setup.outputs.containers != '[]' }} 43 | runs-on: ubuntu-latest 44 | name: ${{ matrix.config.label }} 45 | strategy: 46 | fail-fast: false 47 | matrix: 48 | config: ${{ fromJson(needs.setup.outputs.containers) }} 49 | container: 50 | image: ${{ matrix.config.container }} 51 | 52 | steps: 53 | - uses: r-hub/actions/checkout@v1 54 | - uses: r-hub/actions/platform-info@v1 55 | with: 56 | token: ${{ secrets.RHUB_TOKEN }} 57 | job-config: ${{ matrix.config.job-config }} 58 | - uses: r-hub/actions/setup-deps@v1 59 | with: 60 | token: ${{ secrets.RHUB_TOKEN }} 61 | job-config: ${{ matrix.config.job-config }} 62 | - uses: r-hub/actions/run-check@v1 63 | with: 64 | token: ${{ secrets.RHUB_TOKEN }} 65 | job-config: ${{ matrix.config.job-config }} 66 | 67 | other-platforms: 68 | needs: setup 69 | if: ${{ needs.setup.outputs.platforms != '[]' }} 70 | runs-on: ${{ matrix.config.os }} 71 | name: ${{ matrix.config.label }} 72 | strategy: 73 | fail-fast: false 74 | matrix: 75 | config: ${{ fromJson(needs.setup.outputs.platforms) }} 76 | 77 | steps: 78 | - uses: r-hub/actions/checkout@v1 79 | - uses: r-hub/actions/setup-r@v1 80 | with: 81 | job-config: ${{ matrix.config.job-config }} 82 | token: ${{ secrets.RHUB_TOKEN }} 83 | - uses: r-hub/actions/platform-info@v1 84 | with: 85 | token: ${{ secrets.RHUB_TOKEN }} 86 | job-config: ${{ matrix.config.job-config }} 87 | - uses: r-hub/actions/setup-deps@v1 88 | with: 89 | job-config: ${{ matrix.config.job-config }} 90 | token: ${{ secrets.RHUB_TOKEN }} 91 | - uses: r-hub/actions/run-check@v1 92 | with: 93 | job-config: ${{ matrix.config.job-config }} 94 | token: ${{ secrets.RHUB_TOKEN }} 95 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(add_common_aes) 4 | export(all_partsurv) 5 | export(boot.haz) 6 | export(boot_haz_np) 7 | export(boot_hr) 8 | export(calc_prevalence) 9 | export(calc_prop_sicker) 10 | export(calc_sick) 11 | export(calc_surv) 12 | export(check_PFS_OS) 13 | export(check_list_elements) 14 | export(check_sum_of_transition_array) 15 | export(check_transition_probability) 16 | export(create_at_risk_table) 17 | export(cumhaz_to_haz) 18 | export(expected_surv) 19 | export(find_interval_limits) 20 | export(fit.fun) 21 | export(fit.fun.cure) 22 | export(fit.models.cure) 23 | export(fit.mstate) 24 | export(format_table_cea) 25 | export(gen_data) 26 | export(gen_wcc) 27 | export(get_DARTH_cols) 28 | export(get_os) 29 | export(get_v_names_states) 30 | export(hazard.fn) 31 | export(labfun) 32 | export(model.dist) 33 | export(model.rmvnorm) 34 | export(normboot.haz) 35 | export(number_ticks) 36 | export(odds_to_prob) 37 | export(partsurv) 38 | export(plot_ceac) 39 | export(plot_evpi) 40 | export(plot_exp_loss) 41 | export(plot_icers) 42 | export(plot_prevalence) 43 | export(plot_proportion_sicker) 44 | export(plot_psa) 45 | export(plot_psa_distributions) 46 | export(plot_surv) 47 | export(plot_tc) 48 | export(plot_te) 49 | export(plot_trace) 50 | export(plot_trace_PSM) 51 | export(plot_trace_microsim) 52 | export(plot_trace_microsim_shiny) 53 | export(plot_trace_strategy) 54 | export(prob_to_odds) 55 | export(prob_to_prob) 56 | export(prob_to_rate) 57 | export(rate_to_prob) 58 | export(runMLE.cure) 59 | export(samplev) 60 | export(set_v_names_states) 61 | export(surv_prob) 62 | export(surv_to_haz) 63 | export(trace.DES) 64 | export(trans_prob) 65 | export(trans_to_surv) 66 | export(update_list_params) 67 | export(update_param_list) 68 | import(dplyr) 69 | import(ggplot2) 70 | importFrom(abind,abind) 71 | importFrom(data.table,rbindlist) 72 | importFrom(dplyr,arrange) 73 | importFrom(dplyr,filter) 74 | importFrom(dplyr,pull) 75 | importFrom(dplyr,select) 76 | importFrom(ellipse,ellipse) 77 | importFrom(flexsurv,flexsurvreg) 78 | importFrom(flexsurv,hweibull) 79 | importFrom(flexsurv,normboot.flexsurvreg) 80 | importFrom(flexsurv,pgompertz) 81 | importFrom(flexsurv,pllogis) 82 | importFrom(flexsurvcure,flexsurvcure) 83 | importFrom(ggrepel,geom_label_repel) 84 | importFrom(graphics,legend) 85 | importFrom(graphics,lines) 86 | importFrom(graphics,matlines) 87 | importFrom(graphics,matplot) 88 | importFrom(graphics,title) 89 | importFrom(magrittr,"%>%") 90 | importFrom(msm,msm) 91 | importFrom(msm,prevalence.msm) 92 | importFrom(muhaz,muhaz) 93 | importFrom(rlang,.data) 94 | importFrom(scales,comma) 95 | importFrom(scales,dollar_format) 96 | importFrom(stats,density) 97 | importFrom(stats,model.frame) 98 | importFrom(stats,model.matrix) 99 | importFrom(stats,na.omit) 100 | importFrom(stats,pexp) 101 | importFrom(stats,pgamma) 102 | importFrom(stats,plnorm) 103 | importFrom(stats,pweibull) 104 | importFrom(stats,quantile) 105 | importFrom(stats,runif) 106 | importFrom(stats,time) 107 | importFrom(stringr,str_sub) 108 | importFrom(survHE,fit.models) 109 | importFrom(survival,Surv) 110 | importFrom(survival,survfit) 111 | importFrom(survminer,ggsurvplot) 112 | importFrom(tidyr,pivot_longer) 113 | importFrom(utils,capture.output) 114 | importFrom(utils,getFromNamespace) 115 | importFrom(utils,globalVariables) 116 | importFrom(utils,modifyList) 117 | importFrom(zoo,rollmean) 118 | -------------------------------------------------------------------------------- /R/check_transition_probabilities.R: -------------------------------------------------------------------------------- 1 | #' Check if transition array is valid 2 | #' 3 | #' \code{check_transition_probability} checks if transition probabilities are in \[0, 1\]. 4 | #' 5 | #' @param a_P A transition probability array/ matrix. 6 | #' @param err_stop Logical variable to stop model run if set up as TRUE. Default = FALSE. 7 | #' @param verbose Logical variable to indicate print out of messages. 8 | #' Default = FALSE 9 | #' 10 | #' @return 11 | #' This function stops if transition probability array is not valid and shows 12 | #' what are the entries that are not valid 13 | #' @export 14 | check_transition_probability <- function(a_P, 15 | err_stop = FALSE, 16 | verbose = FALSE) { 17 | 18 | a_P <- as.array(a_P) 19 | 20 | # Verify if a_P is 2D or 3D matrix 21 | n_dim <- length(dim(a_P)) 22 | # If a_P is a 2D matrix, convert to a 3D array 23 | if (n_dim < 3){ 24 | a_P <- array(a_P, dim = list(nrow(a_P), ncol(a_P), 1), 25 | dimnames = list(rownames(a_P), colnames(a_P), "Time independent")) 26 | } 27 | # Check which entries are not valid 28 | m_indices_notvalid <- arrayInd(which(a_P < 0 | a_P > 1), 29 | dim(a_P)) 30 | 31 | if(dim(m_indices_notvalid)[1] != 0){ 32 | v_rows_notval <- rownames(a_P)[m_indices_notvalid[, 1]] 33 | v_cols_notval <- colnames(a_P)[m_indices_notvalid[, 2]] 34 | v_cycles_notval <- dimnames(a_P)[[3]][m_indices_notvalid[, 3]] 35 | 36 | df_notvalid <- data.frame(`Transition probabilities not valid:` = 37 | matrix(paste0(paste(v_rows_notval, v_cols_notval, sep = "->"), 38 | "; at cycle ", 39 | v_cycles_notval), ncol = 1), 40 | check.names = FALSE) 41 | 42 | if(err_stop) { 43 | stop("Not valid transition probabilities\n", 44 | paste(capture.output(df_notvalid), collapse = "\n")) 45 | } 46 | 47 | if(verbose){ 48 | warning("Not valid transition probabilities\n", 49 | paste(capture.output(df_notvalid), collapse = "\n")) 50 | } 51 | } else if (verbose) { 52 | print("Valid transition probabilities") 53 | } 54 | } 55 | 56 | #' Check if the sum of transition probabilities equal to one. 57 | #' 58 | #' \code{check_sum_of_transition_array} checks if each of the rows of the 59 | #' transition matrices sum to one. 60 | #' 61 | #' @param a_P A transition probability array/ matrix. 62 | #' @param n_states Number of health states in a Markov trace, appropriate for Markov models. 63 | #' @param n_rows Number of rows (individuals), appropriate for microsimulation models. 64 | #' @param n_cycles Number of cycles. 65 | #' @param err_stop Logical variable to stop model run if set up as TRUE. 66 | #' Default = TRUE. 67 | #' @param verbose Logical variable to indicate print out of messages. 68 | #' Default = TRUE 69 | #' @return 70 | #' The transition probability array and the cohort trace matrix. 71 | #' @export 72 | check_sum_of_transition_array <- function(a_P, 73 | n_rows = NULL, 74 | n_states = NULL, 75 | n_cycles, 76 | err_stop = TRUE, 77 | verbose = TRUE) { 78 | 79 | if (!is.null(n_rows) & !is.null(n_states)) { 80 | stop("Pick either n_rows or n_states, not both.") 81 | } 82 | 83 | if (is.null(n_rows) & is.null(n_states)) { 84 | stop("Need to specify either n_rows or n_states, but not both.") 85 | } 86 | 87 | if (!is.null(n_rows)) { 88 | n_states <- n_rows 89 | } 90 | 91 | a_P <- as.array(a_P) 92 | d <- length(dim(a_P)) 93 | 94 | val = TRUE 95 | 96 | # For matrix 97 | if (d == 2) { 98 | #valid <- sum(rowSums(a_P)) 99 | target <- rep(1, n_states) 100 | names(target) <- names(rowSums(a_P)) 101 | valid <- isTRUE(all.equal(rowSums(a_P),target)) 102 | #if (abs(valid - n_states) > 0.01) { 103 | if (!valid) { 104 | if (err_stop) { 105 | stop("This is not a valid transition matrix", call. = FALSE) 106 | } 107 | 108 | if (verbose) { 109 | warning("This is not a valid transition matrix", call. = FALSE) 110 | } 111 | val = FALSE 112 | } 113 | } else { 114 | # For array 115 | # valid <- (apply(a_P, d, function(x) sum(rowSums(x))) == n_states) 116 | valid <- apply(a_P, d, function(x) isTRUE(all.equal(sum(rowSums(x)), 117 | n_states))) 118 | if (!isTRUE(all.equal(as.numeric(sum(valid)), as.numeric(n_cycles)))) { 119 | invalid_entries <- which(!valid) # find invalid entries 120 | if (err_stop) { 121 | stop(paste("This is not a valid transition array", 122 | "\n", 123 | "Invalid entries at cycles: ", 124 | paste(invalid_entries, collapse = ", "), 125 | "\n", 126 | "The sum of transition probabilities for these cycles does not equal to 1")) 127 | } 128 | 129 | if (verbose) { 130 | warning(paste("This is not a valid transition array", 131 | "\n", 132 | "Invalid entries at cycles: ", 133 | paste(invalid_entries, collapse = ", "), 134 | "\n", 135 | "The sum of transition probabilities for these cycles does not equal to 1")) 136 | } 137 | val = FALSE 138 | } 139 | } 140 | if ((val & d == 2) & verbose == TRUE) { 141 | print("This is a valid transition matrix") 142 | } else if ((val & d > 2) & verbose == TRUE) { 143 | print("This is a valid transition array") 144 | } 145 | } 146 | -------------------------------------------------------------------------------- /R/plot_psa_distributions.R: -------------------------------------------------------------------------------- 1 | 2 | if (getRversion() >= "2.15.1") utils::globalVariables(c("Parameter", ".med", "Group")) 3 | 4 | #' Plot sampled PSA parameter distributions 5 | #' 6 | #' \code{plot_psa_distributions} melts PSA draws, classifies parameters 7 | #' prefixes ("p_", "u_", "c_"), optionally caps extreme values by quantiles, and 8 | #' produces separate ridge-density plots per group (Probabilities / Utilities / Costs / Other). 9 | #' 10 | #' @param df_psa_random data frame of PSA draws (rows = draws, columns = parameters). 11 | #' Only numeric columns are used. 12 | #' @param cap_quantiles numeric length-2 vector (in (0,1)) giving lower/upper quantiles 13 | #' for optional capping, e.g., \code{c(0.01, 0.99)}. Use \code{NULL} to disable capping. 14 | #' Default = c(0.01, 0.99). 15 | #' @param base_size base font size for \code{theme_bw}. Default = 14. 16 | #' @param scale ridge height scaling for \code{geom_density_ridges}. Default = 1.5. 17 | #' @param rel_min_height minimum ridge height to display. Default = 0.01. 18 | #' @param print_group_table print \code{table(df_melt$Group)} for a quick check. Default = TRUE. 19 | #' @return 20 | #' a named list containing: 21 | #' \itemize{ 22 | #' \item \code{df_melt}: long-format data with \code{Parameter}, \code{value}, \code{Group} 23 | #' \item \code{group_table}: frequency table of groups 24 | #' \item \code{plots}: named list of ggplot objects for "Probabilities", "Utilities", 25 | #' "Costs", and "Other" (missing groups return \code{NULL}) 26 | #' } 27 | #' @examples 28 | #' \donttest{ 29 | #' set.seed(1); n <- 1000 30 | #' df <- data.frame( 31 | #' p_event = rbeta(n, 2, 8), p_death = rbeta(n, 5, 3), 32 | #' u_base = rbeta(n, 20, 5), u_treated = pmin(pmax(rnorm(n, .82, .06), 0), 1), 33 | #' c_tx = rgamma(n, 2, 0.001), c_hosp = rgamma(n, 3, 0.005), 34 | #' other_noise = rnorm(n, 10, 1) 35 | #' ) 36 | #' 37 | #' # Separate panels: one plot per group; no global capping to keep axes sensible. 38 | #' out <- plot_psa_distributions(df, cap_quantiles = NULL) 39 | #' out$group_table 40 | #' 41 | #' # Print each panel (Probabilities / Utilities / Costs / Other if present) 42 | #' for (nm in c("Probabilities", "Utilities", "Costs", "Other")) { 43 | #' if (!is.null(out$plots[[nm]])) print(out$plots[[nm]]) 44 | #' } 45 | #' } 46 | #' @export 47 | plot_psa_distributions <- function(df_psa_random, 48 | cap_quantiles = c(0.01, 0.99), 49 | base_size = 14, 50 | scale = 1.5, 51 | rel_min_height = 0.01, 52 | print_group_table = TRUE) { 53 | # deps via :: to keep lightweight 54 | if (!requireNamespace("reshape2", quietly = TRUE)) stop("Please install.packages('reshape2').") 55 | if (!requireNamespace("dplyr", quietly = TRUE)) stop("Please install.packages('dplyr').") 56 | if (!requireNamespace("stringr", quietly = TRUE)) stop("Please install.packages('stringr').") 57 | if (!requireNamespace("ggplot2", quietly = TRUE)) stop("Please install.packages('ggplot2').") 58 | if (!requireNamespace("ggridges", quietly = TRUE)) stop("Please install.packages('ggridges').") 59 | 60 | # keep only numeric columns 61 | stopifnot(is.data.frame(df_psa_random)) 62 | num_cols <- vapply(df_psa_random, is.numeric, logical(1)) 63 | if (!any(num_cols)) stop("No numeric columns found in df_psa_random.") 64 | df_num <- df_psa_random[, num_cols, drop = FALSE] 65 | 66 | # Melt the dataset (as in the example) 67 | df_melt <- reshape2::melt(df_num, variable.name = "Parameter", value.name = "value") 68 | 69 | # Optionally cap extreme values (global, like the example) 70 | xlim_global <- NULL 71 | if (!is.null(cap_quantiles) && length(cap_quantiles) == 2) { 72 | q <- stats::quantile(df_melt$value, probs = cap_quantiles, na.rm = TRUE) 73 | df_melt <- df_melt[df_melt$value >= q[[1]] & df_melt$value <= q[[2]], , drop = FALSE] 74 | xlim_global <- c(q[[1]], q[[2]]) 75 | } 76 | 77 | # Create a new column to classify parameters by prefix (as in the example) 78 | df_melt <- dplyr::mutate( 79 | df_melt, 80 | Group = dplyr::case_when( 81 | stringr::str_starts(Parameter, "p_") ~ "Probabilities", 82 | stringr::str_starts(Parameter, "u_") ~ "Utilities", 83 | stringr::str_starts(Parameter, "c_") ~ "Costs", 84 | TRUE ~ "Other" 85 | ) 86 | ) 87 | 88 | # Optionally check the groups 89 | group_tab <- table(df_melt$Group) 90 | if (isTRUE(print_group_table)) print(group_tab) 91 | 92 | # Helper to draw one group's ridges (NULL if empty) 93 | mk_plot <- function(dat, title_txt) { 94 | if (nrow(dat) == 0) return(NULL) 95 | # order y by median for readability 96 | ord <- dat |> 97 | dplyr::group_by(Parameter) |> 98 | dplyr::summarise(.med = stats::median(value, na.rm = TRUE), .groups = "drop") |> 99 | dplyr::arrange(.med) 100 | dat$Parameter <- factor(dat$Parameter, levels = ord$Parameter) 101 | 102 | p <- ggplot2::ggplot(dat, ggplot2::aes(x = value, y = Parameter)) + 103 | ggridges::geom_density_ridges(scale = scale, rel_min_height = rel_min_height, linewidth = 0.3) + 104 | ggplot2::theme_bw(base_size = base_size) + 105 | ggplot2::ggtitle(title_txt) 106 | if (!is.null(xlim_global)) { 107 | p <- p + ggplot2::coord_cartesian(xlim = xlim_global) 108 | } 109 | p 110 | } 111 | 112 | # Split and plot (each panel is a separate plot; y only shows that group's parameters) 113 | plots <- list( 114 | Probabilities = mk_plot(dplyr::filter(df_melt, Group == "Probabilities"), "Probabilities"), 115 | Utilities = mk_plot(dplyr::filter(df_melt, Group == "Utilities"), "Utilities"), 116 | Costs = mk_plot(dplyr::filter(df_melt, Group == "Costs"), "Costs"), 117 | Other = mk_plot(dplyr::filter(df_melt, Group == "Other"), "Other") 118 | ) 119 | 120 | list(df_melt = df_melt, group_table = group_tab, plots = plots) 121 | } 122 | 123 | -------------------------------------------------------------------------------- /R/visualization.R: -------------------------------------------------------------------------------- 1 | #' Plot density of total cost 2 | #' 3 | #' \code{plot_tc} plots density of total cost. 4 | #' 5 | #' @param tc total cost 6 | #' @return a plot of the density of total cost 7 | #' @export 8 | plot_tc <- function(tc) { 9 | # Histogram showing variability in individual total costs 10 | plot(density(tc), main = paste("Total cost per person"), xlab = "Cost ($)") 11 | } 12 | 13 | #' Plot density of total QALYs 14 | #' 15 | #' \code{plot_te} plots density of total QALYs 16 | #' 17 | #' @param te total QALYs 18 | #' @return a plot of the density of total QALYs 19 | #' @export 20 | plot_te <- function(te) { 21 | # Histogram showing variability in individual total QALYs 22 | plot(density(te), main = paste("Total QALYs per person"), xlab = "QALYs") 23 | } 24 | 25 | #' Plot cohort trace of a microsimulation model 26 | #' 27 | #' \code{plot_trace_microsim} plots cohort trace of a microsimulation model. 28 | #' 29 | #' @param m_M a cohort trace matrix 30 | #' @return a plot of the cohort trace 31 | #' @export 32 | plot_trace_microsim <- function(m_M) { 33 | # plot the distribution of the population across health states over time (trace) 34 | # count the number of individuals in each health state at each cycle 35 | m_TR <- t(apply(m_M, 2, function(x) table(factor(x, levels = v_names_states, ordered = TRUE)))) 36 | # m_TR <- m_TR / n_i # calculate the proportion of individuals 37 | m_TR <- m_TR / nrow(m_M) 38 | colnames(m_TR) <- v_names_states # name the rows of the matrix 39 | rownames(m_TR) <- paste("Cycle", 0:(ncol(m_M)-1), sep = " ") # name the columns of the matrix 40 | # Plot trace of first health state 41 | plot(0:(ncol(m_M)-1), m_TR[, 1], type = "l", main = "Health state trace", 42 | ylim = c(0, 1), ylab = "Proportion of cohort", xlab = "Cycle") 43 | # add a line for each additional state 44 | for (n_states in 2:length(v_names_states)) { 45 | lines(0:(ncol(m_M)-1), m_TR[, n_states], col = n_states) # adds a line to current plot 46 | } 47 | legend("topright", v_names_states, col = 1:length(v_names_states), # add a legend to current plot 48 | lty = rep(1, length(v_names_states)), bty = "n", cex = 0.65) 49 | 50 | } 51 | 52 | #' Plot cohort trace of a microsimulation model for the Shiny App 53 | #' 54 | #' \code{plot_trace_microsim_shiny} plots cohort trace of a microsimulation model for the Shiny App. 55 | #' 56 | #' @param m_M a cohort trace matrix 57 | #' @param input_list List of Shiny inputs controlling the microsimulation trace plot. 58 | #' @return a plot of the cohort trace for Shiny App 59 | #' @export 60 | plot_trace_microsim_shiny <- function(m_M, input_list = NULL) { 61 | with(input_list,{ 62 | # plot the distribution of the population across health states over time (trace) 63 | # count the number of individuals in each health state at each cycle 64 | m_TR <- t(apply(m_M, 1, function(x) table(factor(x, levels = v_names_states, ordered = TRUE)))) 65 | m_TR <- m_TR / n_i # calculate the proportion of individuals 66 | colnames(m_TR) <- v_names_states # name the rows of the matrix 67 | rownames(m_TR) <- paste("Cycle", seq_len(nrow(m_TR)) - 1L) # name the columns of the matrix 68 | # Plot trace of first health state 69 | matplot(m_TR, type = "l", main = "Health state trace", col= 1:length(v_names_states), 70 | ylim = c(0, 1), ylab = "Proportion of cohort", xlab = "Cycle") 71 | legend("topright", v_names_states, col = 1:length(v_names_states), # add a legend to current plot 72 | lty = rep(1, length(v_names_states)), bty = "n", cex = 0.65) 73 | m_TR 74 | }) 75 | } 76 | 77 | #' Plot Markov trace from a partitioned survival model. 78 | #' 79 | #' \code{plot_trace_PSM} plots Markov trace from a partitioned survival model. 80 | #' 81 | #' @param time numeric vector of time to estimate probabilities. 82 | #' @param partsurv.model partitioned survival model. 83 | #' @param PA run probabilistic analysis. 84 | #' @param v_names_states vector of state names 85 | #' Default = FALSE. 86 | #' @return 87 | #' a plot of the cohort trace. 88 | #' @export 89 | plot_trace_PSM <- function(time, partsurv.model, PA=F, v_names_states) { 90 | if (PA) { 91 | matplot(time, partsurv.model$Mean, type = 'l', lty = 1, ylab = "Markov trace") 92 | title(main = partsurv.model$chosen_models) 93 | matlines(time, partsurv.model$CI[,,1], lty = 2) 94 | matlines(time, partsurv.model$CI[,,2], lty = 2) 95 | legend("topright", v_names_states, 96 | col = 1:length(v_names_states), lty = rep(1,length(v_names_states)), bty = "n") 97 | } else { 98 | matplot(time, partsurv.model$trace, type = "l", lty = 1, ylab = "Markov trace") 99 | title(main = partsurv.model$chosen_models) 100 | legend("topright", v_names_states, 101 | col = 1:length(v_names_states), lty = rep(1,length(v_names_states)), bty = "n") 102 | } 103 | } 104 | 105 | #' Plot cohort trace 106 | #' 107 | #' \code{plot_trace} plots the cohort trace. 108 | #' 109 | #' @param m_M a cohort trace matrix 110 | #' @return a ggplot object - plot of the cohort trace 111 | #' 112 | #' @export 113 | plot_trace <- function(m_M) { 114 | df_M <- data.frame(Cycle = 0:n_cycles, m_M, check.names = F) 115 | df_M_long <- tidyr::gather(df_M, key = `Health State`, value, 2:ncol(df_M)) 116 | df_M_long$`Health State` <- factor(df_M_long$`Health State`, levels = v_names_states) 117 | gg_trace <- ggplot(df_M_long, aes(x = Cycle, y = value, 118 | color = `Health State`, linetype = `Health State`)) + 119 | geom_line(size = 1) + 120 | xlab("Cycle") + 121 | ylab("Proportion of the cohort") + 122 | scale_x_continuous(breaks = number_ticks(8)) + 123 | theme_bw(base_size = 14) + 124 | theme(legend.position = "bottom", 125 | legend.background = element_rect(fill = NA)) 126 | 127 | return(gg_trace) 128 | } 129 | 130 | #' Number of ticks for \code{ggplot2} plots 131 | #' 132 | #' Function for determining number of ticks on axis of \code{ggplot2} plots. 133 | #' @param n integer giving the desired number of ticks on axis of 134 | #' \code{ggplot2} plots. Non-integer values are rounded down. 135 | #' @section Details: 136 | #' Based on function \code{pretty}. 137 | #' @return a vector of axis-label breaks 138 | #' @export 139 | number_ticks <- function(n) { 140 | function(limits) { 141 | pretty(limits, n + 1) 142 | } 143 | } 144 | 145 | #' Plot cohort trace per strategy 146 | #' 147 | #' \code{plot_trace} plots the cohort trace for each strategy, split by health state. 148 | #' 149 | #' @param l_m_M a list containing cohort trace matrices 150 | #' @return a ggplot object - plot of the cohort trace for each strategy split by health state. 151 | #' @export 152 | plot_trace_strategy <- function(l_m_M) { 153 | n_str <- length(l_m_M) 154 | l_df_M <- lapply(l_m_M, as.data.frame) 155 | df_M_strategies <- data.table::rbindlist(l_df_M, use.names = T, 156 | idcol = "Strategy") 157 | df_M_strategies$Cycle <- rep(0:n_cycles, n_str) 158 | m_M_plot <- tidyr::gather(df_M_strategies, key = `Health State`, value, 159 | 2:(ncol(df_M_strategies)-1)) 160 | m_M_plot$`Health State` <- factor(m_M_plot$`Health State`, levels = v_names_states) 161 | m_M_plot$Strategy <- factor(m_M_plot$Strategy, levels = v_names_str) 162 | 163 | p <- ggplot(m_M_plot, aes(x = Cycle, y = value, 164 | color = Strategy, linetype = Strategy)) + 165 | geom_line(size = 1) + 166 | scale_color_brewer(palette="RdBu") + 167 | xlab("Cycle") + 168 | ylab("Proportion of the cohort") + 169 | theme_bw(base_size = 14) + 170 | theme(legend.position = "bottom", 171 | legend.background = element_rect(fill = NA)) + 172 | facet_wrap(~ `Health State`) 173 | 174 | return(p) 175 | } 176 | 177 | #----------------------------------------------------------------------------# 178 | #### Function to calculate survival probabilities #### 179 | #----------------------------------------------------------------------------# 180 | #' Calculate survival probabilities 181 | #' 182 | #' \code{calc_surv} calculates the survival probabilities. 183 | #' 184 | #' @param l_m_M a list containing cohort trace matrices 185 | #' @param v_names_death_states Character vector of state names considered as “dead”. 186 | #' @return a dataframe containing survival probabilities for each strategy 187 | #' @export 188 | calc_surv <- function(l_m_M, v_names_death_states) { 189 | df_surv <- as.data.frame(lapply(l_m_M, 190 | function(x) { 191 | rowSums(x[, !colnames(x) %in% v_names_death_states]) 192 | } 193 | )) 194 | colnames(df_surv) <- v_names_str 195 | df_surv$Cycle <- 0:n_cycles 196 | df_surv_long <- tidyr::gather(df_surv, key = Strategy, Survival, 1:n_str) 197 | df_surv_long$Strategy <- ordered(df_surv_long$Strategy, levels = v_names_str) 198 | df_surv_long <- df_surv_long %>% 199 | select(Strategy, Cycle, Survival) 200 | 201 | return(df_surv_long) 202 | } 203 | 204 | #----------------------------------------------------------------------------# 205 | #### Function to calculate state proportions #### 206 | #----------------------------------------------------------------------------# 207 | #' Calculate state proportions 208 | #' 209 | #' \code{calc_surv} calculates the proportions of the cohort in specified states 210 | #' 211 | #' @param l_m_M a list containing cohort trace matrices 212 | #' @param v_names_sick_states Character vector of state names considered as “sick”. 213 | #' @return a dataframe containing proportions in specified states for each strategy 214 | #' @export 215 | calc_sick <- function(l_m_M, v_names_sick_states) { 216 | n_sick_states <- length(v_names_sick_states) 217 | df_sick <- as.data.frame(lapply(l_m_M, 218 | function(x) { 219 | if (n_sick_states == 1) { 220 | x[, colnames(x) %in% v_names_sick_states] 221 | } else { 222 | rowSums(x[, colnames(x) %in% v_names_sick_states]) 223 | } 224 | } 225 | )) 226 | colnames(df_sick) <- v_names_str 227 | df_sick$Cycle <- 0:n_cycles 228 | df_sick_long <- tidyr::gather(df_sick, key = Strategy, Sick, 1:n_str) 229 | df_sick_long$Strategy <- ordered(df_sick_long$Strategy, levels = v_names_str) 230 | df_sick_long <- df_sick_long %>% 231 | select(Strategy, Cycle, Sick) 232 | 233 | return(df_sick_long) 234 | } 235 | 236 | #----------------------------------------------------------------------------# 237 | #### Function to calculate prevalence #### 238 | #----------------------------------------------------------------------------# 239 | #' Calculate prevalence 240 | #' 241 | #' \code{plot_prevalence} calculate the prevalence for different health states. 242 | #' 243 | #' @param l_m_M a list containing cohort trace matrices 244 | #' @param v_names_sick_states Character vector of state names considered as “sick”. 245 | #' @param v_names_dead_states Character vector of state names considered as “dead”. 246 | #' @return a dataframe containing prevalence of specified health states for each strategy 247 | #' @export 248 | calc_prevalence <- function(l_m_M, v_names_sick_states, v_names_dead_states) { 249 | df_alive <- calc_surv(l_m_M, v_names_dead_states) 250 | df_prop_sick <- calc_sick(l_m_M, v_names_sick_states) 251 | df_prevalence <- data.frame(Strategy = df_alive$Strategy, 252 | Cycle = df_alive$Cycle, 253 | Prevalence = df_prop_sick$Sick / df_alive$Survival) 254 | return(df_prevalence) 255 | } 256 | 257 | #----------------------------------------------------------------------------# 258 | #### Function to calculate state-in-state proportions #### 259 | #----------------------------------------------------------------------------# 260 | #' Calculate state-in-state proportions 261 | #' 262 | #' \code{plot_prevalence} calculates the proportion of a specified subset of states among a set of specified states 263 | #' 264 | #' @param l_m_M a list containing cohort trace matrices 265 | #' @param v_names_sick_states Character vector of state names considered as “sick”. 266 | #' @param v_names_sicker_states Character vector of state names considered “sicker” (more severe) than the base sick states. 267 | #' @return a dataframe containing state-in-state proportions of specified health states for each strategy 268 | #' @export 269 | calc_prop_sicker <- function(l_m_M, v_names_sick_states, v_names_sicker_states) { 270 | df_prop_sick <- calc_sick(l_m_M, v_names_sick_states) 271 | df_prop_sicker <- calc_sick(l_m_M, v_names_sicker_states) 272 | df_prop_sick_sicker <- data.frame(Strategy = df_prop_sick$Strategy, 273 | Cycle = df_prop_sick$Cycle, 274 | `Proportion Sicker` = 275 | df_prop_sicker$Sick / 276 | (df_prop_sick$Sick + df_prop_sicker$Sick)) 277 | 278 | return(df_prop_sick_sicker) 279 | } 280 | 281 | #----------------------------------------------------------------------------# 282 | #### Function to plot survival curve #### 283 | #----------------------------------------------------------------------------# 284 | #' Plot survival curve 285 | #' 286 | #' \code{plot_surv} plots the survival probability curve. 287 | #' 288 | #' @param l_m_M a list containing cohort trace matrices 289 | #' @param v_names_death_states Character vector of state names considered as “dead”. 290 | #' @return a ggplot object - plot of the survival curve 291 | #' @export 292 | plot_surv <- function(l_m_M, v_names_death_states) { 293 | df_surv <- calc_surv(l_m_M, v_names_death_states) 294 | df_surv$Strategy <- factor(df_surv$Strategy, levels = v_names_str) 295 | df_surv$Survival <- round(df_surv$Survival, 2) 296 | 297 | p <- ggplot(df_surv, 298 | aes(x = Cycle, y = Survival, group = Strategy)) + 299 | geom_line(aes(linetype = Strategy, col = Strategy), size = 1.2) + 300 | scale_color_brewer(palette="RdBu") + 301 | xlab("Cycle") + 302 | ylab("Proportion") + 303 | ggtitle("Survival probabilities") + 304 | theme_bw(base_size = 14) + 305 | theme() 306 | 307 | return(p) 308 | } 309 | 310 | #----------------------------------------------------------------------------# 311 | #### Function to plot prevalence curve #### 312 | #----------------------------------------------------------------------------# 313 | #' Plot prevalence curve 314 | #' 315 | #' \code{plot_prevalence} plots the prevalence curve for specified health states. 316 | #' 317 | #' @param l_m_M a list containing cohort trace matrices 318 | #' @param v_names_sick_states Character vector of state names considered as “sick”. 319 | #' @param v_names_dead_states Character vector of state names considered as “dead”. 320 | #' @return a ggplot object - plot of the prevalence curve 321 | #' @export 322 | plot_prevalence <- function(l_m_M, v_names_sick_states, v_names_dead_states) { 323 | df_prevalence <- calc_prevalence(l_m_M, v_names_sick_states, v_names_dead_states) 324 | df_prevalence$Strategy <- factor(df_prevalence$Strategy, levels = v_names_str) 325 | df_prevalence$Proportion.Sicker <- round(df_prevalence$Prevalence, 2) 326 | 327 | p <- ggplot(df_prevalence, 328 | aes(x = Cycle, y = Prevalence, group = Strategy)) + 329 | geom_line(aes(linetype = Strategy, col = Strategy), size = 1.2) + 330 | scale_color_brewer(palette = "RdBu") + 331 | xlab("Cycle") + 332 | ylab("Proportion") + 333 | ggtitle(paste("Prevalence", "of", paste(v_names_sick_states, collapse = " "))) + 334 | theme_bw(base_size = 14) + 335 | theme() 336 | 337 | return(p) 338 | } 339 | 340 | #----------------------------------------------------------------------------# 341 | #### Function to plot state-in-state proportion curve #### 342 | #----------------------------------------------------------------------------# 343 | #' Plot state-in-state proportion curve 344 | #' 345 | #' \code{plot_prevalence} plots the 346 | #' 347 | #' @param l_m_M a list containing cohort trace matrices 348 | #' @param v_names_sick_states Character vector of state names considered as “sick”. 349 | #' @param v_names_sicker_states Character vector of state names considered “sicker” (more severe) than the base sick states. 350 | #' @return a ggplot object - plot of state-in-state proportion curve 351 | #' @export 352 | plot_proportion_sicker <- function(l_m_M, v_names_sick_states, v_names_sicker_states) { 353 | df_proportion_sicker <- calc_prop_sicker(l_m_M, v_names_sick_states, v_names_sicker_states) 354 | df_proportion_sicker$Strategy <- factor(df_proportion_sicker$Strategy, levels = v_names_str) 355 | df_proportion_sicker$Proportion.Sicker <- round(df_proportion_sicker$Proportion.Sicker, 2) 356 | 357 | p <- ggplot(df_proportion_sicker, 358 | aes(x = Cycle, y = Proportion.Sicker, group = Strategy)) + 359 | geom_line(aes(linetype = Strategy, col = Strategy), size = 1.2, na.rm = T) + 360 | scale_color_brewer(palette = "RdBu") + 361 | xlab("Cycle") + 362 | ylab("Proportion") + 363 | ggtitle(paste(paste("Proportion of", v_names_sicker_states), 364 | paste(c("among", v_names_sick_states), collapse = " "))) + 365 | theme_bw(base_size = 14) + 366 | theme() 367 | 368 | return(p) 369 | } 370 | 371 | #' Update parameters 372 | #' 373 | #' \code{update_param_list} updates a model parameter list with one or more 374 | #' update sets. Later update sets override earlier ones on name conflicts. 375 | #' 376 | #' @param l_params_all List with all parameters of decision model 377 | #' @param ... One or more update sets (list/named vector or a data.frame 378 | #' with columns `name` and `value`). 379 | #' @return 380 | #' A list with all parameters updated. 381 | #' @export 382 | update_param_list <- function(l_params_all, ...){ 383 | stopifnot(is.list(l_params_all)) 384 | updates <- list(...) 385 | if (length(updates) == 0L) return(l_params_all) 386 | 387 | normalize_one <- function(x) { 388 | # data.frame/tibble with name/value 389 | if (is.data.frame(x)) { 390 | needed <- c("name", "value") 391 | if (!all(needed %in% names(x))) { 392 | stop("For data.frame updates, must contain columns: ", 393 | paste(needed, collapse = ", ")) 394 | } 395 | # Support dotted paths e.g. "p.p_A" for nested lists 396 | out <- list() 397 | for (i in seq_len(nrow(x))) { 398 | path <- strsplit(as.character(x$name[i]), "\\.")[[1]] 399 | val <- x$value[i] 400 | cursor <- val 401 | # Build nested list from deepest to top 402 | for (nm in rev(path)) { 403 | cursor <- stats::setNames(list(cursor), nm) 404 | } 405 | out <- modifyList(out, cursor) 406 | } 407 | return(out) 408 | } 409 | 410 | # named vector → list 411 | if (is.atomic(x) && !is.null(names(x))) { 412 | return(split(unname(x), names(x))) 413 | } 414 | 415 | # already a list (possibly unnamed) → ensure named at top level if possible 416 | if (is.list(x)) return(x) 417 | 418 | stop("Unsupported update set type: ", class(x)[1]) 419 | } 420 | 421 | for (u in updates) { 422 | u_norm <- normalize_one(u) 423 | l_params_all <- modifyList(l_params_all, u_norm) 424 | } 425 | l_params_all 426 | } 427 | 428 | # Backward compatibility alias 429 | #' @rdname update_param_list 430 | #' @param params_updated Backward-compatible single update set. 431 | #' @export 432 | update_list_params <- function(l_params_all, params_updated) { 433 | update_param_list(l_params_all, params_updated) 434 | } 435 | 436 | #' Plot of ICERs 437 | #' 438 | #' \code{plot.icers} plots the cost-effectiveness plane for a ICER object, calculated with \code{calculate_icers} 439 | #' @param x Object of class \code{icers}. 440 | #' @inheritParams add_common_aes 441 | #' @param currency string. with currency used in the cost-effectiveness analysis (CEA). 442 | #' @param effect_units string. unit of effectiveness 443 | #' @param label whether to label strategies on the efficient frontier, all strategies, or none. 444 | #' defaults to frontier. 445 | #' @param label_max_char max number of characters to label the strategies - if not NULL (the default) 446 | #' longer strategies are truncated to save space. 447 | #' @param plot_frontier_only only plot the efficient frontier 448 | #' @param alpha opacity of points 449 | #' @inheritParams ggrepel::geom_label_repel 450 | #' 451 | #' @return a ggplot2 object which can be modified by adding additional geoms 452 | #' 453 | #' @importFrom stringr str_sub 454 | #' @importFrom ggrepel geom_label_repel 455 | #' @export 456 | plot_icers <- function(x, 457 | txtsize = 12, 458 | currency = "$", 459 | effect_units = "QALYs", 460 | label = c("frontier", "all", "none"), 461 | label_max_char = NULL, 462 | plot_frontier_only = FALSE, 463 | alpha = 1, 464 | n_x_ticks = 6, 465 | n_y_ticks = 6, 466 | xbreaks = NULL, 467 | ybreaks = NULL, 468 | xlim = NULL, 469 | ylim = NULL, 470 | xexpand = expansion(0.1), 471 | yexpand = expansion(0.1), 472 | max.iter = 20000, 473 | ...) { 474 | if (ncol(x) > 7) { 475 | # reformat icers class object if uncertainty bounds are present 476 | x <- x %>% 477 | select(.data$Strategy, .data$Cost, .data$Effect, 478 | .data$Inc_Cost, .data$Inc_Effect, 479 | .data$ICER, .data$Status) 480 | } 481 | 482 | # type checking 483 | label <- match.arg(label) 484 | 485 | # this is so non-dominated strategies are plotted last (on top) 486 | x <- arrange(x, .data$Status) 487 | 488 | # change status text in data frame for plotting 489 | d_name <- "Dominated" 490 | ed_name <- "Weakly Dominated" 491 | nd_name <- "Efficient Frontier" 492 | 493 | status_expand <- c("D" = d_name, "ED" = ed_name, 494 | "ND" = nd_name, "ref" = nd_name) 495 | x$Status <- factor(status_expand[x$Status], ordered = FALSE, 496 | levels = c(d_name, ed_name, nd_name)) 497 | 498 | # linetype 499 | plot_lines <- c("Dominated" = "blank", 500 | "Weakly Dominated" = "blank", 501 | "Efficient Frontier" = "solid") 502 | 503 | # names to refer to in aes_ 504 | stat_name <- "Status" 505 | strat_name <- "Strategy" 506 | eff_name <- "Effect" 507 | cost_name <- "Cost" 508 | 509 | # frontier only 510 | if (plot_frontier_only) { 511 | plt_data <- x[x$Status == nd_name, ] 512 | } else { 513 | plt_data <- x 514 | } 515 | 516 | # make plot 517 | icer_plot <- ggplot(plt_data, aes_(x = as.name(eff_name), y = as.name(cost_name), 518 | shape = as.name(stat_name))) + 519 | geom_point(alpha = alpha, size = 2) + 520 | geom_line(aes_(linetype = as.name(stat_name), group = as.name(stat_name))) + 521 | scale_linetype_manual(name = NULL, values = plot_lines) + 522 | scale_shape_discrete(name = NULL) + 523 | labs(x = paste0("Effect (", effect_units, ")"), 524 | y = paste0("Cost (", currency, ")")) 525 | 526 | icer_plot <- add_common_aes(icer_plot, txtsize, col = "none", 527 | continuous = c("x", "y"), 528 | n_x_ticks = n_x_ticks, n_y_ticks = n_y_ticks, 529 | xbreaks = xbreaks, ybreaks = ybreaks, 530 | xlim = xlim, ylim = ylim, 531 | xexpand = xexpand, yexpand = yexpand) 532 | 533 | # labeling 534 | if (label != "none") { 535 | if (!is.null(label_max_char)) { 536 | plt_data[, strat_name] <- str_sub(plt_data[, strat_name], 537 | start = 1L, end = label_max_char) 538 | } 539 | if (label == "all") { 540 | lab_data <- plt_data 541 | } 542 | if (label == "frontier") { 543 | lab_data <- plt_data[plt_data$Status == nd_name, ] 544 | } 545 | 546 | icer_plot <- icer_plot + 547 | ggrepel::geom_label_repel(data = lab_data, 548 | aes_(label = as.name(strat_name)), 549 | size = 3, 550 | show.legend = FALSE, 551 | max.iter = max.iter, 552 | direction = "both") 553 | } 554 | return(icer_plot) 555 | } 556 | 557 | #' Adds aesthetics to all plots to reduce code duplication 558 | #' 559 | #' @param gplot a ggplot object 560 | #' @param txtsize base text size 561 | #' @param scale_name how to name scale. Default inherits from variable name. 562 | #' @param col either none, full color, or black and white 563 | #' @param col_aes which aesthetics to modify with \code{col} 564 | #' @param lval color lightness - 0 to 100 565 | #' @param greystart between 0 and 1. used in greyscale only. smaller numbers are lighter 566 | #' @param greyend between 0 and 1, greater than greystart. 567 | #' @param continuous which axes are continuous and should be modified by this function 568 | #' @param n_x_ticks,n_y_ticks number of axis ticks 569 | #' @param xbreaks,ybreaks vector of axis breaks. 570 | #' will override \code{n_x_ticks} and/or \code{n_y_ticks} if provided. 571 | #' @param facet_lab_txtsize text size for plot facet labels 572 | #' @param xlim,ylim vector of axis limits, or NULL, which sets limits automatically 573 | #' @param xtrans,ytrans transformations for the axes. See \code{\link[ggplot2]{scale_continuous}} for details. 574 | #' @param xexpand,yexpand Padding around data. See \code{\link[ggplot2]{scale_continuous}} for details. 575 | #' The default behavior in ggplot2 is \code{expansion(0.05)}. See \code{\link[ggplot2]{expansion}} 576 | #' for how to modify this. 577 | #' @param ... further arguments to plot. 578 | #' This is not used by \code{dampack} but required for generic consistency. 579 | #' @return a \code{ggplot2} plot updated with a common aesthetic 580 | #' 581 | #' @import ggplot2 582 | #' @keywords internal 583 | #' @export 584 | add_common_aes <- function(gplot, txtsize, scale_name = waiver(), 585 | col = c("none", "full", "bw"), 586 | col_aes = c("fill", "color"), 587 | lval = 50, 588 | greystart = 0.2, 589 | greyend = 0.8, 590 | continuous = c("none", "x", "y"), 591 | n_x_ticks = 6, 592 | n_y_ticks = 6, 593 | xbreaks = NULL, 594 | ybreaks = NULL, 595 | xlim = NULL, 596 | ylim = NULL, 597 | xtrans = "identity", 598 | ytrans = "identity", 599 | xexpand = waiver(), 600 | yexpand = waiver(), 601 | facet_lab_txtsize = NULL, 602 | ...) { 603 | p <- gplot + 604 | theme_bw() + 605 | theme(legend.title = element_text(size = txtsize), 606 | legend.text = element_text(size = txtsize - 3), 607 | title = element_text(face = "bold", size = (txtsize + 2)), 608 | axis.title.x = element_text(face = "bold", size = txtsize - 1), 609 | axis.title.y = element_text(face = "bold", size = txtsize - 1), 610 | axis.text.y = element_text(size = txtsize - 2), 611 | axis.text.x = element_text(size = txtsize - 2), 612 | strip.text.x = element_text(size = facet_lab_txtsize), 613 | strip.text.y = element_text(size = facet_lab_txtsize)) 614 | 615 | col <- match.arg(col) 616 | col_aes <- match.arg(col_aes, several.ok = TRUE) 617 | if (col == "full") { 618 | if ("color" %in% col_aes) { 619 | p <- p + 620 | scale_color_discrete(name = scale_name, l = lval, 621 | aesthetics = "color", 622 | drop = FALSE) 623 | } 624 | if ("fill" %in% col_aes) { 625 | p <- p + 626 | scale_fill_discrete(name = scale_name, l = lval, 627 | aesthetics = "fill", 628 | drop = FALSE) 629 | } 630 | } 631 | if (col == "bw") { 632 | if ("color" %in% col_aes) { 633 | p <- p + 634 | scale_color_grey(name = scale_name, start = greystart, end = greyend, 635 | aesthetics = "color", 636 | drop = FALSE) 637 | } 638 | if ("fill" %in% col_aes) { 639 | p <- p + 640 | scale_fill_grey(name = scale_name, start = greystart, end = greyend, 641 | aesthetics = "fill", 642 | drop = FALSE) 643 | } 644 | } 645 | 646 | # axes and axis ticks 647 | continuous <- match.arg(continuous, several.ok = TRUE) 648 | 649 | if ("x" %in% continuous) { 650 | if (!is.null(xbreaks)) { 651 | xb <- xbreaks 652 | } else { 653 | xb <- number_ticks(n_x_ticks) 654 | } 655 | p <- p + 656 | scale_x_continuous(breaks = xb, 657 | labels = labfun, 658 | limits = xlim, 659 | trans = xtrans, 660 | expand = xexpand) 661 | } 662 | if ("y" %in% continuous) { 663 | if (!is.null(ybreaks)) { 664 | yb <- ybreaks 665 | } else { 666 | yb <- number_ticks(n_y_ticks) 667 | } 668 | p <- p + 669 | scale_y_continuous(breaks = yb, 670 | labels = labfun, 671 | limits = ylim, 672 | trans = ytrans, 673 | expand = yexpand) 674 | } 675 | return(p) 676 | } 677 | 678 | #' used to automatically label continuous scales 679 | #' @keywords internal 680 | #' @param x axis breaks 681 | #' @return a character vector giving a label for each input value 682 | #' @export 683 | labfun <- function(x) { 684 | if (any(x > 999, na.rm = TRUE)) { 685 | comma(x) 686 | } else { 687 | x 688 | } 689 | } 690 | 691 | 692 | #' Plot the psa object 693 | #' 694 | #' @param x the psa object 695 | #' @param center plot the mean cost and effectiveness for each strategy. defaults to TRUE 696 | #' @param ellipse plot an ellipse around each strategy. defaults to TRUE 697 | #' @param alpha opacity of the scatterplot points. 698 | #' 0 is completely transparent, 1 is completely opaque 699 | #' @inheritParams add_common_aes 700 | #' 701 | #' @importFrom ellipse ellipse 702 | #' @import dplyr 703 | #' @import ggplot2 704 | #' @importFrom scales dollar_format 705 | #' @return A \code{ggplot2} plot of the PSA, showing the distribution of each PSA sample and strategy 706 | #' on the cost-effectiveness plane. 707 | #' @importFrom tidyr pivot_longer 708 | #' @export 709 | plot_psa <- function(x, 710 | center = TRUE, ellipse = TRUE, 711 | alpha = 0.2, txtsize = 12, col = c("full", "bw"), 712 | n_x_ticks = 6, n_y_ticks = 6, 713 | xbreaks = NULL, 714 | ybreaks = NULL, 715 | xlim = NULL, 716 | ylim = NULL, 717 | ...) { 718 | 719 | effectiveness <- x$effectiveness 720 | cost <- x$cost 721 | strategies <- x$strategies 722 | currency <- x$currency 723 | 724 | # expect that effectiveness and costs have strategy column names 725 | # removes confusing 'No id variables; using all as measure variables' 726 | df_cost <- suppressMessages( 727 | pivot_longer(cost, 728 | everything(), 729 | names_to = "Strategy", 730 | values_to = "Cost") 731 | ) 732 | df_effect <- suppressMessages( 733 | pivot_longer(effectiveness, 734 | cols = everything(), 735 | names_to = "Strategy", 736 | values_to = "Effectiveness") 737 | ) 738 | ce_df <- data.frame("Strategy" = df_cost$Strategy, 739 | "Cost" = df_cost$Cost, 740 | "Effectiveness" = df_effect$Effectiveness) 741 | 742 | # make strategies in psa object into ordered factors 743 | ce_df$Strategy <- factor(ce_df$Strategy, levels = strategies, ordered = TRUE) 744 | 745 | psa_plot <- ggplot(ce_df, aes_string(x = "Effectiveness", y = "Cost", color = "Strategy")) + 746 | geom_point(size = 0.7, alpha = alpha, shape = 21) + 747 | ylab(paste("Cost (", currency, ")", sep = "")) 748 | 749 | # define strategy-specific means for the center of the ellipse 750 | if (center) { 751 | strat_means <- ce_df %>% 752 | group_by(.data$Strategy) %>% 753 | summarize(Cost.mean = mean(.data$Cost), 754 | Eff.mean = mean(.data$Effectiveness)) 755 | # make strategies in psa object into ordered factors 756 | strat_means$Strategy <- factor(strat_means$Strategy, levels = strategies, ordered = TRUE) 757 | psa_plot <- psa_plot + 758 | geom_point(data = strat_means, 759 | aes_string(x = "Eff.mean", y = "Cost.mean", fill = "Strategy"), 760 | size = 8, shape = 21, color = "black") 761 | } 762 | 763 | if (ellipse) { 764 | # make points for ellipse plotting 765 | df_list_ell <- lapply(strategies, function(s) { 766 | strat_specific_df <- ce_df[ce_df$Strategy == s, ] 767 | els <- with(strat_specific_df, 768 | ellipse::ellipse(cor(Effectiveness, Cost), 769 | scale = c(sd(Effectiveness), sd(Cost)), 770 | centre = c(mean(Effectiveness), mean(Cost)))) 771 | data.frame(els, group = s, stringsAsFactors = FALSE) 772 | }) 773 | df_ell <- bind_rows(df_list_ell) 774 | # draw ellipse lines 775 | psa_plot <- psa_plot + geom_path(data = df_ell, 776 | aes_string(x = "x", y = "y", colour = "group"), 777 | size = 1, linetype = 2, alpha = 1) 778 | } 779 | 780 | # add common theme 781 | col <- match.arg(col) 782 | add_common_aes(psa_plot, txtsize, col = col, col_aes = c("color", "fill"), 783 | continuous = c("x", "y"), 784 | n_x_ticks = n_x_ticks, n_y_ticks = n_y_ticks, 785 | xbreaks = xbreaks, ybreaks = ybreaks, 786 | xlim = xlim, ylim = ylim) 787 | } 788 | 789 | 790 | #' Plot of Cost-Effectiveness Acceptability Curves (CEAC) 791 | #' 792 | #' Plots the CEAC, using the object created by \code{ceac}. 793 | #' 794 | #' @param x object of class \code{ceac}. 795 | #' @param frontier whether to plot acceptability frontier (TRUE) or not (FALSE) 796 | #' @param points whether to plot points (TRUE) or not (FALSE) 797 | #' @param currency string with currency used in the cost-effectiveness analysis (CEA). 798 | #' Defaults to \code{$}, but can be any currency symbol or word (e.g., GBP, EUR, peso) 799 | #' @param min_prob minimum probability to show strategy in plot. 800 | #' For example, if the min_prob is 0.05, only strategies that ever 801 | #' exceed Pr(Cost Effective) = 0.05 will be plotted. Most useful in situations 802 | #' with many strategies. 803 | #' @inheritParams add_common_aes 804 | #' 805 | #' @keywords internal 806 | #' 807 | #' @details 808 | #' \code{ceac} computes the probability of each of the strategies being 809 | #' cost-effective at each \code{wtp} value. 810 | #' @return A \code{ggplot2} plot of the CEAC. 811 | #' 812 | #' @import ggplot2 813 | #' @import dplyr 814 | #' 815 | #' @export 816 | plot_ceac <- function(x, 817 | frontier = TRUE, 818 | points = TRUE, 819 | currency = "$", 820 | min_prob = 0, 821 | txtsize = 12, 822 | n_x_ticks = 10, 823 | n_y_ticks = 8, 824 | xbreaks = NULL, 825 | ybreaks = NULL, 826 | ylim = NULL, 827 | xlim = c(0, NA), 828 | col = c("full", "bw"), 829 | ...) { 830 | wtp_name <- "WTP" 831 | prop_name <- "Proportion" 832 | strat_name <- "Strategy" 833 | x$WTP_thou <- x[, wtp_name] / 1000 834 | 835 | # removing strategies with probabilities always below `min_prob` 836 | # get group-wise max probability 837 | if (min_prob > 0) { 838 | max_prob <- x %>% 839 | group_by(.data$Strategy) %>% 840 | summarize(maxpr = max(.data$Proportion)) %>% 841 | filter(.data$maxpr >= min_prob) 842 | strat_to_keep <- max_prob$Strategy 843 | if (length(strat_to_keep) == 0) { 844 | stop( 845 | paste("no strategies remaining. you may want to lower your min_prob value (currently ", 846 | min_prob, ")", sep = "") 847 | ) 848 | } 849 | # report filtered out strategies 850 | old_strat <- unique(x$Strategy) 851 | diff_strat <- setdiff(old_strat, strat_to_keep) 852 | n_diff_strat <- length(diff_strat) 853 | if (n_diff_strat > 0) { 854 | # report strategies filtered out 855 | cat("filtered out ", n_diff_strat, " strategies with max prob below ", min_prob, ":\n", 856 | paste(diff_strat, collapse = ","), "\n", sep = "") 857 | 858 | # report if any filtered strategies are on the frontier 859 | df_filt <- filter(x, .data$Strategy %in% diff_strat & .data$On_Frontier) 860 | if (nrow(df_filt) > 0) { 861 | cat(paste0("WARNING - some strategies that were filtered out are on the frontier:\n", 862 | paste(unique(df_filt$Strategy), collapse = ","), "\n")) 863 | } 864 | } 865 | 866 | # filter dataframe 867 | x <- filter(x, .data$Strategy %in% strat_to_keep) 868 | } 869 | 870 | # Drop unused strategy names 871 | x$Strategy <- droplevels(x$Strategy) 872 | 873 | p <- ggplot(data = x, aes_(x = as.name("WTP_thou"), 874 | y = as.name(prop_name), 875 | color = as.name(strat_name))) + 876 | geom_line() + 877 | xlab(paste("Willingness to Pay (Thousand ", currency, " / QALY)", sep = "")) + 878 | ylab("Pr Cost-Effective") 879 | 880 | if (points) { 881 | p <- p + geom_point(aes_(color = as.name(strat_name))) 882 | } 883 | 884 | if (frontier) { 885 | front <- x[x$On_Frontier, ] 886 | p <- p + geom_point(data = front, aes_(x = as.name("WTP_thou"), 887 | y = as.name(prop_name), 888 | shape = as.name("On_Frontier")), 889 | size = 3, stroke = 1, color = "black") + 890 | scale_shape_manual(name = NULL, values = 0, labels = "Frontier") + 891 | guides(color = guide_legend(order = 1), 892 | shape = guide_legend(order = 2)) 893 | } 894 | col <- match.arg(col) 895 | add_common_aes(p, txtsize, col = col, col_aes = "color", 896 | continuous = c("x", "y"), n_x_ticks = n_x_ticks, n_y_ticks = n_y_ticks, 897 | xbreaks = xbreaks, ybreaks = ybreaks, 898 | ylim = ylim, xlim = xlim) 899 | } 900 | 901 | #' Plot of Expected Loss Curves (ELC) 902 | #' 903 | #' @param x object of class \code{exp_loss}, produced by function 904 | #' \code{calc_exp_loss} 905 | #' @param currency string with currency used in the cost-effectiveness analysis (CEA). 906 | #' Default: $, but it could be any currency symbol or word (e.g., GBP, EUR, peso) 907 | #' @param effect_units units of effectiveness. Default: QALY 908 | #' @param log_y take the base 10 log of the y axis 909 | #' @param frontier indicate the frontier (also the expected value of perfect information). 910 | #' To only plot the EVPI see \code{calc_evpi}. 911 | #' @param points whether to plot points on the curve (TRUE) or not (FALSE) 912 | #' @param lsize line size. defaults to 1. 913 | #' @inheritParams add_common_aes 914 | #' 915 | #' @return A \code{ggplot2} object with the expected loss 916 | #' @import ggplot2 917 | #' @importFrom scales comma 918 | #' @export 919 | plot_exp_loss <- function(x, 920 | log_y = TRUE, 921 | frontier = TRUE, 922 | points = TRUE, 923 | lsize = 1, 924 | txtsize = 12, 925 | currency = "$", 926 | effect_units = "QALY", 927 | n_y_ticks = 8, 928 | n_x_ticks = 20, 929 | xbreaks = NULL, 930 | ybreaks = NULL, 931 | xlim = c(0, NA), 932 | ylim = NULL, 933 | col = c("full", "bw"), 934 | ...) { 935 | wtp_name <- "WTP_thou" 936 | loss_name <- "Expected_Loss" 937 | strat_name <- "Strategy" 938 | x[, wtp_name] <- x$WTP / 1000 939 | 940 | # split into on frontier and not on frontier 941 | nofront <- x 942 | front <- x[x$On_Frontier, ] 943 | 944 | # Drop unused levels from strategy names 945 | nofront$Strategy <- droplevels(nofront$Strategy) 946 | front$Strategy <- droplevels(front$Strategy) 947 | # formatting if logging the y axis 948 | if (log_y) { 949 | tr <- "log10" 950 | } else { 951 | tr <- "identity" 952 | } 953 | 954 | p <- ggplot(data = nofront, aes_(x = as.name(wtp_name), 955 | y = as.name(loss_name))) + 956 | xlab(paste0("Willingness to Pay (Thousand ", currency, "/", effect_units, ")")) + 957 | ylab(paste0("Expected Loss (", currency, ")")) 958 | 959 | # color 960 | col <- match.arg(col) 961 | ## change linetype too if color is black and white 962 | if (col == "full") { 963 | if (points) { 964 | p <- p + geom_point(aes_(color = as.name(strat_name))) 965 | } 966 | p <- p + 967 | geom_line(size = lsize, aes_(color = as.name(strat_name))) 968 | 969 | } 970 | if (col == "bw") { 971 | if (points) { 972 | p <- p + geom_point() 973 | } 974 | p <- p + 975 | geom_line(aes_(linetype = as.name(strat_name))) 976 | } 977 | 978 | p <- add_common_aes(p, txtsize, col = col, col_aes = c("color", "line"), 979 | continuous = c("x", "y"), 980 | n_x_ticks = n_x_ticks, n_y_ticks = n_y_ticks, 981 | xbreaks = xbreaks, ybreaks = ybreaks, 982 | xlim = xlim, ylim = ylim, 983 | ytrans = tr) 984 | if (frontier) { 985 | p <- p + geom_point(data = front, aes_(x = as.name(wtp_name), 986 | y = as.name(loss_name), 987 | shape = as.name("On_Frontier")), 988 | size = 3, stroke = 1, color = "black") + 989 | scale_shape_manual(name = NULL, values = 0, labels = "Frontier & EVPI") + 990 | guides(color = guide_legend(order = 1), 991 | linetype = guide_legend(order = 1), 992 | shape = guide_legend(order = 2)) 993 | } 994 | return(p) 995 | } 996 | 997 | #' Plot of Expected Value of Perfect Information (EVPI) 998 | #' 999 | #' @description 1000 | #' Plots the \code{evpi} object created by \code{calc_evpi}. 1001 | #' 1002 | #' @param x object of class \code{evpi}, produced by function 1003 | #' \code{calc_evpi} 1004 | #' @param currency string with currency used in the cost-effectiveness analysis (CEA). 1005 | #' Default: $, but it could be any currency symbol or word (e.g., GBP, EUR, peso) 1006 | #' @param effect_units units of effectiveness. Default: QALY 1007 | #' @inheritParams add_common_aes 1008 | #' @keywords expected value of perfect information 1009 | #' @return A \code{ggplot2} plot with the EVPI 1010 | #' @seealso \code{calc_evpi} 1011 | #' @import ggplot2 1012 | #' @importFrom scales comma 1013 | #' @export 1014 | plot_evpi <- function(x, 1015 | txtsize = 12, 1016 | currency = "$", 1017 | effect_units = "QALY", 1018 | n_y_ticks = 8, 1019 | n_x_ticks = 20, 1020 | xbreaks = NULL, 1021 | ybreaks = NULL, 1022 | xlim = c(0, NA), 1023 | ylim = NULL, 1024 | ...) { 1025 | x$WTP_thou <- x$WTP / 1000 1026 | g <- ggplot(data = x, 1027 | aes_(x = as.name("WTP_thou"), y = as.name("EVPI"))) + 1028 | geom_line() + 1029 | xlab(paste("Willingness to Pay (Thousand ", currency, "/", effect_units, ")", sep = "")) + 1030 | ylab(paste("EVPI (", currency, ")", sep = "")) 1031 | add_common_aes(g, txtsize, continuous = c("x", "y"), 1032 | n_x_ticks = n_x_ticks, n_y_ticks = n_y_ticks, 1033 | xbreaks = xbreaks, ybreaks = ybreaks, 1034 | xlim = xlim, ylim = ylim) 1035 | } 1036 | --------------------------------------------------------------------------------