information_psychometrics

library(TestGardener)
convert<-function(resp) {
    n<-ncol(resp)
    N<-nrow(resp)
    for (i in 1:ncol(resp)) {
        vals<-sample(2:4,N,replace=TRUE)
        resp[,i]<-ifelse(resp[,i]==1,resp[,i],vals)
    }
    optList <- list()
    grbg <- matrix(0,n,1)
    for (item in 1:n) {
        nn <- 4
        scorei <- rep(0,nn)
        scorei[1] <- 1
        optList[[item]] <- scorei
    grbg[item] <- length(scorei)
    }
    key<-rep(1,n)
    optList <- list(itemLab=NULL, optLab=NULL, optScr=optList)
    dl<-make.dataList(resp,key,optList=optList)
    dl
}
## arclen<-function(dl) {
##     indfine       <- seq(0,100,len=101)
##     WfdList       <- dl$WfdList
##     theta         <- dl$theta
##     Qvec          <- dl$Qvec
##     binctr        <- dl$binctr
##     arclenList    <- theta2arclen(theta, Qvec, WfdList, binctr)
##     names(arclenList)
##     arclength    <- arclenList$arclength
##     arclengthvec <- arclenList$arclengthvec
##     ArcLength.plot(arclength, arclengthvec)
## }
## scoreden<-function(dl) {
##     WfdList <- dl$WfdList
##     theta <- dl$theta
##     Qvec <- dl$Qvec
##     # plot the density for the score indices within interval c(0,100)
##     theta_int <- theta[0 < theta & theta < 100]
##     scoreDensity(theta_int)
## }
pca<-function(dl) {
    indfine       <- seq(0,100,len=101)
    WfdList       <- dl$WfdList
    theta         <- dl$theta
    Qvec          <- dl$Qvec
    binctr        <- dl$binctr
    arc    <- theta2arclen(theta, Qvec, WfdList, binctr)$arclength
    #  plot a two-dimension version of manifold curve
    WfdList    <- dl$WfdList
    #theta      <- dl$theta
    zz<-Wpca.plot(arc, WfdList, dl$Wdim,Display=TRUE)
    zz$harmvarmxfd$coefs
}

##rasch model
out<-list()
for (ii in 1:5) {
    th<-rnorm(1000)
    b<-rnorm(25)
    k<-outer(th,b,"-")
    p<-1/(1+exp(-k))
    resp<-list()
    for (i in 1:ncol(p)) resp[[i]]<-rbinom(nrow(p),1,p[,i])
    resp<-do.call("cbind",resp)
    xx<-convert(resp)
    ##arclen(xx)
    #scoreden(xx)
    out[[ii]]<-pca(xx)
}
rasch<-out


##high guessing param
out<-list()
for (ii in 1:5) {
    th<-rnorm(1000)
    b<-rnorm(25)
    k<-outer(th,b,"-")
    p<-.25+(1-.25)*1/(1+exp(-k))
    resp<-list()
    for (i in 1:ncol(p)) resp[[i]]<-rbinom(nrow(p),1,p[,i])
    resp<-do.call("cbind",resp)
    xx<-convert(resp)
    ##arclen(xx)
    #scoreden(xx)
    out[[ii]]<-pca(xx)
}
irt3<-out


##two factor
library(MASS)
out<-list()
for (ii in 1:5) {
    th<-mvrnorm(1000,c(0,0),Sigma=matrix(c(1,0,0,1),2,2))
    b<-rnorm(25)
    b<-sort(b)
    a<-c(rep(1,10),rep(0,15))
    th[,1]<-th[,1]*a
    a<-abs(1-a)
    th[,2]<-th[,2]*a
    k<-outer(rowSums(th),b,"-")
    p<-.25+(1-.25)*1/(1+exp(-k))
    resp<-list()
    for (i in 1:ncol(p)) resp[[i]]<-rbinom(nrow(p),1,p[,i])
    resp<-do.call("cbind",resp)
    xx<-convert(resp)
    ##arclen(xx)
    #scoreden(xx)
    out[[ii]]<-pca(xx)
}
f2<-out

ran<-do.call("rbind",c(f2,rasch,irt3))
xl<-range(ran[,1])
yl<-range(ran[,2])
plot(NULL,xlim=xl,ylim=yl)
for (i in 1:length(rasch)) lines(rasch[[i]])
for (i in 1:length(irt3)) lines(irt3[[i]],col='blue')
for (i in 1:length(f2)) lines(f2[[i]],col='red')