Introduction to flagr package

1. MIRT model(with normal prior)

We use the mirt function in the mirt package to fit a simulated data.

rm(list = ls())
library(flagr)
library(mirt)

# This data is generated from mirt model with multinormal prior(J=30,K=3,N=10000)
load("~/Github/flagr-github/flagr/Medium-scale-poscor.RData")
cmodel <- mirt.model('F1=1-10,
                     F2=11-20,
                     F3=21-30,
COV = F1*F2*F3')
system.time(result_bi <- mirt(response, cmodel,method = "EM"))
theta_est <- fscores(result_bi)

2. confirmatory low-rank Ising model

In this section, we show how to use

cMIRT(Y, Q, A0 = NA, b0 = NA, Sigma0 = NA, print_proc = T, accuracy = NA, min_step = 5, max_step = 1000)

function in our package to model a simulated data, be noted that our model uses a different prior as usual mirt model uses multivariate normal prior, we’ll show a example code and give a comparison between our function and mirt function.

# We use the previous data generated from mirt model
Q <- A>0
K <- ncol(A)
system.time(result22 <- confirmIRT22(A0, b0, Sigma0, response, Q, accuracy = .1))
# calculate the posterior mean of theta
theta_est22 <- t(result22$Sigma%*%t(result22$A)%*%t(response))

#calculate Kendall's tau correlation between two estimated posterior mean of theta
for(i in 1:K){
  cat(cor(theta_est[,i],theta_est22[,i],method = "kendall"),"\n")
}


# Another example, in this example, response data is simulated multivariate IRT model with our spcial prior
# J=60, K=3, N=10000

rm(list = ls())
load("~/Github/flagr-github/flagr/confirmIsing_exam.RData")

system.time(result22 <- confirmIRT22(A0, b0, Sigma0, response, Q, accuracy = 3))
# calculate the posterior mean of theta
theta_est22 <- t(result22$Sigma%*%t(result22$A)%*%t(response))


cmodel <- mirt.model('F1=1-10,
                     F2=11-20,
                     F3=21-30,
COV = F1*F2*F3')
system.time(result_bi <- mirt(response, cmodel,method = "EM"))
system.time(result_bi <- mirt(response, cmodel,method = "MHRM"))


# Third example, data is simulated from mirt model with multivariate normal prior(J=30,K=3,)

2.1 confirmatory low-rank Ising model with covariates

In out flagr package, we use function

confirmIRT_cov <- function(A0, b0, beta0, response, Z, Q, print_proc = T, accuracy = 1, min_step = 5, max_step = 1000)

to estimate confrimatory low-rank Ising model with covariates.

beta0 is the initial value of coefficient, Z is a matrix for covariates.

3. exploratory low-rank Ising model

In our flagr package, we use function

explorIRT(A0, b0, response, print_proc = T, accuracy = 0.01, min_step = 5, max_step = 1000)

to estimate parameters, the following is an example:

rm(list = ls())

# This data is generated from mirt model with our special prior(J=20,K=2,N=1000)
load("~/Github/flagr-github/flagr/explorIsing_exam.RData")
system.time(result <- explorIRT(A0, rep(0,J), response, accuracy = 0.01))

One advantage of our package is that we can handle large scale parameters estimating problem in a fast speed like the following one:

rm(list = ls())

#This data is generated from mirt model with our prior(J=100,K=5,N=1000)
load("~/Github/flagr-github/flagr/explorIsing_exam2.RData")

system.time(result <- explorIRT(A0, b0, response, accuracy = 1))

# Even we start from a far initial value
system.time(result <- explorIRT(A0, rep(0,J), response, accuracy = 1))

Our package can also handle the exploratory low-rank Ising model with covariates information, we illustrate the usage of

explorIRT_cov <- function(A0, b0, beta0, response, Z, print_proc = T, accuracy = 1, min_step = 5, max_step = 1000)

by the following example:

J = 20;
N = 1000;
K = 2;

x <- 0.5;
A <- matrix(0, J, K);
A[1:10, 1] <- x;
A[11:20,2] <- x;
S <- matrix(0, J, J);
diag(S) <- -2.5;
Sigma <- matrix(c(1,0,0,1),2)
Z <- matrix(rnorm(N), N, 1)
beta <- matrix(c(rep(0,J/2),rep(1,J/2)),1,J)

system.time(response1 <- sample_flag_cpp1(A, S, beta, Z, N, burn = 200))
beta_n <- nrow(beta)
A0 <- matrix(0, J, K);
A0[1:10, 1] <- x + rnorm(10);
A0[11:20,2] <- x + rnorm(10);
b0 <- rep(0, J)
beta0 <- matrix(0,beta_n,J)

system.time(result1 <- explorIRT_cov(A0, b0, beta0, response1, Z, accuracy = 0.01))

We can give variance estimation by the following command:

result.var <- IRT.var(result1, response1, Z)
result.sd <- sqrt(diag(result.var))

4. confirmatory FLaG model

We can use function

confirmFLaG <- function(A0, S0, Sigma0, Q, gamma, response, stepA = 5, stepS = 5, stepB = 5, discA = 0.5, discS = 0.5, discB = 0.5, tol = 1e-7, print_proc = T)

to model data using confirmatory FLaG model

rm(list = ls())
# This data is generated from FLaG model(J=20,K=2,N=10000)
load("~/Github/flagr-github/flagr/confirmFLaG_exam1.RData")
result22 <- confirmFLaG(A0, S0, diag(2), Q, gamma, response)

Specificly, if the support of graph is known, we can add the information supp as a parameter of the function

confirmFLaG_supp <- function(A0, S0, Sigma0, Q, supp, response, stepA = 1, stepS = 1, stepB = 1, discA = 0.5, discS = 0.5, discB = 0.5, tol = 1e-7, print_proc = T)

to make the estimation more accurate.

result_supp22<- confirmFLaG_supp(A0, S0, diag(2), Q, supp, response,tol = 1e-7)

5. exploratory FLaG model

We can use function

ADMM5(L0, S0, response, delta, gamma, lambda = 5, tol = 1e-5)

to model data using exploratory FLaG model, see the following example:

J = 20;
N = 1000;
K = 2;

x <- 0.5;
A <- matrix(0, J, K);
A[1:10, 1] <- x;
A[11:20,2] <- x;
L <- A%*% t(A);

S <- matrix(0, J, J);
for(i in seq(1, J-1, by = 2)){
  S[i,i+1] <- 1;
  S[i+1,i] <- 1;
}
diag(S) <- -3.5;
system.time(response <- sample_flag_cpp(A, S, N, burn = 200))
colMeans(response)
L0 = matrix(0, J, J);
S0 = matrix(0, J, J);

delta = 0.06;
gamma = 0.03;
system.time(result <- ADMM5(L0, S0, response, delta, gamma))
result_A <- loadings(result)
varimax(result_A)[["loadings"]][[1]]