forked from saudiwin/idealstan
-
Notifications
You must be signed in to change notification settings - Fork 0
/
test_model_combine.R
95 lines (69 loc) · 3.44 KB
/
test_model_combine.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
# test new identification options
# March 19, 2019
require(idealstan)
require(dplyr)
require(ggplot2)
# to test this, we'll generate two different models then recombine
bin_irt_2pl_sim <- id_sim_gen(num_person=10,num_bills=100,
model_type="ordinal_ratingscale",inflate=F,
diff_sd=1,
reg_discrim_sd = 1,
absence_discrim_sd = 1)
norm_irt_2pl_sim <- id_sim_gen(num_person=10,num_bills=100,ordinal=F,inflate=F,
model_type="normal",
diff_sd=1,
reg_discrim_sd = 1,
absence_discrim_sd = 1)
# combine objects
comb_obj <- bin_irt_2pl_sim
comb_obj@simul_data$true_person <- (comb_obj@simul_data$true_person +
norm_irt_2pl_sim@simul_data$true_person)/2
norm_irt_2pl_sim@score_matrix$item_id <- factor(as.numeric(norm_irt_2pl_sim@score_matrix$item_id) +
max(as.numeric(bin_irt_2pl_sim@score_matrix$item_id)))
comb_obj@score_matrix <- bind_rows(comb_obj@score_matrix,
norm_irt_2pl_sim@score_matrix)
comb_obj@score_matrix <-mutate(comb_obj@score_matrix,model_id=c(rep(3,nrow(bin_irt_2pl_sim@score_matrix)),
rep(9,nrow(norm_irt_2pl_sim@score_matrix))))
# create combined data object
comb_obj_tostan <- id_make(comb_obj@score_matrix,
miss_val = c(NA,NA))
# run a pretend model
est_comb_obj <- id_estimate(comb_obj_tostan,id_refresh = 100)
# now run a real model with real data
require(haven)
require(tidyr)
hb_data <- read_dta("~/idalstan_compare/data/baldwin_huber/apsrfinaldata.dta") %>%
slice(1:46) %>%
select(country,ccode,pg,ELF_fearon_std,betweenstd,cultfrac_std,GIstd,gini_net_std,geo_iso_std,lngdpstd,
popstd,polity2std,afrobarom,wvs,cses,cses_wvs,ELF_ethnic,polity2,between_afrorev) %>%
gather(key="item_id",value="value",-country,-ccode,-pg) %>%
filter(!is.na(value))
# now assign models
hb_data <- mutate(hb_data,model_id=recode(item_id,
ELF_fearon_std=9,
betweenstd=9,
cultfrac_std=9,
GIstd=9,
gini_net_std=9,
geo_iso_std=9,
lngdpstd=9,
popstd=9,
polity2std=9,
afrobarom=1,
wvs=1,
cses=1,
cses_wvs=1,
ELF_ethnic=9,
polity2=11,
between_afrorev=9),
outcome_cont=ifelse(model_id==1,NA,value),
outcome_disc=ifelse(model_id==1,value,NA))
# make idealstan object
hb_idealdata <- id_make(hb_data,person_id = "country",person_cov = ~pg)
# run idealstan model!
hb_fit <- id_estimate(hb_idealdata,restrict_ind_high="betweenstd",
restrict_ind_low="polity2",
const_type="items",id_refresh = 100,
fixtype="fixed")
id_plot_cov(hb_fit)
# look at discrimination scores