Closed ylinglw closed 7 years ago
I added a constraint to the upper limit of the latent space to prevent scores greater than the upper threshold designed to approximate 1, (1 - 1e-7). This constraint is applied to all variables, including continuous variables. The resulting latent space is still quite large so I don't imagine it will result in a ceiling effect.
marginal <- data.frame(matrix(c("theta",1.00000000,NA, "ST04Q01",0.49276818,1.0, "ST11Q01",0.95037688,1.0, "ST11Q02",0.81483928,1.0, "ST11Q03",0.64111245,1.0, "ST11Q04",0.62722772,1.0), nrow=6, byrow=T)) marginal$X2 <- as.numeric(as.character(marginal$X2)) marginal$X3 <- as.numeric(as.character(marginal$X3)) cat_pr <- lapply(as.list(1:dim(as.data.frame(marginal[,-1]))[1]), function(x) as.data.frame(marginal)[,-1][x[1],]) cat_pr <- lapply(cat_pr, function (x) x[!is.na(x)])
q <- data.frame(matrix(c(1.000000000,0.002597179,0.00992501,0.007369647,-0.010599803,0.027392192, 0.002597179,1.000000000,0.02797594,-0.012449477,0.007422285,0.018967963, 0.009925010,0.027975939,1.00000000,0.113199950,0.132064861,0.136868184, 0.007369647,-0.012449477,0.11319995,1.000000000,0.156948690,0.137731346, -0.010599803,0.007422285,0.13206486,0.156948690,1.000000000,0.002082482, 0.027392192,0.018967963,0.13686818,0.137731346,0.002082482,1.000000000), nrow=6, byrow=T)) set.seed(28196)
surv1 <- questionnaire(n = 300, cat_prop = cat_pr, cor_matrix = q) #generate questionnaire data
freq1 <- lapply(surv1[-c(1,2)], table) freq1
if (!require("plyr")) install.packages("plyr") library(plyr) freq1 <- plyr::ldply(freq1, rbind) freq1
####################################################################### #######################################################################