The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.

rRUM_indept

library(hmcdm)

Load the spatial rotation data

N = dim(Design_array)[1]
J = nrow(Q_matrix)
K = ncol(Q_matrix)
L = dim(Design_array)[3]

(1) Simulate responses and response times based on the rRUM model

tau <- numeric(K)
for(k in 1:K){
  tau[k] <- runif(1,.2,.6)
}
R = matrix(0,K,K)
# Initial alphas
p_mastery <- c(.5,.5,.4,.4)
Alphas_0 <- matrix(0,N,K)
for(i in 1:N){
  for(k in 1:K){
    prereqs <- which(R[k,]==1)
    if(length(prereqs)==0){
      Alphas_0[i,k] <- rbinom(1,1,p_mastery[k])
    }
    if(length(prereqs)>0){
      Alphas_0[i,k] <- prod(Alphas_0[i,prereqs])*rbinom(1,1,p_mastery)
    }
  }
}
Alphas <- sim_alphas(model="indept",taus=tau,N=N,L=L,R=R,alpha0=Alphas_0)
table(rowSums(Alphas[,,5]) - rowSums(Alphas[,,1])) # used to see how much transition has taken place
#> 
#>   0   1   2   3   4 
#>  33  89 139  79  10
Smats <- matrix(runif(J*K,.1,.3),c(J,K))
Gmats <- matrix(runif(J*K,.1,.3),c(J,K))
# Simulate rRUM parameters
r_stars <- Gmats / (1-Smats)
pi_stars <- apply((1-Smats)^Q_matrix, 1, prod)

Y_sim <- sim_hmcdm(model="rRUM",Alphas,Q_matrix,Design_array,
                   r_stars=r_stars,pi_stars=pi_stars)

(2) Run the MCMC to sample parameters from the posterior distribution

output_rRUM_indept = hmcdm(Y_sim,Q_matrix,"rRUM_indept",Design_array,
                           100,30,R = R)
#> 0
output_rRUM_indept
#> 
#> Model: rRUM_indept 
#> 
#> Sample Size: 350
#> Number of Items: 
#> Number of Time Points: 
#> 
#> Chain Length: 100, burn-in: 50
summary(output_rRUM_indept)
#> 
#> Model: rRUM_indept 
#> 
#> Item Parameters:
#>  r_stars1_EAP r_stars2_EAP r_stars3_EAP r_stars4_EAP pi_stars_EAP
#>        0.2781       0.6792       0.6201       0.6436       0.8204
#>        0.5422       0.1011       0.6665       0.6236       0.8176
#>        0.6219       0.6512       0.5843       0.2000       0.8191
#>        0.6711       0.5022       0.1893       0.5535       0.7830
#>        0.1142       0.2764       0.5600       0.6678       0.6988
#>    ... 45 more items
#> 
#> Transition Parameters:
#>    taus_EAP
#> τ1   0.6025
#> τ2   0.2616
#> τ3   0.3540
#> τ4   0.4458
#> 
#> Class Probabilities:
#>      pis_EAP
#> 0000 0.07538
#> 0001 0.10249
#> 0010 0.04019
#> 0011 0.05713
#> 0100 0.13001
#>    ... 11 more classes
#> 
#> Deviance Information Criterion (DIC): 22366.34 
#> 
#> Posterior Predictive P-value (PPP):
#> M1: 0.494
#> M2:  0.49
#> total scores:  0.6145
a <- summary(output_rRUM_indept)
head(a$r_stars_EAP)
#>           [,1]      [,2]      [,3]      [,4]
#> [1,] 0.2781204 0.6791891 0.6201037 0.6435526
#> [2,] 0.5421509 0.1010740 0.6664536 0.6235942
#> [3,] 0.6218539 0.6512051 0.5842794 0.2000476
#> [4,] 0.6710642 0.5021942 0.1893288 0.5534743
#> [5,] 0.1141753 0.2763554 0.5600443 0.6678219
#> [6,] 0.5029857 0.3006291 0.2997223 0.5265600

(3) Check for parameter estimation accuracy

(cor_pistars <- cor(as.vector(pi_stars),as.vector(a$pi_stars_EAP)))
#> [1] 0.963348
(cor_rstars <- cor(as.vector(r_stars*Q_matrix),as.vector(a$r_stars_EAP*Q_matrix)))
#> [1] 0.9309798

AAR_vec <- numeric(L)
for(t in 1:L){
  AAR_vec[t] <- mean(Alphas[,,t]==a$Alphas_est[,,t])
}
AAR_vec
#> [1] 0.8457143 0.9042857 0.9285714 0.9521429 0.9664286

PAR_vec <- numeric(L)
for(t in 1:L){
  PAR_vec[t] <- mean(rowSums((Alphas[,,t]-a$Alphas_est[,,t])^2)==0)
}
PAR_vec
#> [1] 0.5200000 0.6857143 0.7600000 0.8400000 0.8828571

(4) Evaluate the fit of the model to the observed response

a$DIC
#>              Transition Response_Time Response    Joint    Total
#> D_bar          2103.685            NA 17736.25 1876.355 21716.29
#> D(theta_bar)   2032.666            NA 17178.03 1855.554 21066.25
#> DIC            2174.703            NA 18294.48 1897.156 22366.34
head(a$PPP_total_scores)
#>      [,1] [,2] [,3] [,4] [,5]
#> [1,] 1.00 0.84 0.02 0.14 0.16
#> [2,] 0.46 0.74 0.74 0.40 1.00
#> [3,] 0.40 0.48 0.96 0.84 0.78
#> [4,] 0.90 0.90 0.60 0.90 0.98
#> [5,] 0.58 0.34 0.86 0.46 0.68
#> [6,] 0.90 0.58 0.78 0.38 0.78
head(a$PPP_item_means)
#> [1] 0.38 0.56 0.56 0.54 0.60 0.66
head(a$PPP_item_ORs)
#>      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
#> [1,]   NA 0.62 0.72 0.26 0.52 0.70 0.84 0.58 0.14  0.62  0.66  0.84  0.68  0.10
#> [2,]   NA   NA 0.66 0.76 0.98 0.56 0.76 0.08 0.38  0.82  0.18  0.76  0.20  0.78
#> [3,]   NA   NA   NA 1.00 0.48 0.98 0.50 0.92 0.64  0.86  0.88  0.76  0.70  0.78
#> [4,]   NA   NA   NA   NA 0.26 0.46 0.56 0.62 0.50  0.26  0.38  0.84  0.22  0.02
#> [5,]   NA   NA   NA   NA   NA 0.40 0.94 0.32 0.00  0.98  0.16  0.68  0.20  0.14
#> [6,]   NA   NA   NA   NA   NA   NA 0.52 0.92 0.50  0.62  0.84  0.74  0.66  0.38
#>      [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26]
#> [1,]  0.22  0.54  0.14  0.32  0.32  0.28  0.52  0.16  0.86  0.64  0.80  0.20
#> [2,]  0.70  0.98  0.92  0.70  0.60  0.56  0.42  0.26  0.28  0.94  0.46  0.44
#> [3,]  0.92  0.98  0.32  0.76  0.82  0.94  0.28  0.50  0.70  0.94  0.28  0.82
#> [4,]  0.38  0.30  0.26  0.18  0.60  0.88  0.98  0.66  0.30  0.62  0.72  0.50
#> [5,]  0.10  0.18  0.40  0.52  0.12  0.16  0.74  0.38  0.46  0.80  0.54  0.38
#> [6,]  0.10  0.10  0.92  0.34  0.54  0.82  0.92  0.70  0.32  0.64  0.60  0.46
#>      [,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34] [,35]     [,36] [,37]
#> [1,]  0.00  0.14  0.02  0.14  0.54  0.20  0.62  0.36  0.46 0.2448980  0.72
#> [2,]  0.62  0.26  0.22  0.78  0.10  0.62  0.90  0.12  0.40 0.9387755  0.28
#> [3,]  0.66  0.08  0.76  0.70  0.62  1.00  0.68  0.32  0.84 1.0000000  0.80
#> [4,]  0.88  0.12  0.98  0.24  0.86  0.44  0.24  0.00  0.62 0.5102041  1.00
#> [5,]  0.54  0.78  0.62  0.60  0.34  0.82  0.36  0.02  0.36 0.5714286  0.80
#> [6,]  0.22  0.82  0.28  0.68  0.56  0.80  0.36  0.26  0.78 0.4081633  0.82
#>      [,38] [,39] [,40] [,41] [,42] [,43] [,44] [,45] [,46] [,47] [,48] [,49]
#> [1,]  0.48  0.78  0.50  0.94  0.42  0.70  0.72  0.72  0.34  0.28  0.46  0.02
#> [2,]  0.80  0.08  0.46  0.50  0.74  0.10  0.14  0.16  0.64  0.74  0.94  0.52
#> [3,]  0.90  0.56  0.88  0.42  0.96  0.28  0.76  0.36  0.86  0.34  0.10  0.50
#> [4,]  0.48  0.68  0.98  0.86  0.32  0.74  0.60  0.98  0.82  0.56  0.36  0.62
#> [5,]  0.44  0.44  0.96  0.34  0.42  0.36  0.16  0.58  0.56  0.14  0.84  0.86
#> [6,]  0.74  0.54  0.86  0.64  0.10  0.44  0.68  0.98  0.12  0.36  0.78  0.96
#>      [,50]
#> [1,]  0.84
#> [2,]  0.18
#> [3,]  0.46
#> [4,]  0.24
#> [5,]  0.54
#> [6,]  0.38

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.