|
|
|
|
stop("Models RSM and GRSM cannot be used for unequal numbers of response categories!")
|
|
|
|
|
}
|
|
|
|
|
design_list <- design_GPCMlasso(formula = formula, data = data,
|
|
|
|
|
Y = Y, RSM = RSM, GPCM = GPCM, DSF = DSF, all.dummies = control$all.dummies,
|
|
|
|
|
main.effects = main.effects)
|
|
|
|
|
if (design_list$m == 0) {
|
|
|
|
|
control$lambda <- 0
|
|
|
|
|
control$adaptive <- FALSE
|
|
|
|
|
cv <- FALSE
|
|
|
|
|
}
|
|
|
|
|
if (length(control$lambda) == 1) {
|
|
|
|
|
cv <- FALSE
|
|
|
|
|
}
|
|
|
|
|
loglik_fun <- loglikPCMlasso
|
|
|
|
|
score_fun <- scorePCMlasso
|
|
|
|
|
log_score_fun <- loglikscorePCMlasso2
|
|
|
|
|
if (all(k == 2)) {
|
|
|
|
|
loglik_fun <- loglikDIFlasso
|
|
|
|
|
score_fun <- scoreDIFlasso
|
|
|
|
|
log_score_fun <- loglikscoreDIFlasso2
|
|
|
|
|
}
|
|
|
|
|
fit <- fit_GPCMlasso(model = model, loglik_fun = loglik_fun, acoefs2 = acoefs2,
|
|
|
|
|
score_fun = score_fun, log_score_fun, design_list = design_list,
|
|
|
|
|
control = control, start = NULL, scale_fac = 1, main.effects = main.effects)
|
|
|
|
|
if (is.null(control$lambda)) {
|
|
|
|
|
control$lambda <- fit$lambda
|
|
|
|
|
}
|
|
|
|
|
coefficients <- fit$coefficients
|
|
|
|
|
coef.rescal <- fit$coef.rescal
|
|
|
|
|
logLik <- fit$logLik
|
|
|
|
|
df <- fit$df
|
|
|
|
|
BIC <- -2 * logLik + log(design_list$n) * df
|
|
|
|
|
AIC <- -2 * logLik + 2 * df
|
|
|
|
|
cAIC <- -2 * logLik + 2 * df + 2 * df * (df - 1)/(design_list$n -
|
|
|
|
|
df - 1)
|
|
|
|
|
if (cv) {
|
|
|
|
|
cv_error <- fit_cv_GPCMlasso(model, design_list, control,
|
|
|
|
|
score_fun, loglik_fun, log_score_fun, Y)
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
cv_error <- NULL
|
|
|
|
|
}
|
|
|
|
|
ret.list <- list(coefficients = coefficients, logLik = logLik,
|
|
|
|
|
cv_error = cv_error, call = match.call(), model = model,
|
|
|
|
|
data = data, control = control, DSF = DSF, formula = formula,
|
|
|
|
|
item.names = item.names, Y = Y, design_list = design_list,
|
|
|
|
|
AIC = AIC, BIC = BIC, cAIC = cAIC, df = df, coef.rescal = coef.rescal,
|
|
|
|
|
main.effects = main.effects)
|
|
|
|
|
class(ret.list) <- "GPCMlasso"
|
|
|
|
|
return(ret.list)
|
|
|
|
|
}
|
|
|
|
|
GPCMlasso2 <- function (formula, data, DSF = FALSE, model = c("PCM", "RSM",
|
|
|
|
|
"GPCM", "GRSM", "RM", "2PL"), control = ctrl_GPCMlasso(),
|
|
|
|
|
cv = FALSE, main.effects = TRUE,acoefs2=NULL)
|
|
|
|
|
{
|
|
|
|
|
if (!is.data.frame(data))
|
|
|
|
|
stop("data has to be a data.frame!")
|
|
|
|
|
Y <- model.response(model.frame(formula, data = data))
|
|
|
|
|
for (i in 1:ncol(Y)) {
|
|
|
|
|
Y[, i] <- as.factor(Y[, i])
|
|
|
|
|
}
|
|
|
|
|
item.names <- colnames(Y)
|
|
|
|
|
model <- match.arg(model)
|
|
|
|
|
RSM <- GPCM <- FALSE
|
|
|
|
|
if (model %in% c("GRSM", "RSM")) {
|
|
|
|
|
RSM <- TRUE
|
|
|
|
|
}
|
|
|
|
|
if (model %in% c("GRSM", "GPCM", "2PL")) {
|
|
|
|
|
GPCM <- TRUE
|
|
|
|
|
}
|
|
|
|
|
k <- apply(Y, 2, function(x) {
|
|
|
|
|
length(levels(as.factor(x)))
|
|
|
|
|
})
|
|
|
|
|
if (all(k == 2) | model %in% c("RM", "2PL")) {
|
|
|
|
|
DSF <- FALSE
|
|
|
|
|
control$cv.crit <- "deviance"
|
|
|
|
|
}
|
|
|
|
|
if (length(unique(k)) > 1 & RSM) {
|
|
|
|
|
stop("Models RSM and GRSM cannot be used for unequal numbers of response categories!")
|
|
|
|
|
}
|
|
|
|
|
design_list <- design_GPCMlasso(formula = formula, data = data,
|
|
|
|
|
Y = Y, RSM = RSM, GPCM = GPCM, DSF = DSF, all.dummies = control$all.dummies,
|
|
|
|
|
main.effects = main.effects)
|
|
|
|
|
if (design_list$m == 0) {
|
|
|
|
|
control$lambda <- 0
|
|
|
|
|
control$adaptive <- FALSE
|
|
|
|
|
cv <- FALSE
|
|
|
|
|
}
|
|
|
|
|
if (length(control$lambda) == 1) {
|
|
|
|
|
cv <- FALSE
|
|
|
|
|
}
|
|
|
|
|
loglik_fun <- loglikPCMlasso
|
|
|
|
|
score_fun <- scorePCMlasso
|
|
|
|
|
log_score_fun <- loglikscorePCMlasso2
|
|
|
|
|
if (all(k == 2)) {
|
|
|
|
|
loglik_fun <- loglikDIFlasso
|
|
|
|
|
score_fun <- scoreDIFlasso
|
|
|
|
|
log_score_fun <- loglikscoreDIFlasso2
|
|
|
|
|
}
|
|
|
|
|
fit <- fit_GPCMlasso(model = model, loglik_fun = loglik_fun, acoefs2 = acoefs2,
|
|
|
|
|
score_fun = score_fun, log_score_fun, design_list = design_list,
|
|
|
|
|
control = control, start = NULL, scale_fac = 1, main.effects = main.effects)
|
|
|
|
|
if (is.null(control$lambda)) {
|
|
|
|
|
control$lambda <- fit$lambda
|
|
|
|
|
}
|
|
|
|
|
coefficients <- fit$coefficients
|
|
|
|
|
coef.rescal <- fit$coef.rescal
|
|
|
|
|
logLik <- fit$logLik
|
|
|
|
|
df <- fit$df
|
|
|
|
|
BIC <- -2 * logLik + log(design_list$n) * df
|
|
|
|
|
AIC <- -2 * logLik + 2 * df
|
|
|
|
|
cAIC <- -2 * logLik + 2 * df + 2 * df * (df - 1)/(design_list$n -
|
|
|
|
|
df - 1)
|
|
|
|
|
if (cv) {
|
|
|
|
|
cv_error <- fit_cv_GPCMlasso(model, design_list, control,
|
|
|
|
|
score_fun, loglik_fun, log_score_fun, Y)
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
cv_error <- NULL
|
|
|
|
|
}
|
|
|
|
|
ret.list <- list(coefficients = coefficients, logLik = logLik,
|
|
|
|
|
cv_error = cv_error, call = match.call(), model = model,
|
|
|
|
|
data = data, control = control, DSF = DSF, formula = formula,
|
|
|
|
|
item.names = item.names, Y = Y, design_list = design_list,
|
|
|
|
|
AIC = AIC, BIC = BIC, cAIC = cAIC, df = df, coef.rescal = coef.rescal,
|
|
|
|
|
main.effects = main.effects)
|
|
|
|
|
class(ret.list) <- "GPCMlasso"
|
|
|
|
|
return(ret.list)
|
|
|
|
|
}
|
|
|
|
|
GPCMlasso2(formula = cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control=ctrl_GPCMlasso(lambda=0.0000000000001),acoefs2 = u)
|
|
|
|
|
u
|
|
|
|
|
## create responses for acat from ordinal values
|
|
|
|
|
createResponse <- function(Y){
|
|
|
|
|
Y <- as.factor(Y)
|
|
|
|
|
model.matrix(~0+Y)[,-length(levels(Y))]
|
|
|
|
|
}
|
|
|
|
|
design_GPCMlasso <- function(formula = formula, Y=Y, data = data, RSM = RSM,
|
|
|
|
|
GPCM = GPCM, DSF = DSF, all.dummies = TRUE, main.effects = main.effects){
|
|
|
|
|
## extract covariates
|
|
|
|
|
if(all.dummies){
|
|
|
|
|
term.labels <- attr(terms(formula), "term.labels")
|
|
|
|
|
X <- matrix(rep(1,nrow(data)))
|
|
|
|
|
for(ij in 1:length(term.labels)){
|
|
|
|
|
x.now <- data[,term.labels[ij], drop = FALSE]
|
|
|
|
|
if(is.factor(x.now[,1])){
|
|
|
|
|
if(nlevels(x.now[,1])==2){
|
|
|
|
|
X <- cbind(X,model.matrix(~.,data=x.now)[,-1,drop=FALSE])
|
|
|
|
|
}else{
|
|
|
|
|
X <- cbind(X,model.matrix(~0+.,data=x.now))
|
|
|
|
|
}
|
|
|
|
|
}else{
|
|
|
|
|
X <- cbind(X,model.matrix(~.,data=x.now)[,-1,drop=FALSE])
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
X <- X[,-1,drop = FALSE]
|
|
|
|
|
}else{
|
|
|
|
|
X <- model.matrix(formula, data = data)
|
|
|
|
|
if(ncol(X)>=1){
|
|
|
|
|
if(colnames(X)[1]=="(Intercept)"){
|
|
|
|
|
X <- X[,-1,drop = FALSE]
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
x.names <- colnames(X)
|
|
|
|
|
## factorize response vector
|
|
|
|
|
## initialize basic parameters
|
|
|
|
|
k <- apply(Y, 2, function(x){length(levels(as.factor(x)))})
|
|
|
|
|
q <- k-1
|
|
|
|
|
n <- nrow(Y)
|
|
|
|
|
I <- ncol(Y)
|
|
|
|
|
m <- ncol(X)
|
|
|
|
|
n_sigma <- 1
|
|
|
|
|
if(GPCM){
|
|
|
|
|
n_sigma <- I
|
|
|
|
|
}
|
|
|
|
|
## get final response vector
|
|
|
|
|
if(all(q==1)){
|
|
|
|
|
response <- as.numeric(as.factor(c(t(Y))))-1
|
|
|
|
|
}else{
|
|
|
|
|
response <- lapply(as.data.frame(Y),createResponse)
|
|
|
|
|
response <- c(t(do.call("cbind",response)))
|
|
|
|
|
}
|
|
|
|
|
## total number of parameters to be optimized
|
|
|
|
|
px <- sum(q)+n_sigma
|
|
|
|
|
if(RSM){
|
|
|
|
|
px <- q[1]+I+n_sigma-1
|
|
|
|
|
}
|
|
|
|
|
## scale X and save standard deviations for re-scaling
|
|
|
|
|
# X <- scale(X, center = FALSE)
|
|
|
|
|
X <- scale(X, center = FALSE, scale = apply(X, 2, sd, na.rm = TRUE))
|
|
|
|
|
sd.vec <- attributes(X)$scale
|
|
|
|
|
sd.vec <- create.sd.vec(sd.vec, DSF, px, n_sigma, I, q, main.effects)
|
|
|
|
|
## create design matrix for basic item parameters
|
|
|
|
|
if(!RSM){
|
|
|
|
|
design <- -diag(px-n_sigma)
|
|
|
|
|
}else{
|
|
|
|
|
design <- -cbind(matrix(rep(diag(I),each=q[1]),ncol=I),
|
|
|
|
|
matrix(rep(diag(q[1]),I),ncol=q[1],byrow = TRUE))[,-(I+1)]
|
|
|
|
|
}
|
|
|
|
|
## create design matrix for covariate part
|
|
|
|
|
if(m>=1){
|
|
|
|
|
designX <- -get_designX(X, DSF, m, I, q, n)
|
|
|
|
|
## create penalization matrix
|
|
|
|
|
acoefs <- get_acoefs(RSM, DSF, m, I, q, n_sigma)
|
|
|
|
|
## update number of parameters to be optimized
|
|
|
|
|
px <- px + ncol(designX)
|
|
|
|
|
}else{
|
|
|
|
|
## dummy matrix in case no covariates are specified
|
|
|
|
|
designX <- matrix(0,0,0)
|
|
|
|
|
acoefs <- matrix(0,nrow=px,ncol=1)
|
|
|
|
|
}
|
|
|
|
|
if(main.effects){
|
|
|
|
|
design.main <- matrix(rep(X, each = sum(q)),ncol = ncol(X))
|
|
|
|
|
designX <- cbind(design.main, designX)
|
|
|
|
|
acoefs <- rbind(matrix(0, ncol = ncol(acoefs), nrow = ncol(design.main)), acoefs)
|
|
|
|
|
px <- px + ncol(X)
|
|
|
|
|
}
|
|
|
|
|
ret.list <- list(q = q, I = I, m = m, px = px, n = n, response = response,
|
|
|
|
|
design = design, designX = designX, sd.vec = sd.vec,
|
|
|
|
|
acoefs = acoefs, n_sigma = n_sigma, x.names = x.names,
|
|
|
|
|
RSM = RSM, GPCM = GPCM, Y = Y, DSF = DSF)
|
|
|
|
|
return(ret.list)
|
|
|
|
|
}
|
|
|
|
|
create.sd.vec <- function(sd.vec, DSF, px, n_sigma, I, q, main.effects){
|
|
|
|
|
if(DSF){
|
|
|
|
|
new_vec <- rep(sd.vec, sum(q))
|
|
|
|
|
}else{
|
|
|
|
|
new_vec <- rep(sd.vec, I)
|
|
|
|
|
}
|
|
|
|
|
if(main.effects){
|
|
|
|
|
new_vec <- c(sd.vec, new_vec)
|
|
|
|
|
}
|
|
|
|
|
new_vec <- c(rep(1,px-n_sigma),new_vec,rep(1,n_sigma))
|
|
|
|
|
new_vec
|
|
|
|
|
}
|
|
|
|
|
GPCMlasso2(formula = cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control=ctrl_GPCMlasso(lambda=0.0000000000001),acoefs2 = u)
|
|
|
|
|
get_designX <- function(X, DSF, m, I, q, n){
|
|
|
|
|
if(!DSF){
|
|
|
|
|
designX <- matrix(0, ncol = m * I, nrow = n * sum(q))
|
|
|
|
|
pos_u <- 1
|
|
|
|
|
for (u in 1:n) {
|
|
|
|
|
for(uu in 1:I){
|
|
|
|
|
designX[pos_u:(pos_u+q[uu]-1), ((uu - 1) * m + 1):(uu * m)] <-
|
|
|
|
|
matrix(rep(X[u,], q[uu]), byrow = TRUE, ncol = m, nrow = q[uu])
|
|
|
|
|
pos_u <- pos_u+q[uu]
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}else{
|
|
|
|
|
designX <- matrix(0, ncol = m * sum(q), nrow = n * sum(q))
|
|
|
|
|
pos_u <- 1
|
|
|
|
|
for (u in 1:n) {
|
|
|
|
|
pos_uu <- 1
|
|
|
|
|
for(uu in 1:I){
|
|
|
|
|
for(uuu in 1:q[uu]){
|
|
|
|
|
designX[pos_u, pos_uu:(pos_uu+m-1)] <-
|
|
|
|
|
X[u,]
|
|
|
|
|
pos_u <- pos_u+1
|
|
|
|
|
pos_uu <- pos_uu+m
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
return(designX)
|
|
|
|
|
}
|
|
|
|
|
get_acoefs_old <- function(RSM, DSF, m, I, q, n_sigma){
|
|
|
|
|
if(!DSF){
|
|
|
|
|
pen1 <- diag(m*I)
|
|
|
|
|
}else{
|
|
|
|
|
pen1 <- matrix(0,nrow=m*sum(q),ncol=m*sum(choose(q,2)))
|
|
|
|
|
pos1 <-1
|
|
|
|
|
pos_pos <- 1
|
|
|
|
|
for(u in 1:I){
|
|
|
|
|
n_comb <- choose(q[u],2)
|
|
|
|
|
if(n_comb>0){
|
|
|
|
|
combis <- combn(q[u],2)-1
|
|
|
|
|
for(uuu in 1:m){
|
|
|
|
|
for(uu in 1:n_comb){
|
|
|
|
|
pen1[combis[1,uu]*m+pos_pos,pos1] <- 1
|
|
|
|
|
pen1[combis[2,uu]*m+pos_pos,pos1] <- -1
|
|
|
|
|
pos1 <- pos1+1
|
|
|
|
|
}
|
|
|
|
|
pos_pos <- pos_pos+1
|
|
|
|
|
}
|
|
|
|
|
pos_pos <- pos_pos+(q[u]-1)*m
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
pen1 <- cbind(diag(m*sum(q)),pen1)
|
|
|
|
|
}
|
|
|
|
|
if(RSM){
|
|
|
|
|
acoefs <- rbind(matrix(0,nrow=q[1]+I-1,ncol=ncol(pen1)),pen1,
|
|
|
|
|
matrix(0, ncol = ncol(pen1), nrow = n_sigma))
|
|
|
|
|
}else{
|
|
|
|
|
acoefs <- rbind(matrix(0,nrow=sum(q),ncol=ncol(pen1)),pen1,
|
|
|
|
|
matrix(0, ncol = ncol(pen1), nrow = n_sigma))
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
get_acoefs <- function(RSM, DSF, m, I, q, n_sigma){
|
|
|
|
|
if(!DSF){
|
|
|
|
|
pen1 <- diag(m*I)
|
|
|
|
|
}else{
|
|
|
|
|
pen1 <- matrix(0,nrow=m*sum(q),ncol=m*sum(q-1))
|
|
|
|
|
pos1 <-1
|
|
|
|
|
pos_pos <- 1
|
|
|
|
|
for(u in 1:I){
|
|
|
|
|
n_comb <- q[u] - 1
|
|
|
|
|
if(n_comb>0){
|
|
|
|
|
combis <- rep(1:q[u], each = 2)
|
|
|
|
|
combis <- matrix(combis[-c(1,length(combis))]-1, nrow = 2)
|
|
|
|
|
for(uuu in 1:m){
|
|
|
|
|
for(uu in 1:n_comb){
|
|
|
|
|
pen1[combis[1,uu]*m+pos_pos,pos1] <- 1
|
|
|
|
|
pen1[combis[2,uu]*m+pos_pos,pos1] <- -1
|
|
|
|
|
pos1 <- pos1+1
|
|
|
|
|
}
|
|
|
|
|
pos_pos <- pos_pos+1
|
|
|
|
|
}
|
|
|
|
|
pos_pos <- pos_pos+(q[u]-1)*m
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
pen1 <- cbind(diag(m*sum(q)),pen1)
|
|
|
|
|
}
|
|
|
|
|
if(RSM){
|
|
|
|
|
acoefs <- rbind(matrix(0,nrow=q[1]+I-1,ncol=ncol(pen1)),pen1,
|
|
|
|
|
matrix(0, ncol = ncol(pen1), nrow = n_sigma))
|
|
|
|
|
}else{
|
|
|
|
|
acoefs <- rbind(matrix(0,nrow=sum(q),ncol=ncol(pen1)),pen1,
|
|
|
|
|
matrix(0, ncol = ncol(pen1), nrow = n_sigma))
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
GPCMlasso2(formula = cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control=ctrl_GPCMlasso(lambda=0.0000000000001),acoefs2 = u)
|
|
|
|
|
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
|
|
|
|
|
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
|
|
|
|
|
loglikPCMlasso <- function(alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac) {
|
|
|
|
|
.Call(`_GPCMlasso_loglikPCMlasso`, alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac)
|
|
|
|
|
}
|
|
|
|
|
scorePCMlasso <- function(alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac) {
|
|
|
|
|
.Call(`_GPCMlasso_scorePCMlasso`, alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac)
|
|
|
|
|
}
|
|
|
|
|
loglikDIFlasso <- function(alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac) {
|
|
|
|
|
.Call(`_GPCMlasso_loglikDIFlasso`, alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac)
|
|
|
|
|
}
|
|
|
|
|
scoreDIFlasso <- function(alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac) {
|
|
|
|
|
.Call(`_GPCMlasso_scoreDIFlasso`, alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac)
|
|
|
|
|
}
|
|
|
|
|
loglikscorePCMlasso <- function(alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac) {
|
|
|
|
|
.Call(`_GPCMlasso_loglikscorePCMlasso`, alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac)
|
|
|
|
|
}
|
|
|
|
|
loglikscoreDIFlasso <- function(alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac) {
|
|
|
|
|
.Call(`_GPCMlasso_loglikscoreDIFlasso`, alpha, Y, X, Z, Q, q, n, I, px, GHweights, GHnodes, acoefs, lambda, lambda2, cvalue, cores, weight, n_sigma, scale_fac)
|
|
|
|
|
}
|
|
|
|
|
GPCMlasso2(formula = cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control=ctrl_GPCMlasso(lambda=0.0000000000001),acoefs2 = u)
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
trace(GPCMlasso,edit=T)
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
View(GPCMlasso)
|
|
|
|
|
u
|
|
|
|
|
aaa
|
|
|
|
|
aaa <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Data/NoDIF/N',100,'/scenario_',"5A_100",'.csv'))
|
|
|
|
|
aaa <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N',100,'/scenario_',"5A_100",'.csv'))
|
|
|
|
|
aaaa <- aaa[aaa$replication==1,]
|
|
|
|
|
GPCMlasso(formula=cbind('item1','item2',"item3","item4")~TT,data=aaaa,model="PCM")
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM")
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001))
|
|
|
|
|
acc <- matrix(nrow = 10,ncol=4,0)
|
|
|
|
|
acc
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001),acoefs2 = acc)
|
|
|
|
|
acc[6,1]1
|
|
|
|
|
acc[6,1]<-1
|
|
|
|
|
acc
|
|
|
|
|
acc[7,2]<-1
|
|
|
|
|
acc[8,3]<-1
|
|
|
|
|
acc[9,4]<-1
|
|
|
|
|
acc
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001),acoefs2 = acc)
|
|
|
|
|
library(TAM)
|
|
|
|
|
tam.mml(resp=aaaa[,c('item1',"item2","item3","item4")],group=aaaa[,'TT'])
|
|
|
|
|
zzz <- tam.mml(resp=aaaa[,c('item1',"item2","item3","item4")],group=aaaa[,'TT'])
|
|
|
|
|
summary(zzz)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001),acoefs2 = acc)
|
|
|
|
|
acc <- matrix(nrow = 10,ncol=4,0)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001),acoefs2 = acc)
|
|
|
|
|
summary(zzz)
|
|
|
|
|
remove.packages(GPCMlasso)
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages("GPCMlasso")
|
|
|
|
|
install.packages("GPCMlasso")
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
View(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001))
|
|
|
|
|
tam.mml(resp=aaaa[,c('item1',"item2","item3","item4")],group=aaaa[,'TT'])
|
|
|
|
|
library(tam.mml)
|
|
|
|
|
library(TAM)
|
|
|
|
|
tam.mml(resp=aaaa[,c('item1',"item2","item3","item4")],group=aaaa[,'TT'])
|
|
|
|
|
tam.mml(resp=aaaa[,c('item1',"item2","item3","item4")],group=aaaa[,'TT'])
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.000000000000000000001))
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.000000000000000000001))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),acoefs=acc)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),acoefs2=acc)
|
|
|
|
|
View(GPCMlasso)
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
View(GPCMlasso)
|
|
|
|
|
aaa <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Data/NoDIF/N',100,'/scenario_',"5A_100",'.csv'))
|
|
|
|
|
aaa <- read.csv(paste0('/home/corentin/Documents/These/Recherche/Simulations/Data/DIF/N',100,'/scenario_',"5A_100",'.csv'))
|
|
|
|
|
aaaa <- aaa[aaa$replication==1,]
|
|
|
|
|
acc <- matrix(nrow = 10,ncol=4,0)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),acoefs2=acc)
|
|
|
|
|
acc[6,1] <- 1;acc[7,2] <- 1;acc[8,3] <- 1;acc[9,4] <- 1
|
|
|
|
|
acc
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),acoefs2=acc)
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 100))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 1000))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))$coefficients
|
|
|
|
|
install.packages("geoR")
|
|
|
|
|
library(geoR)
|
|
|
|
|
nlmP
|
|
|
|
|
nlmP()
|
|
|
|
|
.nlmP()
|
|
|
|
|
geoR::.nlmP
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001))$design_list
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = T)
|
|
|
|
|
summary(GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = T))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = T)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = F)
|
|
|
|
|
library(TAM)
|
|
|
|
|
tam.mml(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"],irtmodel="PCM2")
|
|
|
|
|
summary(tam.mml(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"],irtmodel="PCM2"))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = F)
|
|
|
|
|
summary(tam.mml(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"],irtmodel="PCM2"))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = F)
|
|
|
|
|
summary(tam.mml(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"],irtmodel="PCM2"))
|
|
|
|
|
summary(tam.jml(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"],irtmodel="PCM2"))
|
|
|
|
|
summary(tam.jml(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"]))
|
|
|
|
|
summary(tam(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"]))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000000000000000001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000000000000000000001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 10),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 1),DSF = F,cv=F)
|
|
|
|
|
summary(tam(resp = aaaa[,c("item1","item2","item3","item4")],group=aaaa[,"TT"]))
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 1),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.5),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.1),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.01),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00000001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.01),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.00000001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000001),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0.0000005),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)$design_list
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
remove.packages('GPCMlasso')
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)$design_list
|
|
|
|
|
remove.packages("PCMlasso")
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)$design_list
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)$design_list
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)$design_list
|
|
|
|
|
remove.packages("GPCMlasso")
|
|
|
|
|
install.packages('/home/corentin/Documents/These/Recherche/GPCMlasso_0.1-7.tar.gz')
|
|
|
|
|
library(GPCMlasso)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT:item1,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~I(TT:item1*0),data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT:item1*0,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
aaaa$item1tt <- 1-aaaa$item1
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT:item1tt,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
aaaa$item2tt <- 1-aaaa$item2
|
|
|
|
|
aaaa$item3tt <- 1-aaaa$item3
|
|
|
|
|
aaaa$item1
|
|
|
|
|
aaaa$item4tt <- 1-aaaa$item4
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT:item1tt+TT:item2TT+TT:item3tt+TT:item4tt,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT:item1tt+TT:item2tt+TT:item3tt+TT:item4tt,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT*item1tt,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
|
|
|
|
GPCMlasso(formula=cbind(item1,item2,item3,item4)~TT*item1tt+TT*item2tt+TT*item3tt+TT*item4tt,data=aaaa,model="PCM",control = ctrl_GPCMlasso(lambda = 0),DSF = F,cv=F)
|
