IBMR/example.R at main · keshav-motwani/IBMR · GitHub

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
library(IBMR)

set.seed(1)

p = 500
nonzero = 100
n = rep(500, 2)

category_mappings = simulate_category_mappings(2, 2, list(c(1, 2), c(2, 1)))

alpha = simulate_alpha(category_mappings$categories)
Beta = simulate_Beta(category_mappings$categories, p, nonzero)

X_star_list = simulate_X_star_list(n, p)
U_list = simulate_U_list(X_star_list, "int", 0.1)
X_list = compute_X_list(X_star_list, U_list)
Y_list = simulate_Y_list(category_mappings$categories, category_mappings$inverse_category_mappings, X_star_list, alpha, Beta)
Z_list = list(matrix(1, nrow = n[1]), matrix(1, nrow = n[2]))

X_star_list_val = simulate_X_star_list(n, p)
U_list_val = simulate_U_list(X_star_list_val, "int", 0.1)
X_list_val = compute_X_list(X_star_list_val, U_list_val)
Y_list_val = simulate_Y_list(category_mappings$categories, category_mappings$inverse_category_mappings, X_star_list_val, alpha, Beta)

X_list_test = simulate_X_star_list(10000, p)
Y_list_test = simulate_Y_list(category_mappings$categories, list(setNames(nm = category_mappings$categories)), X_list_test, alpha, Beta)

system.time({IBMR_fit = IBMR(Y_list = Y_list,
                             categories = category_mappings$categories,
                             category_mappings = category_mappings$category_mappings,
                             X_list = X_list,
                             Z_list = Z_list,
                             Y_list_validation = Y_list_val,
                             category_mappings_validation = category_mappings$category_mappings,
                             X_list_validation = X_list_val,
                             verbose = FALSE)})

system.time({IBMR_NG_fit = IBMR_no_Gamma(Y_list = Y_list,
                                         categories = category_mappings$categories,
                                         category_mappings = category_mappings$category_mappings,
                                         X_list = X_list,
                                         Y_list_validation = Y_list_val,
                                         category_mappings_validation = category_mappings$category_mappings,
                                         X_list_validation = X_list_val,
                                         verbose = FALSE)})

system.time({subset_fit = subset(Y_list = Y_list,
                                 categories = category_mappings$categories,
                                 category_mappings = category_mappings$category_mappings,
                                 X_list = X_list,
                                 Y_list_validation = Y_list_val,
                                 category_mappings_validation = category_mappings$category_mappings,
                                 X_list_validation = X_list_val,
                                 verbose = FALSE)})

system.time({relabel_fit = relabel(Y_list = Y_list,
                                   categories = category_mappings$categories,
                                   category_mappings = category_mappings$category_mappings,
                                   X_list = X_list,
                                   Y_list_validation = Y_list_val,
                                   category_mappings_validation = category_mappings$category_mappings,
                                   X_list_validation = X_list_val,
                                   verbose = FALSE)})

mean(Y_list_test[[1]] != predict_categories(predict_probabilities(IBMR_fit$best_model, X_list_test))[[1]])
mean(Y_list_test[[1]] != predict_categories(predict_probabilities(IBMR_NG_fit$best_model, X_list_test))[[1]])
mean(Y_list_test[[1]] != predict_categories(predict_probabilities(subset_fit$best_model, X_list_test))[[1]])
mean(Y_list_test[[1]] != predict_categories(predict_probabilities(relabel_fit$best_model, X_list_test))[[1]])