Half finished econ analysis vignette

.Rbuildignore

@@ -59,3 +59,4 @@
 ^data-raw/vignettes/_AQoL_6D_Syn_Pop\.Rmd$
 ^doc$
 ^Meta$
+^data-raw/vignettes/_Clippings\.Rmd$

NAMESPACE

@@ -8,6 +8,7 @@ export(add_costs_from_gamma_dist)
 export(add_dates_from_dist)
 export(add_diffs_by_group_and_tmpt)
 export(add_qalys)
+export(add_qalys_to_ds)
 export(extract_guide_box_lgd)
 export(firstbounce_aqol6d_adol)
 export(firstbounce_bads)

R/fn_add.R

@@ -20,7 +20,6 @@
 #' @importFrom dplyr rename select left_join
 #' @importFrom rlang sym
 #' @importFrom tidyselect all_of
-#' @keywords internal
 add_aqol6d_predn_to_ds <- function (data_tb, model_mdl, tfmn_1L_chr, predr_vars_nms_chr = NULL, 
  utl_var_nm_1L_chr = NULL, id_var_nm_1L_chr = "fkClientID", 
  round_var_nm_1L_chr = "round", round_bl_val_1L_chr = "Baseline", 
@@ -270,3 +269,24 @@ add_qalys <- function (ds_tb, cmprsn_var_nm_1L_chr = "study_arm_chr", duration_v
  }
  return(updated_ds_tb)
 }
+#' Add qalys to dataset
+#' @description add_qalys_to_ds() is an Add function that updates an object by adding data to that object. Specifically, this function implements an algorithm to add qalys to dataset. Function argument ds_tb specifies the object to be updated. The function returns Dataset (a tibble).
+#' @param ds_tb Dataset (a tibble)
+#' @param ds_smry_ls Dataset smry (a list)
+#' @return Dataset (a tibble)
+#' @rdname add_qalys_to_ds
+#' @export 
+#' @importFrom purrr map reduce
+add_qalys_to_ds <- function (ds_tb, ds_smry_ls) 
+{
+ args_ls_ls <- purrr::map(c(ds_smry_ls$predr_var_nms, ds_smry_ls$utl_var_nm_1L_chr), 
+ ~list(change_var_nm_1L_chr = paste0(.x, "_change_dbl"), 
+ var_nm_1L_chr = .x))
+ ds_tb <- purrr::reduce(1:length(args_ls_ls), .init = ds_tb, 
+ ~add_change_in_ds_var(.x, var_nm_1L_chr = args_ls_ls[[.y]]$var_nm_1L_chr, 
+ change_var_nm_1L_chr = args_ls_ls[[.y]]$change_var_nm_1L_chr)) %>% 
+ add_qalys(utl_change_var_nm_1L_chr = paste0(ds_smry_ls$utl_var_nm_1L_chr, 
+ "_change_dbl"), utl_var_nm_1L_chr = ds_smry_ls$utl_var_nm_1L_chr, 
+ duration_var_nm_1L_chr = "duration_prd", qalys_var_nm_1L_chr = "qalys_dbl")
+ return(ds_tb)
+}

R/fn_extract.R

@@ -5,6 +5,7 @@
 #' @rdname extract_guide_box_lgd
 #' @export 
 #' @importFrom ggplot2 ggplot_gtable ggplot_build
+#' @keywords internal
 extract_guide_box_lgd <- function (a.gplot) 
 {
  tmp <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(a.gplot))

R/fn_get.R

@@ -9,7 +9,6 @@
 #' @export 
 #' @importFrom dataverse dataset_files
 #' @importFrom purrr map_chr
-#' @keywords internal
 get_mdl_from_dv <- function (mdl_nm_1L_chr, dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/JC6PTV", 
  server_1L_chr = "dataverse.harvard.edu", key_1L_chr = NULL) 
 {
@@ -37,7 +36,6 @@ get_mdl_from_dv <- function (mdl_nm_1L_chr, dv_ds_nm_1L_chr = "https://doi.org/1
 #' @importFrom dplyr filter mutate across everything pull
 #' @importFrom stringr str_trim
 #' @importFrom tibble as_tibble
-#' @keywords internal
 get_mdls_using_predrs <- function (mdl_predrs_in_ds_chr, mdls_lup = NULL) 
 {
  if (is.null(mdls_lup)) 
@@ -69,7 +67,6 @@ get_mdls_using_predrs <- function (mdl_predrs_in_ds_chr, mdls_lup = NULL)
 #' @export 
 #' @importFrom utils data
 #' @importFrom ready4fun get_from_lup_obj
-#' @keywords internal
 get_tfmn_from_lup <- function (mdl_nm_1L_chr, mdls_lup = NULL) 
 {
  if (is.null(mdls_lup)) 

R/fn_make.R

@@ -183,7 +183,6 @@ make_formula <- function (dep_var_nm_1L_chr, predictors_chr, environment_env = p
 #' @importFrom boot boot
 #' @importFrom purrr map_int
 #' @importFrom BCEA bcea
-#' @keywords internal
 make_he_smry <- function (ds_tb, change_vars_chr = NA_character_, wtp_dbl = 50000, 
  bootstrap_iters_1L_int = 1000, change_types_chr = "dbl", 
  benefits_pfx_1L_chr = "qalys_dbl", benefits_var_nm_1L_chr = "qalys", 
@@ -221,7 +220,6 @@ make_he_smry <- function (ds_tb, change_vars_chr = NA_character_, wtp_dbl = 5000
 #' @rdname make_matched_ds
 #' @export 
 #' @importFrom dplyr mutate across
-#' @keywords internal
 make_matched_ds <- function (sngl_grp_ds, cmprsn_smry_tb, ds_smry_ls) 
 {
  matched_ds_tb <- sngl_grp_ds_tb %>% make_fake_trial_ds(id_var_nm_1L_chr = ds_smry_ls$id_var_nm_1L_chr, 
@@ -284,7 +282,6 @@ make_matched_ds_spine <- function (ds_tb, round_var_nm_1L_chr = "Timepoint_chr",
 #' @export 
 #' @importFrom dplyr select mutate arrange
 #' @importFrom tibble as_tibble
-#' @keywords internal
 make_sngl_grp_ds <- function (seed_ds_tb = NULL, ds_smry_ls) 
 {
  sngl_grp_ds_tb <- seed_ds_tb %>% dplyr::select(ds_smry_ls$id_var_nm_1L_chr, 

_pkgdown.yml

@@ -32,4 +32,11 @@ reference:
  - firstbounce_sofas
 - title: "Functions"
 - contents:
- - extract_guide_box_lgd
+ - add_aqol6d_predn_to_ds
+ - add_qalys_to_ds
+ - get_mdl_from_dv
+ - get_mdls_using_predrs
+ - get_tfmn_from_lup
+ - make_he_smry
+ - make_matched_ds
+ - make_sngl_grp_ds

data-raw/DATASET.R

@@ -103,27 +103,9 @@ utils::data("fn_type_lup_tb")
 fns_dmt_tb <- ready4fun::make_dmt_for_all_fns(paths_ls = ready4fun::make_fn_nms()[1],
  undocumented_fns_dir_chr = ready4fun::make_undmtd_fns_dir_chr()[1],
  custom_dmt_ls = list(details_ls = NULL,
- inc_for_main_user_lgl_ls = list(force_true_chr = c("add_aqol6d_items_to_tbs_ls","add_aqol_scores_tbs_ls",
- "add_aqol6dU_to_aqol6d_items_tb","add_aqol6dU_to_tbs_ls",
- "add_cors_and_uts_to_tbs_ls_ls","add_dim_disv_to_aqol6d_items_tb",
- "add_dim_scores_to_aqol6d_items_tb", "add_unwtd_dim_tots",
- "add_itm_disv_to_aqol6d_itms_tb","add_labels_to_aqol6d_tb",
- "add_uids_to_tbs_ls","calculate_aqol6d_dim_1_disv",
- "calculate_aqol6d_dim_2_disv","calculate_aqol6d_dim_3_disv",
- "calculate_aqol6d_dim_4_disv","calculate_aqol6d_dim_5_disv",
- "calculate_aqol6d_dim_6_disv","calculate_adult_aqol6dU",
- "extract_guide_box_lgd","force_min_max_and_int_cnstrs",
- "force_vec_to_sum_to_int","impute_adult_aqol6d_items_tb",
- #"make_aqol_items_props_tbs_ls",
- "make_aqol6d_fns_ls",
- "make_aqol6d_items_tb", "make_correlated_data_tb",
- "make_corstars_tbl_xx","make_dim_sclg_cons_dbl",
- "make_domain_items_ls","make_item_wrst_wghts_ls_ls",
- "make_pdef_cor_mat_mat", "make_synth_series_tbs_ls",
- "make_vec_with_sum_of_int", "randomise_changes_in_fct_levs",
- "reorder_tbs_for_target_cors","replace_with_missing_vals",
- "scramble_xx","transform_raw_aqol_tb_to_aqol6d_tb",
- "write_results_to_csv"),
+ inc_for_main_user_lgl_ls = list(force_true_chr = c("add_aqol6d_predn_to_ds","add_qalys_to_ds",
+ "get_mdl_from_dv","get_mdls_using_predrs","get_tfmn_from_lup",
+ "make_he_smry","make_sngl_grp_ds","make_matched_ds"),
  force_false_chr = NA_character_),
  args_ls_ls = NULL),
  fn_type_lup_tb = fn_type_lup_tb,
@@ -191,7 +173,7 @@ readLines(".github/workflows/R-CMD-check.yaml")[-28] %>%
  writeLines(".github/workflows/R-CMD-check.yaml")
 ready4fun::write_and_doc_fn_fls(fns_dmt_tb,
  r_dir_1L_chr = "R",
- dev_pkgs_chr = c("ready4fun","ready4show","ready4use","TTU"),
+ dev_pkgs_chr = c("ready4fun","ready4show","ready4use","TTU","dataverse"),
  update_pkgdown_1L_lgl = T,
  path_to_dvpr_dmt_dir_1L_chr = "../../../../../Documentation/Code/Developer",
  path_to_user_dmt_dir_1L_chr = "../../../../../Documentation/Code/User")

data-raw/fns/add.R

@@ -194,3 +194,20 @@ add_qalys <- function(ds_tb,
  }
  return(updated_ds_tb)
 }
+add_qalys_to_ds <- function(ds_tb,
+ ds_smry_ls){
+ args_ls_ls <- purrr::map(c(ds_smry_ls$predr_var_nms,
+ ds_smry_ls$utl_var_nm_1L_chr),
+ ~ list(change_var_nm_1L_chr = paste0(.x,"_change_dbl"),
+ var_nm_1L_chr = .x))
+ ds_tb <- purrr::reduce(1:length(args_ls_ls),
+ .init = ds_tb,
+ ~ add_change_in_ds_var(.x,
+ var_nm_1L_chr = args_ls_ls[[.y]]$var_nm_1L_chr,
+ change_var_nm_1L_chr = args_ls_ls[[.y]]$change_var_nm_1L_chr)) %>%
+ add_qalys(utl_change_var_nm_1L_chr = paste0(ds_smry_ls$utl_var_nm_1L_chr,"_change_dbl"),
+ utl_var_nm_1L_chr = ds_smry_ls$utl_var_nm_1L_chr,
+ duration_var_nm_1L_chr = "duration_prd",
+ qalys_var_nm_1L_chr = "qalys_dbl")
+ return(ds_tb)
+}

data-raw/vignettes/_Clippings.Rmd

@@ -0,0 +1,69 @@
+---
+title: "_Clipplings"
+author: "Matthew Hamilton"
+date: "18/02/2021"
+output: html_document
+---
+
+## Matched groups details
+
+
+## Single group details
+The `r sngl_grp_ds_tb %>% dplyr::filter(round == "Baseline") %>% nrow()` baseline records are summarised below.
+```{r}
+(sngl_grp_ds_tb %>% dplyr::filter(round == "Baseline"))[4:7] %>% summary()
+```
+The summary of `r sngl_grp_ds_tb %>% dplyr::filter(round == "Follow-up") %>% nrow()` follow-up records:
+```{r}
+(sngl_grp_ds_tb %>% dplyr::filter(round == "Follow-up"))[4:7] %>% summary()
+```
+We add a cost variable with gamma distributed costs that have mean values of \$300 for a defined period up to baseline and \$1500 for the costs accrued between baseline and follow-up. 
+The resulting single group dataset contains `r nrow(sngl_grp_ds_tb)` records, with a snapshot provided below.
+
+```{r}
+sngl_grp_ds_tb %>% head()
+```
+
+# Types of economic analysis facilitated by youthu
+There are four types of economic analysis in youth mental health that youthu can help with:
+
+- Extending cost-consequence and cost-effectiveness economic evaluations to include cost-utility analyses that are easier for healthcare policy-makers to interpret;
+- Extending efficacy trials with a modelled analysis exploring the plausibility of the potential cost-effectiveness of study interventions;
+- Extending single group datasets (e.g. health service records, pilot studys) with a modelled analysis of the potential for hypothethised interventions being cost-effective; and
+- Assessing the potential economic value of alternative intervention research proposals.
+```{r}
+# var_nms_chr <- paste0(c("costs_dbl","qalys_dbl", paste0(c("PHQ9","SOFAS","AQOL6D_HU"), "_change_dbl")),"_Follow-up")
+ 
+```
+
+```{r}
+# named_mat <- bootstraps_ls$t
+# colnames(named_mat) <- names(bootstraps_ls$t0)
+```
+
+```{r}
+evpi_ls <- BCEA::evppi(names(he_smry_ls$bootstraps_ls$t0)[c(1,3)],
+ input = he_smry_ls$named_mat,
+ he = he_smry_ls$ce_res_ls)
+```
+```{r fig.width=6}
+BCEA::plot.evppi(evpi_ls, graph = "ggplot2")
+```
+
+```{r fig.width=6}
+BCEA::eib.plot(he_smry_ls$ce_res_ls)
+```
+
+```{r fig.width=6}
+BCEA::evi.plot(he_smry_ls$ce_res_ls,
+ graph = "ggplot2")
+```
+
+```{r fig.width=6}
+BCEA::ceac.plot(he_smry_ls$ce_res_ls,
+ graph = "ggplot2",
+ #title = "my title",
+ line_colors = "green",
+ theme = ggplot2::theme_dark())
+
+```