ready4 – Software - libraries (youthu)

Docs: Create a synthetic population of young people attending primary mental health services

Thu, 30 Nov 2023 00:00:00 +0000

This below section renders an R Markdown program. The following alternative options may provide improved viewing experience, more contextual information and access to more useful code formats:

view the HTML in the dataset containing its outputs (includes contextual information) from that article; and;
view the HTML along with the current release of its R Markdown code (useful if you plan to run the code) and
view the HTML along with the current development version of its R Markdown code (useful if you wish to copy or edit the code)

Introduction

This program generates a purely synthetic (i.e. fake - no trace of any real records) population that is reasonably representative of the input data we used for the utility mapping study described in the article https://doi.org/10.1101/2021.07.07.21260129.

No access to the real data is required in order to use this program - it is based on summary statistics (e.g. means and standard deviations of variables, correlation matrices). It should be noted however, that a different (and simpler) workflow can be implemented when you do have access to the source dataset (for example, by using the syn function from the synthpop package).

The output of this program is very similar but not identical to a fake dataset created by an earlier version of this program and which is saved in the “ymh_clinical_dict_r3.RDS” file from the https://doi.org/10.7910/DVN/HJXYKQ data repository.

Install required R packages

If you do not have the following packages already installed, uncomment and run the following lines.

# install.packages("faux")
# devtools::install_github("ready4-dev/ready4) 
# devtools::install_github("ready4-dev/youthvars) 
# devtools::install_github("ready4-dev/scorz) 
# devtools::install_github("ready4-dev/specific") 
# devtools::install_github("ready4-dev/TTU")
# devtools::install_github("ready4-dev/youthu")

Load the ready4 framework package.

library(ready4)

Specify parameters to generate outcome fake data

AQoL item response parameters

The first set of input data are the proportions for each allowed response for each of the twenty AQOL-6D questions at both baseline and followup.

aqol_items_prpns_tbs_ls <- list(bl_answer_props_tb = tibble::tribble(
    ~Question, ~Answer_1, ~Answer_2, ~Answer_3, ~Answer_4, ~Answer_5, ~Answer_6,
    "Q1", 0.35, 0.38, 0.16, 0.03, NA_real_,100, # Check item 5 in real data.
    "Q2", 0.28, 0.38, 0.18, 0.08, 0.04,100,
    "Q3", 0.78, 0.18, 0.03, 0.01, 0.0, 100,
    "Q4", 0.64, 0.23, 0.09, 0.0, 100, NA_real_,
    "Q5", 0.3, 0.48, 0.12, 0.05, 100, NA_real_,
    "Q6", 0.33, 0.48, 0.15, 100, NA_real_,NA_real_,
    "Q7", 0.44, 0.27, 0.11, 100, NA_real_, NA_real_,
    "Q8", 0.18, 0.29, 0.23, 0.21, 100, NA_real_,
    "Q9", 0.07, 0.27, 0.19, 0.37, 100, NA_real_,
    "Q10", 0.04, 0.15, 0.4, 0.25, 100, NA_real_,
    "Q11", 0.03, 0.13, 0.52, 0.25, 100, NA_real_,
    "Q12", 0.06, 0.21, 0.25, 0.34, 100, NA_real_,
    "Q13", 0.05, 0.25, 0.31, 0.28, 100, NA_real_,
    "Q14", 0.05, 0.3, 0.34, 0.25, 100, NA_real_,
    "Q15", 0.57, 0.25, 0.12, 100, NA_real_,NA_real_,
    "Q16", 0.48, 0.42, 0.06, 100, NA_real_, NA_real_,
    "Q17", 0.44, 0.3, 0.16, 0.07, 100, NA_real_,
    "Q18", 0.33, 0.38, 0.25, 0.04, 0.0, 100,
    "Q19", 0.33, 0.49, 0.16, 0.02, 0.0, 100,
    "Q20", 0.67, 0.21, 0.02, 100, NA_real_,NA_real_),
    fup_answer_props_tb = tibble::tribble(
    ~Question, ~Answer_1, ~Answer_2, ~Answer_3, ~Answer_4, ~Answer_5, ~Answer_6,
    "Q1", 0.51, 0.33, 0.12, 0.02, NA_real_, 100,
    "Q2", 0.36, 0.38, 0.16, 0.06, 0.02,100,
    "Q3", 0.81, 0.15, 0.04, 0.00, 0.0, 100,
    "Q4", 0.73, 0.18, 0.09, 0.0, 100, NA_real_,
    "Q5", 0.36, 0.42, 0.12, 0.05, 100, NA_real_,
    "Q6", 0.48, 0.40, 0.11, 100, NA_real_,NA_real_,
    "Q7", 0.57, 0.25, 0.09, 100, NA_real_, NA_real_,
    "Q8", 0.31, 0.33, 0.17, 0.12, 100, NA_real_,
    "Q9", 0.13, 0.35, 0.19, 0.23, 100, NA_real_,
    "Q10", 0.1, 0.21, 0.43, 0.16, 100, NA_real_,
    "Q11", 0.06, 0.25, 0.48, 0.18, 100, NA_real_,
    "Q12", 0.08, 0.27, 0.26, 0.25, 100, NA_real_,
    "Q13", 0.07, 0.37, 0.31, 0.19, 100, NA_real_,
    "Q14", 0.08, 0.37, 0.34, 0.15, 100, NA_real_,
    "Q15", 0.62, 0.23, 0.09, 100, NA_real_,NA_real_,
    "Q16", 0.52, 0.40, 0.06, 100, NA_real_, NA_real_,
    "Q17", 0.51, 0.28, 0.15, 0.06, 100, NA_real_,
    "Q18", 0.37, 0.35, 0.25, 0.03, 0.0, 100,
    "Q19", 0.43, 0.40, 0.16, 0.01, 0.0, 100,
    "Q20", 0.77, 0.21, 0.02, 100, NA_real_,NA_real_)) %>%
  youthvars::make_complete_prpns_tbs_ls()

Outcome variable correlation parameters

First we specify the names of variables we will be creating as outcome variables.

var_names_chr <- c("aqol6d_total_w","phq9_total","bads_total",
                   "gad7_total","oasis_total","scared_total","k6_total")

The next step is to specify the correlations between outcome variables (variables assumed to be ordered as in previous step) at baseline and follow-up timepoints.

cor_mat_ls <- list(matrix(c(1,-0.78,0.72,-0.67,-0.71,-0.65,-0.67,
                               NA,1,-0.73,0.69,0.66,0.63,0.71,
                               NA,NA,1,-.57,-0.64,-0.57,-0.65,
                               NA,NA,NA,1,0.74,0.70,0.63,
                               NA,NA,NA,NA,1,0.7,0.59,
                               NA,NA,NA,NA,NA,1,0.55,
                               NA,NA,NA,NA,NA,NA,1),7,7),
                    matrix(c(1,-0.81,0.72,-0.71,-0.73,-0.64,-0.68,
                        NA,1,-0.72,0.69,0.68,0.61,0.68,
                        NA,NA,1,-0.59,-0.61,-0.51,-0.61,
                        NA,NA,NA,1,0.75,0.71,0.6,
                        NA,NA,NA,NA,1,0.68,0.59,
                        NA,NA,NA,NA,NA,1,0.52,
                        NA,NA,NA,NA,NA,NA,1),7,7))

We now specify the univariate distribution parameters for each of the outcome variables.

synth_data_spine_ls <- list(cor_mat_ls = cor_mat_ls,
                            nbr_obs_dbl = c(1068,643),
                            timepoint_nms_chr = c("BL","FUP"),
                            means_ls = list(c(0.6,12.8,78.2, 10.4,8.1,34.2,12.2),
                                            c(0.7,9.8,89.4, 7.9,6.3,28.8,9.8)),
                            sds_ls = list(c(0.2,6.6,24.8,5.7,4.7,17.9,5.8),
                                          c(0.2,6.5,24.4,5.5,4.3,17.8,5.9)),
                            missing_ls = list(c(0,4,10,6,7,7,4),
                                              c(0,5,2,2,1,2,2)),
                            min_max_ls = list(c(0.03,1),
                                              c(0,27),
                                              c(0,150),
                                              c(0,21),
                                              c(0,20),
                                              c(0,82),
                                              c(0,24)),
                            discrete_lgl = c(F,rep(T,6)),
                            var_names_chr = var_names_chr,
                            aqol_tots_var_nms_chr = c(cumulative = "aqol6d_total_c",
                                                      weighted = "aqol6d_total_w"))

Generate fake data

Create fake outcome variable datasets

We now use the parameters we have just specified to create baseline and follow-up datasets with fake data for our nominated outcome variables.

aqol_scores_pars_ls <- list(means_dbl = c(44.5,40.6), 
                            sds_dbl = c(9.9,9.8),
                            corr_dbl = -0.95)
aqol6d_adol_pop_tbs_ls <- aqol_items_prpns_tbs_ls %>%
  scorz::make_aqol6d_adol_pop_tbs_ls(aqol_scores_pars_ls = aqol_scores_pars_ls,
                                     series_names_chr =  c("bl_outcomes_tb",
                                                           "fup_outcomes_tb"),
                                     synth_data_spine_ls = synth_data_spine_ls,
                                     temporal_cors_ls = list(aqol6d_total_w = 0.85))
#> Joining with `by = join_by(id, match_var_chr)`
#> Joining with `by = join_by(id)`
#> Joining with `by = join_by(id, match_var_chr)`
#> Joining with `by = join_by(id)`

Create fake descriptive variables

We now specify the names and statistical parameters of the variables we will be using in descriptive statistics. For this analysis we are not interested in capturing the joint distribution between these variables, so we only use univariate parameters.

descriptives_BL_tb <- tibble::tibble(fkClientID = aqol6d_adol_pop_tbs_ls$bl_outcomes_tb$fkClientID,
                                     round = c(1) ,
                                     d_age = rnorm(1068,18.1,3.3) %>% 
                                       purrr::map_dbl(~min(.x,25) %>% 
                                                        max(12)),
                                     d_gender = c(rep(1,653),
                                                  rep(2,359),
                                                  rep(3,39),
                                                  rep(NA_real_,17)) %>% 
                                       specific::scramble_xx() %>%
                                       factor(labels = c("Female","Male","Other")),
                                     d_sexual_ori_s = c(rep(1,738),
                                                        rep(2,289),
                                                        rep(NA_real_,41)) %>% 
                                       specific::scramble_xx() %>%
                                       factor(labels = c("Straight","Other")),
                                     Region = c(rep(1,671),
                                                rep(2,397)) %>% 
                                       specific::scramble_xx() %>%
                                       factor(labels = c("Metro","Regional")),
                                     CALD = c(rep(T,759),
                                              rep(F,169),
                                              rep(NA,140)) %>% 
                                       specific::scramble_xx(),
                                     d_studying_working = c(rep(1,405),
                                                            rep(2,167),
                                                            rep(3,305),
                                                            rep(4,159),
                                                            rep(NA_real_,32)) %>% 
                                       specific::scramble_xx() %>% 
                                       factor(labels = c("Studying only",
                                                         "Working only",
                                                         "Studying and working",
                                                         "Not studying or working")),
                                     c_p_diag_s = c(rep(1,182),
                                                    rep(2,264),
                                                    rep(3,332),
                                                    rep(4,237),
                                                    rep(NA_real_,53)) %>% 
                                       specific::scramble_xx() %>%
                         factor(labels = c("Depression", "Anxiety","Depression and Anxiety", "Other")),
                         c_clinical_staging_s = c(rep(1,625),
                                                  rep(2,326),
                                                  rep(3,86),
                                                  rep(NA_real_,31)) %>% 
                           specific::scramble_xx() %>%
                           factor(labels = c("0-1a","1b","2-4")),
                         c_sofas = c(rnorm(1068-30,65.2,9.5),
                                     rep(NA_real_,30)) %>% 
                           purrr::map_dbl(~min(.x,100) %>% 
                                            max(0)) %>% 
                           specific::scramble_xx(),
                         s_centre = NA_character_, 
                         d_agegroup = NA_character_, 
                         d_sex_birth_s = NA_character_, 
                         d_country_bir_s = NA_character_,
                         d_ATSI = NA_character_,
                         d_english_home = NA, 
                         d_english_native = NA, 
                         d_relation_s = c(rep(1,325),
                                          rep(2,426),
                                          rep(3,286),
                                          rep(NA_real_,31)) %>% 
                           specific::scramble_xx() %>%
                           factor(labels = c("REPLACE_ME_1",
                                             "REPLACE_ME_2",
                                             "REPLACE_ME_3")))  %>%
  dplyr::mutate(d_sex_birth_s = dplyr::case_when(is.na(d_gender) ~ NA_integer_,
                                                 as.integer(d_gender) %in% 
                                                   c(1L,2L) & 
                                                   runif(1068)>0.995 ~ as.integer(d_gender) %>%
                                                   purrr::map_int(~ ifelse(is.na(.x), 
                                                                           .x, 
                                                                           switch(.x,2L,1L,3L))),
                                                 as.integer(d_gender) == 3 ~ sample(c(1L,2L), 
                                                                                    1068, 
                                                                                    replace = T),
                                                 TRUE ~ as.integer(d_gender)
                                                 ) %>%
                  factor(labels = c("Female","Male")))
#> Registered S3 methods overwritten by 'ggalt':
#>   method                  from   
#>   grid.draw.absoluteGrob  ggplot2
#>   grobHeight.absoluteGrob ggplot2
#>   grobWidth.absoluteGrob  ggplot2
#>   grobX.absoluteGrob      ggplot2
#>   grobY.absoluteGrob      ggplot2
#> Registered S3 methods overwritten by 'rmutil':
#>   method         from 
#>   plot.residuals psych
#>   print.response httr
descriptives_FUP_tb <- descriptives_BL_tb %>% 
  dplyr::filter(fkClientID %in% 
                  aqol6d_adol_pop_tbs_ls$fup_outcomes_tb$fkClientID) %>%
  dplyr::mutate(round = 2,
                d_age = d_age + 0.25,
                Region = Region %>% 
                  specific::randomise_changes_in_fct_lvls(0.98),
                d_studying_working = d_studying_working %>%
                  specific::randomise_changes_in_fct_lvls(0.9),
                c_p_diag_s = c_p_diag_s %>% 
                  specific::randomise_changes_in_fct_lvls(0.90),
                c_clinical_staging_s = c_clinical_staging_s %>% 
                  specific::randomise_changes_in_fct_lvls(0.8),
                c_sofas = c_sofas + rnorm(643,4.7,10) %>% 
                         purrr::map_dbl(~min(.x,100) %>% max(0)))
bl_tb <- dplyr::inner_join(descriptives_BL_tb,
                           aqol6d_adol_pop_tbs_ls$bl_outcomes_tb) 
#> Joining with `by = join_by(fkClientID)`
fup_tb <- dplyr::inner_join(descriptives_FUP_tb,
                            aqol6d_adol_pop_tbs_ls$fup_outcomes_tb)
#> Joining with `by = join_by(fkClientID)`

We make some adjustments to ensure that the c_sofas variable is correlated with our aqol6d_total_w variable at both baseline and follow-up.

bl_tb <- bl_tb %>%
  dplyr::mutate(c_sofas = faux::rnorm_pre(bl_tb$aqol6d_total_w %>% 
                                            as.vector(), 
                                          mu = 65.2, 
                                          sd = 9.5, 
                                          r = 0.5, 
                                          empirical = T) %>% 
                  purrr::map_dbl(~min(.x,100) %>% max(0)))
fup_tb <- fup_tb %>%
  dplyr::mutate(c_sofas = faux::rnorm_pre(fup_tb$aqol6d_total_w %>% 
                                            as.vector(), 
                                          mu = 69.9, 
                                          sd = 10, 
                                          r = 0.5, 
                                          empirical = T) %>% 
                  purrr::map_dbl(~min(.x,100) %>% max(0)))

Combine datasets

We now add the fake outcome variables dataset to the fake descriptive variables dataset.

composite_tb <- dplyr::bind_rows(bl_tb, fup_tb) %>%
  dplyr::mutate(d_age = floor(d_age)) %>%
  dplyr::mutate(d_gender = d_gender %>% as.character() %>%
                  purrr::map_chr(~ifelse(.x=="Other",
                                         sample(c("Genderqueer/gender nonconforming/agender",
                                                              "Transgender"),1),
                                         .x)),
                s_centre = Region %>% as.character() %>%
                  purrr::map_chr(~ifelse(.x=="Metro",
                                         sample(c("Canberra","Southport","Knox"),1),
                                         "Regional Centre")),
                d_country_bir_s = CALD %>%
                  purrr::map_chr(~ifelse(.x,
                                         "Other",
                                         "Australia")), 
                       d_ATSI = CALD %>%
                  purrr::map_chr(~ifelse(.x,
                                         "Yes",
                                         "No")),
                       d_english_home = CALD %>%
                  purrr::map_chr(~ifelse(.x,
                                         "No",
                                         "Yes")), 
                       d_english_native = CALD %>%
                  purrr::map_chr(~ifelse(.x,
                                         "No",
                                         "Yes"))
                ) %>%
  dplyr::select(-CALD) %>%
  dplyr::select(-Region)
composite_tb <- composite_tb %>%
  dplyr::select(-setdiff(names(composite_tb)[startsWith(names(composite_tb),
                                                        "aqol6d_")],
                         names(composite_tb)[startsWith(names(composite_tb),
                                                        "aqol6d_q")]))
composite_tb <- composite_tb %>%
  dplyr::mutate(c_sofas = as.integer(round(c_sofas,0))) %>%
  dplyr::mutate(round = factor(round, labels = c("Baseline",
                                                 "Follow-up"))) %>%
  dplyr::mutate(d_relation_s = dplyr::case_when(d_relation_s %in% 
                                                  c("REPLACE_ME_1","REPLACE_ME_2") ~ 
                                                  "Not in a relationship",
                                                T ~ "In a relationship")) %>%
  youthu::add_dates_from_dstr(bl_start_date_dtm = Sys.Date() - lubridate::days(600),##
                              bl_end_date_dtm = Sys.Date() - lubridate::days(420),
                              duration_args_ls = list(a = 60, b = 140, mean = 90, sd = 10),
                              duration_fn = truncnorm::rtruncnorm,
                              date_var_nm_1L_chr = "d_interview_date") %>%
  dplyr::select(-duration_prd) %>%
  youthvars::transform_raw_ds_for_analysis() %>%
  dplyr::rename(phq9_total = PHQ9,
                bads_total = BADS,
                gad7_total = GAD7,
                oasis_total = OASIS,
                scared_total = SCARED,
                k6_total = K6,
                c_sofas = SOFAS) %>%
  dplyr::select(-c("d_agegroup","Gender", "CALD", "Region"))

Docs: Find and deploy utility mapping models

Fri, 20 Oct 2023 00:00:00 +0000

This below section renders a vignette article from the youthu library. You can use the following links to:

view the vignette on the library website (adds useful hyperlinks to code blocks)
view the source file from that article, and;
edit its contents (requires a GitHub account).

library(youthu)

This vignette outlines a workflow for:

Searching, selecting and retrieving transfer to utility models;
Preparing a prediction dataset for use with a selected transfer to utility model; and
Applying the selected transfer to utility model to a prediction dataset to predict Quality Adjusted Life Years (QALYs).

The practical value of implementing such a workflow is discussed in the economic analysis vignette and a scientific manuscript. Note, this example uses fake data - it should should not be used to inform decision making.

Search, select and retrieve transfer to utility models

To identify datasets that contain transfer to utility models compatible with youthu (ie those developped with the TTU package), you can use the get_ttu_dv_dss function. The function searches specified dataverses (in the below example, the TTU dataverse) for datasets containing output from the TTU package.

ttu_dv_dss_tb <- get_ttu_dv_dss("TTU")

The ttu_dv_dss_tb table summarises some pertinent details about each dataset containing TTU models found by the preceding command. These details include a link to any scientific summary (the “Article” column) associated with a dataset.

Transfer to Utility Datasets
ID	Utility	Predictors	Article
1	aqol6dtotalw	BADS total score , GAD7 total score , K6 total score , OASIS total score , PHQ9 total score , SCARED total score, SOFAS total score

To identify models that predict a specified type of health utility from one or more of a specified subset of predictors, use:

mdls_lup <- get_mdls_lup(ttu_dv_dss_tb = ttu_dv_dss_tb,
                         utility_type_chr = "AQoL-6D",
                         mdl_predrs_in_ds_chr = c("PHQ9 total score",
                                                  "SOFAS total score"))

The preceding command will produce a lookup table with information that includes the catalogue names of models, the predictors used in each model and the analysis that generated each one.

Selected elements from Models Look-Up Table
Catalogue reference	Predictors	Analysis
PHQ9_1_GLM_GSN_LOG	PHQ9	Primary Analysis
PHQ9_1_OLS_CLL	PHQ9	Primary Analysis
PHQ9_SOFAS_1_GLM_GSN_LOG	PHQ9 , SOFAS	Primary Analysis
PHQ9_SOFAS_1_OLS_CLL	PHQ9 , SOFAS	Primary Analysis
OASIS_SOFAS_1_GLM_GSN_LOG	OASIS, SOFAS	Primary Analysis
OASIS_SOFAS_1_OLS_CLL	OASIS, SOFAS	Primary Analysis
BADS_SOFAS_1_GLM_GSN_LOG	BADS , SOFAS	Primary Analysis
BADS_SOFAS_1_OLS_CLL	BADS , SOFAS	Primary Analysis
K6_SOFAS_1_GLM_GSN_LOG	K6 , SOFAS	Primary Analysis
K6_SOFAS_1_OLS_CLL	K6 , SOFAS	Primary Analysis
SCARED_SOFAS_1_GLM_GSN_LOG	SCARED, SOFAS	Primary Analysis
SCARED_SOFAS_1_OLS_CLL	SCARED, SOFAS	Primary Analysis
GAD7_SOFAS_1_GLM_GSN_LOG	GAD7 , SOFAS	Primary Analysis
GAD7_SOFAS_1_OLS_CLL	GAD7 , SOFAS	Primary Analysis
SOFAS_1_GLM_GSN_LOG	SOFAS	Secondary Analysis A
SOFAS_1_OLS_CLL	SOFAS	Secondary Analysis A
OASIS_PHQ9_1_GLM_GSN_LOG	OASIS, PHQ9	Secondary Analysis B
OASIS_PHQ9_1_OLS_CLL	OASIS, PHQ9	Secondary Analysis B
GAD7_PHQ9_1_GLM_GSN_LOG	GAD7, PHQ9	Secondary Analysis B
GAD7_PHQ9_1_OLS_CLL	GAD7, PHQ9	Secondary Analysis B
SCARED_PHQ9_1_GLM_GSN_LOG	SCARED, PHQ9	Secondary Analysis B
SCARED_PHQ9_1_OLS_CLL	SCARED, PHQ9	Secondary Analysis B

To review the summary information about the predictive performance of a specific model, use:

get_dv_mdl_smrys(mdls_lup,
                 mdl_nms_chr = "PHQ9_SOFAS_1_OLS_CLL")
#> $PHQ9_SOFAS_1_OLS_CLL
#>        Parameter Estimate    SE          95% CI
#> 1 SD (Intercept)    0.348 0.017   0.312 , 0.382
#> 2      Intercept    0.428 0.129   0.174 , 0.686
#> 3  PHQ9 baseline   -9.115 0.249 -9.601 , -8.618
#> 4    PHQ9 change   -7.331 0.339 -8.007 , -6.665
#> 5 SOFAS baseline    0.960 0.172   0.616 , 1.292
#> 6   SOFAS change    1.146 0.235   0.674 , 1.607
#> 7             R2    0.767 0.012   0.743 , 0.788
#> 8           RMSE    0.925 0.004   0.922 , 0.928
#> 9          Sigma    0.406 0.012   0.384 , 0.429

More information about a selected model can be found in the online model catalogue, the link to which can be obtained with the following command:

get_mdl_ctlg_url(mdls_lup,
                 mdl_nm_1L_chr = "PHQ9_SOFAS_1_OLS_CLL")

[1] “https://dataverse.harvard.edu/api/access/datafile/6484935”

Prepare a prediction dataset for use with a selected transfer to utility model

Import data

You can now import and inspect the dataset you plan on using for prediction. In the below example we use fake data.

data_tb <- make_fake_ds_one()

Illustrative example of a prediction dataset
UID	Timepoint	Date	PHQ_total	SOFAS_total
Participant_1	Baseline	2022-05-22	7	69
Participant_10	Baseline	2022-04-07	17	60
Participant_10	Follow-up	2022-06-22	17	64
Participant_100	Baseline	2022-07-29	0	76
Participant_1000	Baseline	2022-02-10	0	71
Participant_1000	Follow-up	2022-05-05	0	71

Confirm dataset can be used as a prediction dataset

The prediction dataset must contain variables that correspond to all the predictors of the model you intend to apply. The allowable range and required class of each predictor variable are described in the min_val_dbl, max_val_dbl and class_chr columns of the model predictors lookup table, which can be accessed with a call to the get_predictors_lup function.

predictors_lup <- get_predictors_lup(mdls_lup = mdls_lup,
                                     mdl_nm_1L_chr = "PHQ9_SOFAS_1_OLS_CLL")

Model predictors lookup table
short_name_chr	long_name_chr	min_val_dbl	max_val_dbl	class_chr	increment_dbl	class_fn_chr	mdl_scaling_dbl	covariate_lgl
PHQ9	PHQ9 total score	0	27	integer	1	youthvars::youthvars_phq9	0.01	FALSE
SOFAS	SOFAS total score	0	100	integer	1	youthvars::youthvars_sofas	0.01	TRUE

The prediction dataset must also include both a unique client identifier variable and a measurement time-point identifier variable (which must be a factor with two levels). The dataset also needs to be in long format (ie where measures at different time-points for the same individual are stacked on top of each other in separate rows). We can confirm these conditions hold by creating a dataset metadata object using the make_predn_metadata_ls function. In creating the metadata object, the function checks that the dataset can be used in conjunction with the model specified at the mdl_nm_1L_chr argument. If the prediction dataset uses different variable names for the predictors to those specified in the predictors_lup lookup table, a named vector detailing the correspondence between the two sets of variable names needs to be passed to the predr_vars_nms_chr argument. Finally, if you wish to specify a preferred variable name to use for the predicted utility values when applying the model, you can do this by passing this name to the utl_var_nm_1L_chr argument.

predn_ds_ls <- make_predn_metadata_ls(data_tb,
                                      id_var_nm_1L_chr = "UID",
                                      msrmnt_date_var_nm_1L_chr = "Date",
                                      predr_vars_nms_chr = c(PHQ9 = "PHQ_total",SOFAS = "SOFAS_total"),
                                      round_var_nm_1L_chr = "Timepoint",
                                      round_bl_val_1L_chr = "Baseline",
                                      utl_var_nm_1L_chr = "AQoL6D_HU",
                                      mdls_lup = mdls_lup,
                                      mdl_nm_1L_chr = "PHQ9_SOFAS_1_OLS_CLL")

Apply the selected transfer to utility model to a prediction dataset to predict Quality Adjusted Life Years (QALYs)

Predict health utility at baseline and follow-up timepoints

To generate utility predictions we use the add_utl_predn function. The function needs to be supplied with the prediction dataset (the value passed to argument data_tb) and the validated prediction metadata object we created in the previous step.

data_tb <- add_utl_predn(data_tb,
                         predn_ds_ls = predn_ds_ls)
#> Joining with `by = join_by(UID, Timepoint)`

By default the add_utl_predn function samples model parameter values based on a table of model coefficients when making predictions and constrains predictions to an allowed range. You can override these defaults by adding additional arguments new_data_is_1L_chr = "Predicted" (which uses mean parameter values), force_min_max_1L_lgl = F (removes range constraint) and (if the source dataset makes available downloadable model objects) make_from_tbl_1L_lgl = F. These settings will produce different predictions. It is strongly recommended that you consult the model catalogue (see above) to understand how such decisions may affect the validity of the predicted values that will be generated.

Prediction dataset with predicted utilities
UID	Timepoint	Date	PHQ_total	SOFAS_total	AQoL6D_HU
Participant_1	Baseline	2022-05-22	7	69	0.9080468
Participant_10	Baseline	2022-04-07	17	60	0.5533808
Participant_10	Follow-up	2022-06-22	17	64	0.4006010
Participant_100	Baseline	2022-07-29	0	76	0.6809903
Participant_1000	Baseline	2022-02-10	0	71	0.9877882
Participant_1000	Follow-up	2022-05-05	0	71	0.9602037

Our health utility predictions are now available for use and are summarised below.

summary(data_tb$AQoL6D_HU)
#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#> 0.06646 0.42781 0.63403 0.62335 0.83351 1.00000

Calculate QALYs

The last step is to calculate Quality Adjusted Life Years, using a method assuming a linear rate of change between timepoints.

data_tb <- data_tb %>% add_qalys_to_ds(predn_ds_ls = predn_ds_ls,
                                       include_predrs_1L_lgl = F,
                                       reshape_1L_lgl = F)

Prediction dataset with QALYs
UID	Timepoint	Date	PHQ_total	SOFAS_total	AQoL6D_HU	AQoL6D_HU_change_dbl	duration_prd	qalys_dbl
Participant_1	Baseline	2022-05-22	7	69	0.9080468	0.0000000	0S	0.0000000
Participant_10	Baseline	2022-04-07	17	60	0.5533808	0.0000000	0S	0.0000000
Participant_10	Follow-up	2022-06-22	17	64	0.4006010	-0.1527798	76d 0H 0M 0S	0.0992507
Participant_100	Baseline	2022-07-29	0	76	0.6809903	0.0000000	0S	0.0000000
Participant_1000	Baseline	2022-02-10	0	71	0.9877882	0.0000000	0S	0.0000000
Participant_1000	Follow-up	2022-05-05	0	71	0.9602037	-0.0275845	84d 0H 0M 0S	0.2239991

Docs: Use utility mapping algorithms to help implement cost-utility analyses

Fri, 20 Oct 2023 00:00:00 +0000

This below section renders a vignette article from the youthu library. You can use the following links to:

view the vignette on the library website (adds useful hyperlinks to code blocks)
view the source file from that article, and;
edit its contents (requires a GitHub account).

library(youthu)
set.seed(1234)

This vignette illustrates the rationale for and practical decision-making utility of youthu’s QALYs prediction workflow. Note, this example is illustrated with fake data and should not be used to inform decision-making.

Motivation

The main motivation behind the youthu package is to extend the types of economic analysis that can be undertaken with both single group (e.g. pilot study, health service records) and matched groups (e.g. trial) longitudinal datasets that do not include measures of health utility. This article focuses on its application to matched group datasets.

Example dataset

First, we must first import our data. In this example we will use a fake dataset.

ds_tb <- make_fake_ds_two()
#> Joining with `by = join_by(fkClientID, study_arm_chr)`

Our dataset includes 268 matched comparisons, with each comparison containing baseline and follow-up records for one intervention arm participant and one control arm participant. The first few records are as follows.

First few records from input dataset
fkClientID	round	date_psx	duration_prd	PHQ9	SOFAS	costs_dbl	study_arm_chr	match_idx_int
Participant_20	Baseline	2023-03-15	0S	16	41	301.1868	Intervention	1
Participant_593	Baseline	2023-01-20	0S	19	43	259.3190	Control	1
Participant_593	Follow-up	2023-07-14	175d 0H 0M 0S	16	65	1290.4220	Control	1
Participant_20	Follow-up	2023-09-09	178d 0H 0M 0S	15	74	1787.4242	Intervention	1
Participant_259	Baseline	2023-05-10	0S	19	39	311.0018	Control	2
Participant_962	Baseline	2023-06-22	0S	10	45	276.2181	Intervention	2

This dataset contains features that make it possible to use in conjunction with youthu’s economic analysis functions. These requirements are described in the vignette about finding and using models compatible models to predict QALYs;

The dataset also contains a cost variable, which is a requirement for most, though not all, of the economic analyses that can be undertaken with youthu.

Limitations of datasets without measures of health utility

A notable omission from the dataset is any measure of utility. This omission means that, in the absence of using mapping algorithms such as those included with youthu, the most feasible types of economic evaluation to apply to this dataset would likely be cost-consequence analysis (where a synopsis of the differences in a range of measures are presented alongside cost differences) and cost-effectiveness analysis (where a summary statistic - the incremental cost-effectiveness ratio or ICER - is calculated by dividing differences in costs by differences in a single outcome measure).

These types of economic analyses can be relatively simple to interpret if either the intervention or control arm is simultaneously cheaper and more effective across all included outcome measures. However, these conditions don’t hold in our sample data.

summary((ds_tb %>% dplyr::filter(study_arm_chr == "Control" & round == "Baseline"))[5:6])
#>       PHQ9          SOFAS      
#>  Min.   : 0.0   Min.   :39.00  
#>  1st Qu.: 7.0   1st Qu.:60.00  
#>  Median :12.0   Median :66.00  
#>  Mean   :10.9   Mean   :66.13  
#>  3rd Qu.:15.0   3rd Qu.:72.00  
#>  Max.   :19.0   Max.   :89.00

summary((ds_tb %>% dplyr::filter(study_arm_chr == "Control" & round == "Follow-up"))[5:7])
#>       PHQ9            SOFAS         costs_dbl     
#>  Min.   : 0.000   Min.   :39.00   Min.   : 889.9  
#>  1st Qu.: 4.000   1st Qu.:64.00   1st Qu.:1321.1  
#>  Median : 8.000   Median :71.00   Median :1486.7  
#>  Mean   : 8.493   Mean   :70.65   Mean   :1489.0  
#>  3rd Qu.:13.000   3rd Qu.:77.00   3rd Qu.:1627.0  
#>  Max.   :27.000   Max.   :98.00   Max.   :2216.5

summary((ds_tb %>% dplyr::filter(study_arm_chr == "Intervention" & round == "Baseline"))[5:6])
#>       PHQ9           SOFAS      
#>  Min.   : 0.00   Min.   :36.00  
#>  1st Qu.: 7.00   1st Qu.:61.00  
#>  Median :11.00   Median :67.00  
#>  Mean   :10.81   Mean   :66.74  
#>  3rd Qu.:15.00   3rd Qu.:72.25  
#>  Max.   :19.00   Max.   :88.00

summary((ds_tb %>% dplyr::filter(study_arm_chr == "Intervention" & round == "Follow-up"))[5:7])
#>       PHQ9            SOFAS      costs_dbl     
#>  Min.   : 0.000   Min.   :40   Min.   : 923.4  
#>  1st Qu.: 2.000   1st Qu.:60   1st Qu.:1625.6  
#>  Median : 6.500   Median :68   Median :1777.3  
#>  Mean   : 6.851   Mean   :68   Mean   :1807.8  
#>  3rd Qu.:11.000   3rd Qu.:77   3rd Qu.:1996.0  
#>  Max.   :25.000   Max.   :93   Max.   :2872.7

The pattern of results summarised above create some significant barriers to meaningfully interpreting economic evaluations that are based on cost-consequence or cost-effectiveness analysis:

A cost-effectiveness analysis in which change in PHQ-9 was the benefit measure would be difficult to interpret as the Intervention arm is both more effective and more costly, which begs the question is it worth paying the extra dollars for this improvement? Also - would a judgment of cost-effectiveness remain the same if the study had measured a slightly different incremental benefit or recorded change over a longer or shorter time horizon? It is likely that there is no commonly used value for money benchmark for improvements measured in PHQ-9, nor is there any time weighting associated with the measure. Furthermore, if the potential funding for the intervention is from a budget that is allocated to non-depressive illnesses (e.g. physical health), results from a cost-effectiveness analysis using PHQ-9 as its benefit measure are not readily comparable with economic evaluations of interventions from other illness groups using different benefit measures that are potentially competing for the same scarce funding.
A cost consequence analyses that summarised the differences in costs with the differences in changes in PHQ-9 and SOFAS score would be difficult to interpret because while the intervention is more effective than control for improvements measured on PHQ-9 (where lower scores are better), the control group is superior if benefits are based on functioning improvements as measured by SOFAS scores (where higher scores are better). The lack of any formal weighting for how to trade off clinical symptoms and functioning means that interpretation of this analysis will be highly subjective and likely to change across potential decision makers.

These types of short-comings can be significantly addressed by undertaking cost-utility analyses (CUAs) as:

they use a measure of benefit - the Quality Adjusted Life Year (QALY) - that captures multiple domains of health, weighted by time and population preferences in a single index measure that can be applied across health conditions;
there are published benchmark willingness to pay values for QALYs that are routinely used by decision makers in many countries to make ICER statistics readily interpretable in the context of health budget allocation.

The rest of this article demonstrates how youthu functions can be used to undertake CUA based analyses on the type of data we have just profiled.

Using youthu in a cost-utility analysis workflow

Predict adolescent AQoL-6D health utility

Our first step is to identify which youthu models we will use to predict adolescent AQoL-6D and apply these models to our data. This step was explained in more detail in another vignette article about finding and using transfer to utility models, so will be dealt with briefly here.

First we make sure that our dataset can be used as a prediction dataset in conjunction with the model we intend using.

predn_ds_ls <- make_predn_metadata_ls(ds_tb,
                                      cmprsn_groups_chr = c("Intervention", "Control"),
                                      cmprsn_var_nm_1L_chr = "study_arm_chr",
                                      costs_var_nm_1L_chr = "costs_dbl",
                                      id_var_nm_1L_chr = "fkClientID",
                                      msrmnt_date_var_nm_1L_chr = "date_psx",
                                      round_var_nm_1L_chr = "round",
                                      round_bl_val_1L_chr = "Baseline",
                                      utl_var_nm_1L_chr = "AQoL6D_HU",
                                      mdls_lup = get_mdls_lup(utility_type_chr = "AQoL-6D",
                                                              mdl_predrs_in_ds_chr = c("PHQ9 total score",
                                                                                       "SOFAS total score"),
                                                              ttu_dv_nms_chr = "TTU"),
                                      mdl_nm_1L_chr =  "PHQ9_SOFAS_1_OLS_CLL")

We now use our preferred model to predict health utility from the measures in our dataset.

ds_tb <- add_utl_predn(ds_tb,
                       predn_ds_ls = predn_ds_ls) %>%
  dplyr::select(fkClientID, round, study_arm_chr, date_psx, duration_prd, dplyr::everything())
#> Joining with `by = join_by(fkClientID, round)`

Calculate QALYs

Next we combine the health utility data with the interval between measurement data to calculate QALYs and add them to the dataset.

ds_tb  <- ds_tb %>% add_qalys_to_ds(predn_ds_ls = predn_ds_ls,
                                    include_predrs_1L_lgl = T,
                                    reshape_1L_lgl = T)

First few records from updated dataset with QALYs
fkClientID	study_arm_chr	match_idx_int	date_psx_Baseline	date_psx_Follow-up	duration_prd_Baseline	duration_prd_Follow-up	costs_dbl_Baseline	costs_dbl_Follow-up	PHQ9_Baseline	PHQ9_Follow-up	SOFAS_Baseline	SOFAS_Follow-up	AQoL6D_HU_Baseline	AQoL6D_HU_Follow-up	PHQ9_change_dbl_Baseline	PHQ9_change_dbl_Follow-up	SOFAS_change_dbl_Baseline	SOFAS_change_dbl_Follow-up	AQoL6D_HU_change_dbl_Baseline	AQoL6D_HU_change_dbl_Follow-up	qalys_dbl_Baseline	qalys_dbl_Follow-up
Participant_10	Control	243	2022-12-29	2023-06-24	0S	177d 0H 0M 0S	647.9386	1696.235	8	10	61	64	0.7597988	0.6079774	0	2	0	3	0	-0.1518214	0	0.3314119
Participant_1000	Control	191	2023-02-24	2023-08-27	0S	184d 0H 0M 0S	428.9205	1619.037	4	2	63	82	0.8459579	0.7688131	0	-2	0	19	0	-0.0771448	0	0.4067322
Participant_1001	Intervention	230	2023-01-19	2023-07-17	0S	179d 0H 0M 0S	429.3703	1844.219	10	14	59	72	0.6138300	0.8607305	0	4	0	13	0	0.2469005	0	0.3613228
Participant_1003	Intervention	115	2023-02-17	2023-08-18	0S	182d 0H 0M 0S	395.1637	1537.365	9	0	71	81	0.5808015	0.9315788	0	-9	0	10	0	0.3507773	0	0.3768011
Participant_1005	Intervention	183	2023-05-21	2023-11-23	0S	186d 0H 0M 0S	402.9910	1826.511	17	0	78	88	0.5460607	0.9593811	0	-17	0	10	0	0.4133204	0	0.3833158
Participant_1006	Intervention	219	2023-06-16	2023-12-12	0S	179d 0H 0M 0S	534.2285	2401.478	9	14	75	73	0.7239490	0.5885972	0	5	0	-2	0	-0.1353518	0	0.3216232

Analyse results

Now we can run the main economic analysis. This is implemented by the make_hlth_ec_smry function, which first bootstraps the dataset (implemented by the boot function from the boot package) before passing the mean values for costs and QALYs from each bootstrap sample to with bcea function of the BCEA package to calculate a range of health economic statistics. For this example we pass a value of 50,000 for the willingness to pay parameter, as this is the dollar amount commonly used in Australia as a benchmark for the value of a QALY.

Note, for this illustrative example we only request 1000 bootstrap iterations - in practice this number may be higher.

he_smry_ls <- ds_tb %>% make_hlth_ec_smry(predn_ds_ls = predn_ds_ls,
                                                 wtp_dbl = 50000,
                                                 bootstrap_iters_1L_int = 1000L)
#> Warning: There was 1 warning in `dplyr::summarise()`.
#> ℹ In argument: `dplyr::across(.fns = mean)`.
#> Caused by warning:
#> ! Using `across()` without supplying `.cols` was deprecated in dplyr 1.1.0.
#> ℹ Please supply `.cols` instead.

As part of the output of the make_hlth_ec_smry function is a BCEA object, we can use the BCEA package to produce a number of graphical summaries of economic results. One of the most important is the production of a cost-effectiveness plane. This plot highlights that, with an ICER of $-98,145.56, less than half of the bootstrapped iteration incremental cost and QALY pairs fall within the zone of cost-effectiveness (green). In fact, at the cost-effectiveness threshold we supplied, the results suggest there is a 8% probability that the intervention is cost-effective.

library(ggplot2)
BCEA::ceplane.plot(he_smry_ls$ce_res_ls, wtp =50000,    
                   area_color = "green",
                    graph = "ggplot2",
          theme = ggplot2::theme_light())
#> Warning: Duplicated aesthetics after name standardisation: colour

Docs: Develop health utility mapping algorithms

Thu, 05 Jan 2017 00:00:00 +0000

This below section embeds a PDF version of an R Markdown program. The following alternative options may provide improved viewing experience, more contextual information and access to more useful code formats:

Docs: Predict health utility

Thu, 05 Jan 2017 00:00:00 +0000