Movatterモバイル変換


[0]ホーム

URL:


DINA_HO_RT_joint

library(hmcdm)

Load the spatial rotation data

N=length(Test_versions)J=nrow(Q_matrix)K=ncol(Q_matrix)L=nrow(Test_order)

(1) Simulate responses and response times based on the HMDCM modelwith response times (no covariance between speed and learningability)

ETAs<-ETAmat(K, J, Q_matrix)class_0<-sample(1:2^K, N,replace = L)Alphas_0<-matrix(0,N,K)mu_thetatau=c(0,0)Sig_thetatau=rbind(c(1.8^2,.4*.5*1.8),c(.4*.5*1.8,.25))Z=matrix(rnorm(N*2),N,2)thetatau_true= Z%*%chol(Sig_thetatau)thetas_true= thetatau_true[,1]taus_true= thetatau_true[,2]G_version=3phi_true=0.8for(iin1:N){  Alphas_0[i,]<-inv_bijectionvector(K,(class_0[i]-1))}lambdas_true<-c(-2, .4, .055)# empirical from Wang 2017Alphas<-sim_alphas(model="HO_joint",lambdas=lambdas_true,thetas=thetas_true,Q_matrix=Q_matrix,Design_array=Design_array)table(rowSums(Alphas[,,5])-rowSums(Alphas[,,1]))# used to see how much transition has taken place#>#>   0   1   2   3   4#>  64  58  84 107  37itempars_true<-matrix(runif(J*2,.1,.2),ncol=2)RT_itempars_true<-matrix(NA,nrow=J,ncol=2)RT_itempars_true[,2]<-rnorm(J,3.45,.5)RT_itempars_true[,1]<-runif(J,1.5,2)Y_sim<-sim_hmcdm(model="DINA",Alphas,Q_matrix,Design_array,itempars=itempars_true)L_sim<-sim_RT(Alphas,Q_matrix,Design_array,                  RT_itempars_true,taus_true,phi_true,G_version)

(2) Run the MCMC to sample parameters from the posteriordistribution

output_HMDCM_RT_joint=hmcdm(Y_sim,Q_matrix,"DINA_HO_RT_joint",Design_array,100,30,Latency_array = L_sim,G_version = G_version,theta_propose =2,deltas_propose =c(.45,.25,.06))#> 0output_HMDCM_RT_joint#>#> Model: DINA_HO_RT_joint#>#> Sample Size: 350#> Number of Items:#> Number of Time Points:#>#> Chain Length: 100, burn-in: 50summary(output_HMDCM_RT_joint)#>#> Model: DINA_HO_RT_joint#>#> Item Parameters:#>  ss_EAP  gs_EAP#>  0.1727 0.08984#>  0.1816 0.17441#>  0.1579 0.11196#>  0.1180 0.16100#>  0.1086 0.12128#>    ... 45 more items#>#> Transition Parameters:#>    lambdas_EAP#> λ0     -1.9333#> λ1      0.1473#> λ2      0.1668#>#> Class Probabilities:#>      pis_EAP#> 0000  0.1683#> 0001  0.1329#> 0010  0.1479#> 0011  0.2828#> 0100  0.1229#>    ... 11 more classes#>#> Deviance Information Criterion (DIC): 158101#>#> Posterior Predictive P-value (PPP):#> M1:   0.5#> M2:  0.49#> total scores:  0.6265a<-summary(output_HMDCM_RT_joint)a#>#> Model: DINA_HO_RT_joint#>#> Item Parameters:#>  ss_EAP  gs_EAP#>  0.1727 0.08984#>  0.1816 0.17441#>  0.1579 0.11196#>  0.1180 0.16100#>  0.1086 0.12128#>    ... 45 more items#>#> Transition Parameters:#>    lambdas_EAP#> λ0     -1.9333#> λ1      0.1473#> λ2      0.1668#>#> Class Probabilities:#>      pis_EAP#> 0000  0.1683#> 0001  0.1329#> 0010  0.1479#> 0011  0.2828#> 0100  0.1229#>    ... 11 more classes#>#> Deviance Information Criterion (DIC): 158101#>#> Posterior Predictive P-value (PPP):#> M1: 0.5008#> M2:  0.49#> total scores:  0.6284a$ss_EAP#>             [,1]#>  [1,] 0.17269201#>  [2,] 0.18155850#>  [3,] 0.15793767#>  [4,] 0.11800202#>  [5,] 0.10859240#>  [6,] 0.18435075#>  [7,] 0.13729573#>  [8,] 0.09056036#>  [9,] 0.14026537#> [10,] 0.10935337#> [11,] 0.10923594#> [12,] 0.18604417#> [13,] 0.17070529#> [14,] 0.09539927#> [15,] 0.10884538#> [16,] 0.15417946#> [17,] 0.18275347#> [18,] 0.17545294#> [19,] 0.24954013#> [20,] 0.13180079#> [21,] 0.12408538#> [22,] 0.20856378#> [23,] 0.13759198#> [24,] 0.22857160#> [25,] 0.18071116#> [26,] 0.23041432#> [27,] 0.16984212#> [28,] 0.20469014#> [29,] 0.17311793#> [30,] 0.17487781#> [31,] 0.14947353#> [32,] 0.12124006#> [33,] 0.24027107#> [34,] 0.13190875#> [35,] 0.17088618#> [36,] 0.10801057#> [37,] 0.25565457#> [38,] 0.12657494#> [39,] 0.19016467#> [40,] 0.14297617#> [41,] 0.12272135#> [42,] 0.15629315#> [43,] 0.22920419#> [44,] 0.24783945#> [45,] 0.21246526#> [46,] 0.14814914#> [47,] 0.28445936#> [48,] 0.22325116#> [49,] 0.15027183#> [50,] 0.16661440head(a$ss_EAP)#>           [,1]#> [1,] 0.1726920#> [2,] 0.1815585#> [3,] 0.1579377#> [4,] 0.1180020#> [5,] 0.1085924#> [6,] 0.1843508

(3) Check for parameter estimation accuracy

(cor_thetas<-cor(thetas_true,a$thetas_EAP))#>           [,1]#> [1,] 0.7914858(cor_taus<-cor(taus_true,a$response_times_coefficients$taus_EAP))#>           [,1]#> [1,] 0.9869964(cor_ss<-cor(as.vector(itempars_true[,1]),a$ss_EAP))#>           [,1]#> [1,] 0.7527781(cor_gs<-cor(as.vector(itempars_true[,2]),a$gs_EAP))#>           [,1]#> [1,] 0.7282395AAR_vec<-numeric(L)for(tin1:L){  AAR_vec[t]<-mean(Alphas[,,t]==a$Alphas_est[,,t])}AAR_vec#> [1] 0.9271429 0.9321429 0.9571429 0.9635714 0.9628571PAR_vec<-numeric(L)for(tin1:L){  PAR_vec[t]<-mean(rowSums((Alphas[,,t]-a$Alphas_est[,,t])^2)==0)}PAR_vec#> [1] 0.7257143 0.7600000 0.8342857 0.8657143 0.8685714

(4) Evaluate the fit of the model to the observed response andresponse times data (here, Y_sim and R_sim)

a$DIC#>              Transition Response_Time Response    Joint    Total#> D_bar          1959.319      137004.6 14607.29 3549.689 157120.9#> D(theta_bar)   1704.693      136565.8 14429.81 3440.395 156140.7#> DIC            2213.944      137443.3 14784.77 3658.983 158101.0head(a$PPP_total_scores)#>      [,1] [,2] [,3] [,4] [,5]#> [1,] 0.96 0.66 0.80 0.12 0.22#> [2,] 0.20 0.38 0.08 0.84 0.92#> [3,] 0.82 0.88 0.32 0.64 0.86#> [4,] 0.76 0.04 0.96 0.40 0.74#> [5,] 1.00 0.70 0.32 0.78 0.34#> [6,] 0.34 0.40 0.78 0.78 0.70head(a$PPP_total_RTs)#>      [,1] [,2] [,3] [,4] [,5]#> [1,] 0.32 0.56 0.86 0.12 0.20#> [2,] 0.56 0.84 0.18 0.90 0.02#> [3,] 0.24 0.46 0.64 0.46 0.78#> [4,] 0.42 0.64 0.52 0.78 0.28#> [5,] 0.80 0.26 0.56 0.52 0.66#> [6,] 0.82 0.00 0.08 0.88 0.32head(a$PPP_item_means)#> [1] 0.56 0.60 0.48 0.44 0.48 0.44head(a$PPP_item_mean_RTs)#> [1] 0.22 0.52 0.48 0.68 0.14 0.36head(a$PPP_item_ORs)#>      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]#> [1,]   NA 0.94 0.92 0.18 0.94 0.38 0.82 0.70 0.64  0.98  0.48  0.84  0.34  0.36#> [2,]   NA   NA 0.82 0.60 0.82 0.92 0.90 0.68 0.54  0.78  0.40  0.28  0.42  0.96#> [3,]   NA   NA   NA 0.66 0.62 0.42 0.60 0.72 0.78  0.24  0.80  0.82  0.80  0.98#> [4,]   NA   NA   NA   NA 0.48 0.06 0.16 0.16 0.76  0.16  0.66  0.28  0.90  0.82#> [5,]   NA   NA   NA   NA   NA 0.30 0.54 0.62 0.46  0.34  0.84  0.36  0.88  0.52#> [6,]   NA   NA   NA   NA   NA   NA 0.88 0.62 0.58  0.50  0.10  0.78  0.20  0.70#>      [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26]#> [1,]  0.72  0.34  0.90  0.02  0.42  0.04  0.86  0.92  0.70  0.94  0.32  0.48#> [2,]  0.92  0.90  0.42  0.90  1.00  0.96  0.88  0.92  0.54  0.88  0.62  0.52#> [3,]  0.84  0.08  0.66  0.56  0.98  0.38  0.12  0.18  0.58  0.46  0.34  0.38#> [4,]  0.02  0.18  0.32  0.30  0.40  0.28  0.46  0.50  0.20  0.34  0.44  0.34#> [5,]  0.76  0.50  0.92  0.90  0.84  0.60  0.50  0.98  0.44  0.96  0.46  0.98#> [6,]  0.30  0.54  0.90  0.72  0.84  0.62  0.10  0.78  0.12  0.76  0.02  0.50#>      [,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38]#> [1,]  0.10  0.34  0.58  0.76  0.12  0.66  0.80  0.72  0.94  0.78  0.46  0.94#> [2,]  0.14  0.78  0.64  0.90  0.46  0.88  0.94  0.92  0.80  0.74  0.90  0.82#> [3,]  0.84  0.46  0.08  0.68  0.06  0.24  0.36  0.62  0.14  0.60  0.38  0.14#> [4,]  0.46  0.36  0.48  0.36  0.74  0.34  0.56  0.92  0.58  0.30  0.24  0.26#> [5,]  0.28  0.24  0.32  0.82  0.40  0.64  0.72  0.72  0.66  0.78  0.62  0.32#> [6,]  0.02  0.16  0.32  0.48  0.42  0.84  0.66  0.40  0.40  0.54  0.08  0.32#>      [,39] [,40] [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48] [,49] [,50]#> [1,]  0.80  0.28  0.50  0.70  0.48  0.80  0.82  0.90  0.84  0.80  0.88  0.52#> [2,]  0.70  0.76  0.86  0.42  0.30  0.94  0.62  0.76  0.98  0.90  0.78  0.76#> [3,]  0.50  0.20  0.88  0.56  0.82  0.06  0.78  0.70  0.28  0.68  0.38  0.06#> [4,]  0.88  0.18  0.36  0.92  0.42  0.94  0.98  0.42  0.80  0.06  0.56  0.12#> [5,]  0.88  0.26  0.56  0.80  0.24  0.18  0.74  0.26  0.44  0.84  0.64  0.44#> [6,]  0.18  0.22  0.76  0.12  0.22  0.46  0.52  0.78  0.24  0.34  0.52  0.44

[8]ページ先頭

©2009-2025 Movatter.jp