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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
library(tidyverse)
library(caret)
library(MLeval)
library(pROC)
source("./data_prep.R")
# load("./modelling_results.RData")
load("modelling_results_withrrlda.RData")
second_visit_donors <- mike_wide[["donor_id"]]
second_visit_donors
second_visits <- c()
results <- results
data_list <- sets_partitions
donor_list <- list()
feature_list <- list()
count = 1
for (set in data_list) {
donors <- c(set[["train"]][["donor_id"]], set[['test']][['donor_id']])
features <- names(set[["train"]])
donor_list[[count]] <- donors
feature_list[[count]] <- features
second_visits <- c(second_visits, length(intersect(donors, second_visit_donors)))
count = count + 1
}
second_visits
donor_list <- donor_list[c(14, 16, 19)]
feature_list <- feature_list[c(14, 16, 19)]
donor_intersect <- intersection(donor_list[[1]], donor_list[[2]], donor_list[[3]])
n_donor_intersect <- length(donor_intersect)
feature_intersect1 <- intersection(feature_list[[1]], feature_list[[2]])
n_feature_intersect1 <- length(feature_intersect1)
# which(second_visits > 15)
# which.max(second_visits)
# dataset14_rrlda_eval <- evalm(results[["rrlda"]][[14]])
# dataset14_nb_eval <- evalm(results[["naive_bayes"]][[14]])
# dataset14_rf_eval <- evalm(results[["rf"]][[14]])
# dataset14_reglog_eval <- evalm(results[["regLogistic"]][[14]])
#
# dataset16_rrlda_eval <- evalm(results[["rrlda"]][[16]])
# dataset16_nb_eval <- evalm(results[["naive_bayes"]][[16]])
# dataset16_rf_eval <- evalm(results[["rf"]][[16]])
# dataset16_reglog_eval <- evalm(results[["regLogistic"]][[16]])
#
# dataset19_rrlda_eval <- evalm(results[["rrlda"]][[19]])
# dataset19_nb_eval <- evalm(results[["naive_bayes"]][[19]])
# dataset19_rf_eval <- evalm(results[["rf"]][[19]])
# dataset19_reglog_eval <- evalm(results[["regLogistic"]][[19]])
dataset1_rrlda_eval <- evalm(results[["rrlda"]][[1]])
dataset1_nb_eval <- evalm(results[["naive_bayes"]][[1]])
dataset1_rf_eval <- evalm(results[["rf"]][[1]])
dataset1_reglog_eval <- evalm(results[["regLogistic"]][[1]])
dataset2_rrlda_eval <- evalm(results[["rrlda"]][[2]])
dataset2_nb_eval <- evalm(results[["naive_bayes"]][[2]])
dataset2_rf_eval <- evalm(results[["rf"]][[2]])
dataset2_reglog_eval <- evalm(results[["regLogistic"]][[2]])
dataset3_rrlda_eval <- evalm(results[["rrlda"]][[3]])
dataset3_nb_eval <- evalm(results[["naive_bayes"]][[3]])
dataset3_rf_eval <- evalm(results[["rf"]][[3]])
dataset3_reglog_eval <- evalm(results[["regLogistic"]][[3]])
get_test_auc <- function(dataset, model) {
used_datasets <- c(14,16,19)
test_data <- data_list[[used_datasets[dataset]]][["test"]]
print(test_data)
model_res <- results[[model]][[dataset]]
preds <- predict(model_res, newdata = test_data[-c(1, 2)])
preds <- as.numeric(preds)
auc_score <- auc(roc(
response = test_data[["outcome"]],
predictor = preds,
ret = c("roc")
))
round(as.numeric(auc_score), 2)
}
d1_rrlda_met <- as_tibble(dataset1_rrlda_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "rrlda")
d1_nb_met <- as_tibble(dataset1_nb_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "nb")
d1_rf_met <- as_tibble(dataset1_rf_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "rf")
d1_reglog_met <- as_tibble(dataset1_reglog_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "reglog")
d1_met <- bind_rows(list(d1_rrlda_met, d1_nb_met, d1_rf_met, d1_reglog_met)) %>%
mutate(
`Score (CI)` = paste(Score, "(", CI, ")")
) %>%
pivot_wider(
id_cols = model,
values_from = Score,
names_from = Metric
) %>%
mutate(
`test_AUC` = c(
get_test_auc(1, "rrlda"),
get_test_auc(1, "naive_bayes"),
get_test_auc(1, "rf"),
get_test_auc(1, "regLogistic")
)
) %>%
select(-`AUC-PRG`, -`AUC-PR`, -Informedness) %>%
kable(format = "latex", booktabs = TRUE)
d1_met
d2_rrlda_met <- as_tibble(dataset2_rrlda_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "rrlda")
d2_nb_met <- as_tibble(dataset2_nb_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "nb")
d2_rf_met <- as_tibble(dataset2_rf_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "rf")
d2_reglog_met <- as_tibble(dataset2_reglog_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "reglog")
d2_met <- bind_rows(list(d2_rrlda_met, d2_nb_met, d2_rf_met, d2_reglog_met)) %>%
mutate(
`Score (CI)` = paste(Score, "(", CI, ")")
) %>%
pivot_wider(
id_cols = model,
values_from = Score,
names_from = Metric
) %>%
mutate(
`test_AUC` = c(
get_test_auc(2, "rrlda"),
get_test_auc(2, "naive_bayes"),
get_test_auc(2, "rf"),
get_test_auc(2, "regLogistic")
)
) %>%
select(-`AUC-PRG`, -`AUC-PR`, -Informedness) %>%
kable(format = "latex", booktabs = TRUE)
d2_met
d3_rrlda_met <- as_tibble(dataset3_rrlda_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "rrlda")
d3_nb_met <- as_tibble(dataset3_nb_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "nb")
d3_rf_met <- as_tibble(dataset3_rf_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "rf")
d3_reglog_met <- as_tibble(dataset3_reglog_eval$stdres$`Group 1`, rownames = "Metric") %>%
mutate(model = "reglog")
d3_met <- bind_rows(list(d3_rrlda_met, d3_nb_met, d3_rf_met, d3_reglog_met)) %>%
mutate(
`Score (CI)` = paste(Score, "(", CI, ")")
) %>%
pivot_wider(
id_cols = model,
values_from = Score,
names_from = Metric
) %>%
mutate(
`test_AUC` = c(
get_test_auc(3, "rrlda"),
get_test_auc(3, "naive_bayes"),
get_test_auc(3, "rf"),
get_test_auc(3, "regLogistic")
)
) %>%
select(-`AUC-PRG`, -`AUC-PR`, -Informedness) %>%
kable(format = "latex", booktabs = TRUE)
d3_met
|
