## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----Specify_1----------------------------------------------------------------
library(CLCM)
N <- 200
number.timepoints <- 1
item.type <- rep('Ordinal', 6) 
categories.j <- rep(4, 6)
J <- length(item.type)
item.names <- paste0('Item_', 1:J)

## ----Specify_2, echo = FALSE--------------------------------------------------
K <- 2
alpha <- vector()
for(k in K:1){
  tmp <- vector()
  base <- rbind( matrix(0, nrow=2^(K-k), ncol=1), matrix(1, nrow=2^(K-k), ncol=1) )
  base <- rep(base, 2^(k-1) )
  alpha <- cbind(alpha,base)
}
alpha <- cbind(alpha, rowSums(alpha))
alpha <- alpha[(order(alpha[,(K+1)])),]
alpha <- alpha[ ,-(K+1)]
alpha <- as.matrix(alpha)
colnames(alpha) <- paste0('Factor_', 1:K)
rownames(alpha) <- paste0('Latent_Class_', 1:nrow(alpha))
alpha

## ----Specify_4, echo = FALSE--------------------------------------------------
Q <- matrix(c(rep(c(1,0), J/2), rep(c(0, 1), J/2)), nrow = J, ncol = K, byrow = TRUE)
rownames(Q) <- item.names
colnames(Q) <- paste0('Factor_', 1:K)
Q

## ----Specify_5, echo = FALSE--------------------------------------------------
eta <- alpha %*% t(Q)
eta <- ifelse(eta == matrix(1,2^K,1) %*% colSums(t(Q)),1, 0 )
eta

## ----Specify_6, echo = FALSE--------------------------------------------------
eta[ , 1, drop = FALSE ]

## ----Specify_7, echo = FALSE--------------------------------------------------
Q[ 1, , drop = FALSE ]
alpha

## ----Specify_8----------------------------------------------------------------
lc.prop <- list('Time_1' = rep(1/2^K, 2^K)) 
lc.prop

## ----Simulate-----------------------------------------------------------------

set.seed(03062021)
X <- simulate_clcm(N = N, Q = Q, number.timepoints = number.timepoints, 
                   item.type = item.type, 
                   categories.j = categories.j, 
                   lc.prop = lc.prop)
apply(X$item.responses, 2, table)                
apply(X$item.responses, 2, function(x) prop.table(table(x)))                
prop.table(table(apply(X$post, 1, which.max)))


## ----Estimate-----------------------------------------------------------------
mod1 <- clcm(dat = X$dat, max.diff = 0.001,
             item.type = X$item.type, 
             item.names = X$item.names, 
             Q = X$Q) 


## ----Estimate_2---------------------------------------------------------------
Q_2 <- matrix(1, nrow = J, ncol = 1)
mod2 <- clcm(dat = X$dat, max.diff = 0.001,
             item.type = X$item.type, 
             item.names = X$item.names, 
             Q = Q_2) 


## ----Model Fit_1, eval = FALSE------------------------------------------------
# mod.fit1 <- C2_clcm(mod1)
# mod.fit2 <- C2_clcm(mod2)

## ----Model Fit_2--------------------------------------------------------------
    mod.fit.rel.1 <- aic_bic_clcm(mod1)
    mod.fit.rel.2 <- aic_bic_clcm(mod2)
    unlist(mod.fit.rel.1)
    unlist(mod.fit.rel.2)


## ----Compare------------------------------------------------------------------
      lca.hat <- mod1$dat$lca 
      lca.true <- mod1$dat$true_lca      
      table(lca.true == lca.hat)
      prop.table(table(lca.true == lca.hat))
      xtabs( ~ lca.true + lca.hat)