/
renew.R
120 lines (119 loc) · 5.92 KB
/
renew.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
renew_ScorzAqol6Adol <- function(x,
label_ds_1L_lgl = T,
type_1L_chr = "score"){
y <- x@a_YouthvarsProfile@a_Ready4useDyad
y <- renew(y, type_1L_chr = "unlabel")
if(type_1L_chr == "score"){
if(identical(x@scrg_dss_ls,list(list()))){
x@scrg_dss_ls <- make_aqol6d_scrg_dss()
}
select_chr <- setdiff(names(y@ds_tb),
x@instrument_dict_r3$var_nm_chr[!x@instrument_dict_r3$var_nm_chr %>%
startsWith(x@itm_prefix_1L_chr)] %>%
as.vector())
y@ds_tb <- y@ds_tb %>%
dplyr::select(tidyselect::all_of(select_chr))
y@ds_tb <- add_adol6d_scores(y@ds_tb, # Make an enhanceSlot method - then generalise renew mthd to parent class
aqol6d_scrg_dss_ls = x@scrg_dss_ls,
prefix_1L_chr = x@itm_prefix_1L_chr,
id_var_nm_1L_chr = x@a_YouthvarsProfile@id_var_nm_1L_chr,
total_aqol_var_nm_1L_chr = x@total_unwtd_var_nm_1L_chr,
wtd_aqol_var_nm_1L_chr = x@total_wtd_var_nm_1L_chr)
y@dictionary_r3 <- ready4use::renew.ready4use_dictionary(y@dictionary_r3,
new_cases_r3 = x@instrument_dict_r3)
}
if(label_ds_1L_lgl)
y <- renew(y)
if(type_1L_chr == "score"){
x@a_YouthvarsProfile@a_Ready4useDyad <- y
}
return(x)
}
renew_ScorzEuroQol5 <- function(x,
label_ds_1L_lgl = T,
type_1L_chr = "score"){
y <- x@a_YouthvarsProfile@a_Ready4useDyad
y <- renew(y, type_1L_chr = "unlabel")
if(type_1L_chr == "score"){
y@ds_tb <- y@ds_tb %>%
dplyr::rename_with(~c("MO","SC","UA","PD","AD"),
x@itm_var_nms_chr) %>%
dplyr::mutate(`:=`(!!rlang::sym(x@total_wtd_var_nm_1L_chr),
eq5d::eq5d(.,
country = x@country_1L_chr,
version = x@instrument_version_1L_chr,
type = x@type_1L_chr))) %>%
dplyr::rename_with(~x@itm_var_nms_chr,
c("MO","SC","UA","PD","AD")) %>%
dplyr::mutate(`:=`(!!rlang::sym(x@total_unwtd_var_nm_1L_chr),
rowSums(dplyr::across(x@itm_var_nms_chr)))) %>%
dplyr::filter(!is.na(!!rlang::sym(x@total_unwtd_var_nm_1L_chr)))
instrument_dict_r3 <- x@instrument_dict_r3
instrument_dict_r3$var_nm_chr <- c(x@itm_var_nms_chr,
x@total_unwtd_var_nm_1L_chr,
x@total_wtd_var_nm_1L_chr)
y@dictionary_r3 <- ready4::renew(y@dictionary_r3,
new_cases_r3 = instrument_dict_r3)
}
if(label_ds_1L_lgl)
y <- renew(y)
if(type_1L_chr == "score"){
x@a_YouthvarsProfile@a_Ready4useDyad <- y
}
return(x)
}
renew_ScorzProfile <- function(x,
drop_msng_1L_lgl = F,
item_type_1L_chr = "numeric",
scoring_fn = identity,
scorz_args_ls = NULL,
label_ds_1L_lgl = T,
type_1L_chr = "score"){
if(type_1L_chr %in% c("score","score-c","score-w")){
if(type_1L_chr == "score"){
x <- renew(x,
scoring_fn = scoring_fn,
scorz_args_ls = scorz_args_ls,
label_ds_1L_lgl = label_ds_1L_lgl,
type_1L_chr = "score-w") %>%
renew(label_ds_1L_lgl = label_ds_1L_lgl, type_1L_chr = "score-c")
}
if(type_1L_chr %in% c("score-c","score-w")){
y <- x@a_YouthvarsProfile@a_Ready4useDyad
y <- renew(y, type_1L_chr = "unlabel")
}
if(type_1L_chr == "score-c"){
y@ds_tb <- y@ds_tb %>%
dplyr::mutate(`:=`(!!rlang::sym(x@total_unwtd_var_nm_1L_chr),
rowSums(dplyr::select(.,dplyr::starts_with(x@itm_prefix_1L_chr)))))
if(drop_msng_1L_lgl)
y@ds_tb <- y@ds_tb %>%
dplyr::filter(!is.na(!!rlang::sym(x@total_unwtd_var_nm_1L_chr)))
if(!x@total_unwtd_var_nm_1L_chr %in% x@instrument_dict_r3$var_nm_chr){
x@instrument_dict_r3 <- ready4use::renew.ready4use_dictionary(x@instrument_dict_r3,
var_nm_chr = x@total_unwtd_var_nm_1L_chr,
var_ctg_chr = "multi-attribute utility instrument unweighted total score",
var_desc_chr = paste0(x@instrument_nm_1L_chr, " (unweighted total)"),
var_type_chr = item_type_1L_chr)
}
}
if(type_1L_chr == "score-w"){
y@ds_tb <- rlang::exec(scoring_fn, y@ds_tb, !!!scorz_args_ls)
if(!x@total_wtd_var_nm_1L_chr %in% x@instrument_dict_r3$var_nm_chr){
x@instrument_dict_r3 <- ready4use::renew.ready4use_dictionary(x@instrument_dict_r3,
var_nm_chr = x@total_wtd_var_nm_1L_chr,
var_ctg_chr = "health utility",
var_desc_chr = paste0(x@instrument_nm_1L_chr, " total score"),
var_type_chr = item_type_1L_chr)
}
}
}
if(type_1L_chr %in% c("score-c","score-w")){
y@dictionary_r3 <- ready4use::renew.ready4use_dictionary(y@dictionary_r3,
new_cases_r3 = x@instrument_dict_r3)
if(label_ds_1L_lgl)
y <- renew(y)
x@a_YouthvarsProfile@a_Ready4useDyad <- y
}
return(x)
}