[r-cran-erm] 08/33: Import Upstream version 0.12-2.3
Andreas Tille
tille at debian.org
Mon Dec 12 11:19:33 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-erm.
commit a922e3f4b3bc6fcf4ee52ffb7668ef8ee8435a40
Author: Andreas Tille <tille at debian.org>
Date: Mon Dec 12 11:20:01 2016 +0100
Import Upstream version 0.12-2.3
---
DESCRIPTION | 54 +++++-----
NAMESPACE | 1 +
NEWS | 34 ++++++
R/LRtest.Rm.R | 15 ++-
R/MLoef.R | 15 +--
R/cmlprep.R | 50 +++++----
R/datcheck.R | 4 +-
R/fitcml.R | 100 ++++++++---------
R/invalid.R | 13 +++
R/itemfit.ppar.r | 14 ++-
R/likLR.R | 2 +-
R/personfit.ppar.R | 13 ++-
R/pifit.internal.r | 7 +-
R/plotPImap.R | 40 ++++---
R/plotPWmap.R | 228 +++++++++++++++++++++++++++++++++++++++
R/print.ifit.R | 4 +-
R/print.pfit.R | 4 +-
inst/doc/Rplots.pdf | 119 +++++++++-----------
inst/doc/{eRmvig.R => eRm.R} | 0
inst/doc/{eRmvig.Rnw => eRm.Rnw} | 0
inst/doc/{eRmvig.pdf => eRm.pdf} | Bin 433168 -> 433229 bytes
man/LRtest.Rd | 1 +
man/MLoef.Rd | 5 +-
man/eRm-package.Rd | 17 +--
man/plotPImap.Rd | 13 ++-
man/plotPWmap.Rd | 106 ++++++++++++++++++
src/eRm.dll | Bin 0 -> 5632 bytes
27 files changed, 643 insertions(+), 216 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index ff263e2..4a4d44c 100755
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,28 +1,26 @@
-Package: eRm
-Type: Package
-Title: Extended Rasch Modeling.
-Version: 0.12-0
-Date: 2010-04-07
-Author: Patrick Mair, Reinhold Hatzinger, Marco Maier
-Maintainer: Patrick Mair <patrick.mair at wu.ac.at>
-Description: eRm fits Rasch models (RM), linear logistic test models
- (LLTM), rating scale model (RSM), linear rating scale models
- (LRSM), partial credit models (PCM), and linear partial credit
- models (LPCM). Missing values are allowed in the data matrix.
- Additional features are the ML estimation of the person
- parameters, Andersen's LR-test, item-specific Wald test,
- Martin-L�f-Test, nonparametric Monte-Carlo Tests, itemfit and
- personfit statistics including infit and outfit measures,
- various ICC and related plots, automated stepwise item
- elimination, simulation module for various binary data
- matrices. An eRm platform is provided at R-forge (see URL).
-License: GPL
-Encoding: latin1
-URL: http://r-forge.r-project.org/projects/erm/
-Imports: graphics, stats, MASS, methods
-Depends: R (>= 2.9.0), gtools, splines, methods, RaschSampler
-LazyData: yes
-LazyLoad: yes
-Packaged: 2010-04-08 14:17:05 UTC; hatz
-Repository: CRAN
-Date/Publication: 2010-04-08 14:57:49
+Package: eRm
+Type: Package
+Title: Extended Rasch Modeling.
+Version: 0.12-2.3
+Date: 2010-05-31
+Author: Patrick Mair, Reinhold Hatzinger, Marco Maier
+Maintainer: Patrick Mair <patrick.mair at wu.ac.at>
+Description: eRm fits Rasch models (RM), linear logistic test models
+ (LLTM), rating scale model (RSM), linear rating scale models
+ (LRSM), partial credit models (PCM), and linear partial credit
+ models (LPCM). Missing values are allowed in the data matrix.
+ Additional features are the ML estimation of the person
+ parameters, Andersen's LR-test, item-specific Wald test,
+ Martin-Loef-Test, nonparametric Monte-Carlo Tests,
+ itemfit and personfit statistics including infit and outfit
+ measures, various ICC and related plots, automated stepwise
+ item elimination, simulation module for various binary data
+ matrices. An eRm platform is provided at R-forge (see URL).
+License: GPL
+Encoding: latin1
+URL: http://r-forge.r-project.org/projects/erm/
+Imports: graphics, stats, MASS, methods
+Depends: R (>= 2.9.0), splines, methods, RaschSampler
+LazyData: yes
+LazyLoad: yes
+Packaged: 2010-06-02 09:06:13 UTC; hatz
diff --git a/NAMESPACE b/NAMESPACE
index 473d9ac..4f4695a 100755
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -15,6 +15,7 @@ export(plotGOF)
export(plotICC)
export(plotjointICC)
export(plotPImap)
+export(plotPWmap)
export(pmat)
export(Waldtest)
export(IC)
diff --git a/NEWS b/NEWS
index 7ca4d94..58440ef 100755
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,37 @@
+Changes in Version 0.13-0
+ o LLTM, LRSM, and LPCM work now for repeated measurement designs with treatment groups and missing values.
+ o Rename vignette to 'eRm'.
+
+
+Changes in Version 0.12-2
+
+ o new function plotPWmap to plot Bond-and-Fox style
+ pathway maps for the data by Julian Gilbey. Since
+ calculation of the t-statistics requires calculation
+ of the kurtosis of the standardized residuals,
+ according changes to itemfit.ppar, personfit.ppar,
+ pifit.internal, print.ifit, and print.pfit.
+
+ o plotPImap patched by Julian Gilbey: length of item.subset
+ did not match the documentation, warning stars did not all
+ appear, pre-calculated person.parameter data can be passed
+ to the function via pp, mis-ordered items can be coloured.
+ some minor bugs fixed.
+
+ o the optimizer can be changed to optim using fitctrl<-"optim"
+ and reset to nlm (the default) with fitctrl<-"nlm"
+
+ o value of LRtest now countains the list fitobj which contains
+ the model objects according to the subgroups specified by
+ splitcr
+
+ o MLoef no longer supports missings values
+
+Changes in Version 0.12-1
+
+ o function invalid from package gtools integrated into eRm
+ eRm no longer depends on gtools
+
Changes in Version 0.12-0
o for RM, RSM, and PCM: eta parameters are now
diff --git a/R/LRtest.Rm.R b/R/LRtest.Rm.R
index 84033d3..3e83f56 100755
--- a/R/LRtest.Rm.R
+++ b/R/LRtest.Rm.R
@@ -142,7 +142,8 @@ if (object$model=="RM") {
likg <- objectg$loglik
nparg <- length(objectg$etapar)
# betalab <- colnames(objectg$X)
- list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta)
+ list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta,outobj=objectg) # rh outobj added
+ ###list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta) # rh outobj added
})
}
if (object$model=="PCM") {
@@ -150,7 +151,8 @@ if (object$model=="PCM") {
objectg <- PCM(x,se=se)
likg <- objectg$loglik
nparg <- length(objectg$etapar)
- list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta)
+ list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta,outobj=objectg) # rh outobj added
+ ###list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta) # rh outobj added
})
}
if (object$model=="RSM") {
@@ -158,10 +160,15 @@ if (object$model=="RSM") {
objectg <- RSM(x,se=se)
likg <- objectg$loglik
nparg <- length(objectg$etapar)
- list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta)
+ list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta,outobj=objectg) # rh outobj added
+ ###list(likg,nparg,objectg$betapar,objectg$etapar,objectg$se.beta) # rh outobj added
})
}
+## extract fitted splitgroup models # rh 02-05-2010
+fitobj<-likpar[6,]
+likpar<-likpar[-6,]
+
if (length(del.pos) > 0) { #re-estimate full model
pos <- length(Xlist.n) #position of the full model
loglik.all <- likpar[1,pos][[1]] #loglik full model
@@ -183,7 +190,7 @@ betalist <- likpar[3,] #organizing betalist
result <- list(X=X.original, X.list=Xlist.n, model=object$model,LR=LR,
df=df, pvalue=pvalue, likgroup=unlist(likpar[1,],use.names=FALSE),
- betalist=betalist, etalist=likpar[4,],selist=likpar[5,], spl.gr=spl.gr, call=call)
+ betalist=betalist, etalist=likpar[4,],selist=likpar[5,], spl.gr=spl.gr, call=call, fitobj=fitobj) ## rh fitobj added
class(result) <- "LR"
result
}
diff --git a/R/MLoef.R b/R/MLoef.R
index 81c8aae..0349ee6 100755
--- a/R/MLoef.R
+++ b/R/MLoef.R
@@ -38,7 +38,7 @@ MLoef <- function(robj, splitcr="median")
}
sp.groups <- unique(numsplit)
i.groups <- list(which(numsplit == sp.groups[1]), which(numsplit == sp.groups[2]))
-
+
# check if one group countains less than 2 items
if( (length(i.groups[[1]]) < 2) | (length(i.groups[[2]]) < 2) ){
stop("Each group of items must contain at least 2 items.")
@@ -48,6 +48,9 @@ MLoef <- function(robj, splitcr="median")
if(any(rowSums(is.na(robj$X01[,i.groups[[1]]])) >= (length(i.groups[[1]]) - 1)))stop("Group 1 contains subjects with less than two valid responses.")
if(any(rowSums(is.na(robj$X01[,i.groups[[2]]])) >= (length(i.groups[[2]]) - 1)))stop("Group 2 contains subjects with less than two valid responses.")
+ ### no test with missing values rh 19-05-10
+ if (any(is.na(robj$X)))stop("Martin-Loef Test with NA currently not available\n")
+
### possible missing patterns and classification of persons into groups
MV.X <- apply(matrix(as.numeric(is.na(robj$X01)),ncol=ncol(robj$X01)),1,paste,collapse="")
MV.p <- sort(unique(MV.X))
@@ -64,14 +67,14 @@ MLoef <- function(robj, splitcr="median")
res1 <- RM(robj$X01[,i.groups[[1]]])
res2 <- RM(robj$X01[,i.groups[[2]]])
-
+
### calculating the numerator and denominator
ml.num <- ml.den <- numeric()
-
+
for(i in 1:length(MV.p)){
.temp.num <- table(rowSums(na.X01[[i]],na.rm=T))
ml.num[i] <- sum(log((.temp.num/sum(.temp.num))^.temp.num))
-
+
if(nrow(na.X01[[i]]) > 1){
.temp.den <- table(rowSums(na.X01[[i]][,i.groups[[1]]],na.rm=T),
rowSums(na.X01[[i]][,i.groups[[2]]],na.rm=T))
@@ -82,7 +85,7 @@ MLoef <- function(robj, splitcr="median")
}
ml.den[i] <- sum(log((.temp.den/sum(.temp.den))^.temp.den))
}
-
+
a <- sum(ml.num)
b <- sum(ml.den)
k <- c(length(i.groups[[1]]),length(i.groups[[2]]))
@@ -90,7 +93,7 @@ MLoef <- function(robj, splitcr="median")
ML.LR <- -2*( (a + robj$loglik) - (b + res1$loglik + res2$loglik) )
DF <- prod(k) - 1
p.value <- 1 - pchisq(ML.LR, DF)
-
+
result <- list(X01=robj$X01, model=robj$model, LR=ML.LR,
df=DF, p.value=p.value, L0=robj$loglik, L1=res1$loglik, L2=res2$loglik,
theta.table.RM=table(rowSums(robj$X01)), # both used for the plotting
diff --git a/R/cmlprep.R b/R/cmlprep.R
index 70ef165..bb28e4c 100755
--- a/R/cmlprep.R
+++ b/R/cmlprep.R
@@ -14,6 +14,7 @@ function(X01,mt_vek,mpoints,Groups,W,gmemb)
ngroups <- max(Groups) #number of groups
x_mtlist <- by(X01,levs,colSums,na.rm=TRUE) #item-category raw scores for each group (as list)
x_mtlist.G <- by(X01,Groups,colSums,na.rm=TRUE) #item-category raw scores for each group (as list)
+ #FIXME!!! use x_mtlist??
x_mt <- as.vector(unlist(x_mtlist.G)) #as vector: g1|g2|...
}
@@ -23,40 +24,43 @@ function(X01,mt_vek,mpoints,Groups,W,gmemb)
rtot <- sum(mt_vek)*mpoints
ics <- rep(sequence(mt_vek),mpoints) #item category scores for each item as vector
- rv <- apply(X01,1,function(x) { #person raw scores
+ rv <- apply(X01,1,function(x) { #person raw scores of 0/1 matrix
ics[!is.na(x)]%*%na.exclude(x)})
+ #--- preparing index vector for item parameters ---
if (ngroups > 1) { #groups
- seglen <- sum(mt_vek) #length of beta vector (called segment)
- gind <- rep(rep(1:ngroups,rep(seglen,ngroups)),mpoints) #index vector for group extraction
+ seglen <- sum(mt_vek) #length of beta vector (segment)
+ gind <- rep(rep(1:ngroups,rep(seglen,ngroups)),mpoints) #parameter index vector for group extraction
} else {
gind <- rep(1,dim(W)[1])
}
-
-
- rvlist <- split(rv,levs) #split person raw scores due to levels
- nrlist <- lapply(rvlist,function(rvel) { #list with item raw score frequencies for each group (transposed)
- rvtab <- table(rvel) #raw score frequencies
- dnamevek <- as.numeric(unlist(dimnames(rvtab))) #different raw scores for 0 fill up
- nr <- rep (0,rtot+1) #setting 0 raw score frequencies
- nr[dnamevek+1] <- rvtab #vector with person raw scores from 1:rtot (with 0 fill up)
+
+ #--- preparing lists for person splits ---
+ rvlist <- split(rv,levs) #split person raw scores due to levels (NAgroup AND treatment)
+ nrlist <- lapply(rvlist,function(rvel) { #list with item raw score frequencies for each group (transposed)
+ rvtab <- table(rvel) #raw score frequencies
+ dnamevek <- as.numeric(unlist(dimnames(rvtab))) #different raw scores for 0 fill up
+ nr <- rep (0,rtot+1) #setting 0 raw score frequencies
+ nr[dnamevek+1] <- rvtab #vector with person raw scores from 1:rtot (with 0 fill up)
nr <- nr[-1]
return(nr)
})
- if ((ngroups > 1) && (length(unique(gmemb)))) { #NA groups AND Groups
+ if ((ngroups > 1) && (length(unique(gmemb)) > 1)) { #NA groups AND Groups
gg <- table(Groups,gmemb)
- gg[gg > 0] <- 1
-
+ #gg[gg > 0] <- 1
g_NA <- as.vector(rowSums(gg)) #How many NA-sub groups in each Group
-
- grgm <- cbind(Groups, gmemb)
- grgmst <- apply(grgm,1,function(x) { #merge indexes to characters
- paste(x[1],x[2]) })
- GGind <- rank(unique(grgmst))
- levtab <- table(levs) #frequencies of levels
- gby <- rep(GGind,levtab) #ordering by NAgroups nested in Group
+ #grgm <- cbind(Groups, gmemb)
+ #grgmst <- apply(grgm,1,function(x) { #merge indexes to characters
+ # paste(x[1],x[2]) })
+ #GGind <- rank(unique(grgmst))
+ #levtab <- table(levs) #frequencies of levels
+ #FIXME!!! following line wrong index
+ #gby <- rep(GGind,levtab) #ordering by NAgroups nested in Group
+
+ #this probably does the job
+ gby <- levs
} else {
g_NA <- 1
gby <- gmemb
@@ -66,9 +70,9 @@ function(X01,mt_vek,mpoints,Groups,W,gmemb)
x.u <- unique(x)
as.numeric(as.matrix(x.u))}) #NA's are coded with 0
- NAcheck <- sapply(NAstruc,sum) #if for certain NAgroups only 1 item was presented
+ NAcheck <- sapply(NAstruc,sum) #if for certain NAgroups only 1 item was presented
list(x_mt=x_mt,mt_ind=mt_ind,x_tmt=x_tmt,rtot=rtot,nrlist=nrlist,gind=gind,x_mtlist=x_mtlist,
- NAstruc=NAstruc,g_NA=g_NA)
+ NAstruc=NAstruc,g_NA=g_NA,gby=gby)
}
diff --git a/R/datcheck.R b/R/datcheck.R
index 9ab27b3..87d3044 100755
--- a/R/datcheck.R
+++ b/R/datcheck.R
@@ -27,8 +27,8 @@ function(X,W,mpoints,groupvec,model)
if ((max(groupvec) > 1) && (mpoints==1)) {
stop("Model not identifiable! Group contrasts can only be imposed for repeated measurement designs.") }
- if ((length(groupvec) > 1) && any(is.na(X))) {
- stop("Model with repeated measures, group specification and NAs cannot be computed!") }
+# if ((length(groupvec) > 1) && any(is.na(X))) {
+# stop("Model with repeated measures, group specification and NAs cannot be computed!") }
#----------------------- check X --------------------------------
allna.vec <- apply(X,2,function(y) {all(is.na(y))}) #eliminate items with all NA's
diff --git a/R/fitcml.R b/R/fitcml.R
index 69e2c25..3cf9ce0 100755
--- a/R/fitcml.R
+++ b/R/fitcml.R
@@ -1,91 +1,85 @@
`fitcml` <-
-function (mt_ind,nrlist,x_mt,rtot,W,ngroups,gind,x_mtlist,NAstruc,g_NA,st.err,etaStart)
+function (mt_ind,nrlist,x_mt,rtot,W,ngroups,gind,x_mtlist,NAstruc,g_NA,st.err,etaStart,gby)
{
#cml function for call in nlm
cml <- function(eta)
{
-beta <- as.vector(W%*%eta)
-beta.list <- split(beta,gind)
-beta.list1 <- beta.list
+ beta <- as.vector(W%*%eta)
+ #FIXME!!! gby??
+ beta.list <- split(beta,gind) #gind index for treatment groups
+ beta.list1 <- beta.list
-betaNA <- mapply(function(x,y) {rbind(x,y)},beta.list1,NAstruc,SIMPLIFY=FALSE) #beta and NAstructure as list (over Groups)
+ #beta and NAstructure (over Groups): 1st line parameter values, 2nd line which item NA
+ betaNA <- mapply(function(x,y) {rbind(x,y)},beta.list1,NAstruc,SIMPLIFY=FALSE)
+ #likelihood term based on gamma functions for each Group x NAgroup combination
+ Lg <- lapply(betaNA, function(betaNAmat) {
+ beta.vec <- betaNAmat[1,] #get parameter vector beta
-Lg <- lapply(betaNA, function(betaNAmat) { #gamma functions for each Group x NAgroup combination
+ #gamma functions for each NAgroup within Groups
+ Lg.NA <- apply(matrix(betaNAmat[-1,],ncol=length(beta.vec)),1, function(NAvec) {
+
+ #list of virtual item-category parameters per item
+ beta_list <- as.list(split(beta.vec[NAvec==1],mt_ind[1:(length(beta.vec[NAvec==1]))]))
+ parlist <- lapply(beta_list,exp) #initial epsilon as list
- #print(betaNAmat)
- beta.vec <- betaNAmat[1,] #get parameter vector beta
-
- Lg.NA <- apply(matrix(betaNAmat[-1,],ncol=length(beta.vec)),1, function(NAvec) { #likelihood for each NAgroup within Groups
-
- beta_list <- as.list(split(beta.vec[NAvec==1],mt_ind[1:(length(beta.vec[NAvec==1]))])) #list of virtual item-category parameters per item
- parlist <- lapply(beta_list,exp) #initial epsilon as list
-
#------------------gamma functions----------------------
g_iter <- NULL #computation of the gamma functions
K <- length(parlist)
for (t in 1:(K-1)) { #building up J1,...,Jt,...,Js
-
+
if (t==1) { #first iteration step
gterm <- c(1,parlist[[t]]) #0th element included
}else
{
- gterm <- g_iter #gamma previous iteration with 0th el
+ gterm <- g_iter #gamma previous iteration with 0th el
g_iter <- NULL
}
-
- parvek <- c(1,parlist[[t+1]]) #eps vector in current iteration with 0th el
- h <- length(parvek) #dimensions for matrix
+
+ parvek <- c(1,parlist[[t+1]]) #eps vector in current iteration with 0th el
+ h <- length(parvek) #dimensions for matrix
mt <- length(gterm)
- rtot1 <- h+mt-1 #number of possible raw scores (0 included)
-
+ rtot1 <- h+mt-1 #number of possible raw scores (0 included)
+
gtermvek <- rep(c(gterm,rep(0,h)),h) #building up matrix for gamma term
gtermvek <- gtermvek[-((length(gtermvek)-h+1):length(gtermvek))] #eliminating last h 0's
gmat <- matrix(gtermvek,nrow=rtot1,ncol=h)
- emat <- matrix(rep(parvek,rep(rtot1,h)),ncol=h,nrow=rtot1) #building up matrix for eps term
+ emat <- matrix(rep(parvek,rep(rtot1,h)),ncol=h,nrow=rtot1) #building up matrix for eps term
gmat_new <- gmat*emat #merge matrices
- g_iter <- rowSums(gmat_new) #gamma functions in current iteration are rowsums
+ g_iter <- rowSums(gmat_new) #gamma functions in current iteration are rowsums
}
#----------------- end gamma functions ------------------
-
- Lg.NA <- as.vector(g_iter[2:(rtot+1)]) #final gamma vector stored in gamma (without gamma0)
- return(Lg.NA)
- })
-})
-
-
-#----------------- log-likelihood -----------------------
-
-#=========to be deleted
-#L1t <- (mapply(function(x,z) {
-# x[!is.na(z)]%*%na.exclude(z)
-# },nrlist,lapply(Lg,log))) #sum up L1-terms (group-wise)
-#L2t <- (mapply("%*%",x_mtlist,beta.list1)) #sum up L2-terms (group-wise)
-#print(L1t-L2t)
-#==========end delete
-
-L1 <- sum(mapply(function(x,z) {
+ Lg.NA <- as.vector(g_iter[2:(rtot+1)]) #final gamma vector stored in gamma (without gamma0)
+ return(Lg.NA)
+ })
+ })
+ #----------------- compute likelihood components -----------------------
+ L1 <- sum(mapply(function(x,z) {
x[!is.na(z)]%*%na.exclude(z)
},nrlist,lapply(Lg,log))) #sum up L1-terms (group-wise)
-L2 <- sum(mapply("%*%",x_mtlist,beta.list1)) #sum up L2-terms (group-wise)
-
-L1-L2 #actual likelihood value
-#print(L1-L2)
-#----------------- end likelihood -----------------------
+ L2 <- sum(mapply("%*%",x_mtlist,beta.list1)) #sum up L2-terms (group-wise)
+ L1-L2 #final likelihood value
}
-
+#----------------- end likelihood -----------------------
eta <- etaStart #starting values for eta parameters
-options(warn=-1) #turn off warnings for NA/Inf
-fit <- nlm(cml,eta,hessian=st.err,iterlim=5000) #NLM optimizer
-
-#options(warn=0)
-
-#fit <- optim(eta,cml,method="BFGS",hessian=TRUE)
+err<-try(exists(fitctrl), TRUE) # check if fitctrl is defined
+if(class(err)=="try-error") fitctrl <- "nlm" # if undefined set it to "nlm"
+
+if(fitctrl=="nlm"){
+ options(warn=-1) #turn off warnings for NA/Inf
+ fit <- nlm(cml,eta,hessian=st.err,iterlim=5000) #NLM optimizer
+} else if(fitctrl=="optim"){
+ options(warn=0)
+ fit <- optim(eta,cml,method="BFGS",hessian=TRUE,control=list(maxit=5000))
+ fit$counts<-fit$counts[1]
+ names(fit)<-c("estimate","minimum","iterations","code","message","hessian")
+} else stop("optimizer misspecified in fitctrl\n")
+fit
}
diff --git a/R/invalid.R b/R/invalid.R
new file mode 100755
index 0000000..9c1f3f4
--- /dev/null
+++ b/R/invalid.R
@@ -0,0 +1,13 @@
+# $Id: invalid.R 625 2005-06-09 14:20:30Z nj7w $
+
+invalid <- function(x)
+ {
+ if( missing(x) || is.null(x) || length(x)==0 )
+ return(TRUE)
+ if(is.list(x))
+ return(all(sapply(x,invalid)))
+ else if(is.vector(x))
+ return(all(is.na(x)))
+ else
+ return(FALSE)
+ }
diff --git a/R/itemfit.ppar.r b/R/itemfit.ppar.r
index 755fc47..390bf23 100755
--- a/R/itemfit.ppar.r
+++ b/R/itemfit.ppar.r
@@ -12,6 +12,7 @@ function(object)
VE <- pifit.internal(object) #compute expectation and variance term
Emat <- VE$Emat
Vmat <- VE$Vmat
+ Cmat <- VE$Cmat
st.res <- (X-Emat)/sqrt(Vmat)
sq.res <- st.res^2 #squared standardized residuals
@@ -21,11 +22,20 @@ function(object)
i.outfitMSQ <- ifit/idf
+ qsq.outfitMSQ <- (colSums(sq.res/Vmat^2, na.rm=TRUE)/idf^2) - 1/idf
+ q.outfitMSQ <- sqrt(qsq.outfitMSQ)
+
isumVmat<-colSums(Vmat)
i.infitMSQ <- colSums(sq.res*Vmat, na.rm = TRUE)/isumVmat
- result <- list(i.fit=ifit,i.df=idf,st.res=st.res,i.outfitMSQ=i.outfitMSQ,i.infitMSQ=i.infitMSQ)
+ qsq.infitMSQ <- colSums(Cmat-Vmat^2, na.rm=TRUE)/isumVmat^2
+ q.infitMSQ <- sqrt(qsq.infitMSQ)
+
+ i.outfitZ <- (sqrt(i.outfitMSQ)-1)*(3/q.outfitMSQ)+(q.outfitMSQ/3)
+ i.infitZ <- (sqrt(i.infitMSQ)-1)*(3/q.infitMSQ)+(q.infitMSQ/3)
+
+ result <- list(i.fit=ifit,i.df=idf,st.res=st.res,i.outfitMSQ=i.outfitMSQ,i.infitMSQ=i.infitMSQ,i.outfitZ=i.outfitZ,i.infitZ=i.infitZ)
+
class(result) <- "ifit"
result
}
-
diff --git a/R/likLR.R b/R/likLR.R
index bf6cc7a..cb002cf 100755
--- a/R/likLR.R
+++ b/R/likLR.R
@@ -28,7 +28,7 @@ if ((dim(Xprep$W)[1]) != ((dim(Xprep$X01)[2])*ng)) stop("Mismatch between number
Lprep <- cmlprep(Xprep$X01,Xprep$mt_vek,mpoints,Groups,Xprep$W,gmemb)
parest <- fitcml(Lprep$mt_ind,Lprep$nrlist,Lprep$x_mt,Lprep$rtot,Xprep$W,
max(Groups),gind=Lprep$gind,x_mtlist=Lprep$x_mtlist,
- Lprep$NAstruc,g_NA=Lprep$g_NA,st.err,etaStart)
+ Lprep$NAstruc,g_NA=Lprep$g_NA,st.err,etaStart,gby=Lprep$gby)
W1 <- Xprep$W
#rownames(W1) <- NULL
diff --git a/R/personfit.ppar.R b/R/personfit.ppar.R
index ebf0052..af642ed 100755
--- a/R/personfit.ppar.R
+++ b/R/personfit.ppar.R
@@ -18,6 +18,7 @@ function(object)
VE <- pifit.internal(object) #compute expectation and variance term
Emat <- VE$Emat
Vmat <- VE$Vmat
+ Cmat <- VE$Cmat
st.res <- (X-Emat)/sqrt(Vmat)
#st.res <- (X[!TFrow,]-Emat)/sqrt(Vmat)
@@ -31,11 +32,21 @@ function(object)
p.outfitMSQ <- pfit/pdf
+ qsq.outfitMSQ <- (rowSums(sq.res/Vmat^2, na.rm=TRUE)/pdf^2) - 1/pdf
+ q.outfitMSQ <- sqrt(qsq.outfitMSQ)
+
psumVmat<-rowSums(Vmat)
p.infitMSQ <- rowSums(sq.res*Vmat, na.rm = TRUE)/psumVmat
+ qsq.infitMSQ <- rowSums(Cmat-Vmat^2, na.rm=TRUE)/psumVmat^2
+ q.infitMSQ <- sqrt(qsq.infitMSQ)
+
+ p.outfitZ <- (sqrt(p.outfitMSQ)-1)*(3/q.outfitMSQ)+(q.outfitMSQ/3)
+ p.infitZ <- (sqrt(p.infitMSQ)-1)*(3/q.infitMSQ)+(q.infitMSQ/3)
+
result <- list(p.fit = pfit, p.df = pdf, st.res = st.res, p.outfitMSQ = p.outfitMSQ,
- p.infitMSQ = p.infitMSQ)
+ p.infitMSQ = p.infitMSQ,
+ p.outfitZ = p.outfitZ, p.infitZ = p.infitZ)
class(result) <- "pfit"
result
}
diff --git a/R/pifit.internal.r b/R/pifit.internal.r
index f35487f..d130f7a 100755
--- a/R/pifit.internal.r
+++ b/R/pifit.internal.r
@@ -35,6 +35,11 @@ pifit.internal <- function(object)
V.list <- tapply(1:length(mt_ind0),mt_ind0, function(ind) {rowSums(Vmat.cat[,ind],na.rm=TRUE)})
Vmat <- matrix(unlist(V.list),ncol=dim(X)[2],dimnames=list(rownames(pmat),colnames(X)))
- result <- list(Emat=Emat,Vmat=Vmat)
+ #------------------------kurtosis term for standardized residuals------
+ Cmat.cat <- (Emat0)^4*pmat0
+ C.list <- tapply(1:length(mt_ind0),mt_ind0, function(ind) {rowSums(Cmat.cat[,ind],na.rm=TRUE)})
+ Cmat <- matrix(unlist(C.list),ncol=dim(X)[2],dimnames=list(rownames(pmat),colnames(X)))
+
+ result <- list(Emat=Emat,Vmat=Vmat,Cmat=Cmat)
}
diff --git a/R/plotPImap.R b/R/plotPImap.R
index 3684ee6..ef5be68 100755
--- a/R/plotPImap.R
+++ b/R/plotPImap.R
@@ -1,7 +1,9 @@
`plotPImap` <-
function(object, item.subset="all", sorted = FALSE, main="Person-Item Map",
latdim="Latent Dimension", pplabel="Person\nParameter\nDistribution",
- cex.gen=0.7, xrange=NULL, warn.ord=TRUE, irug=TRUE)
+ cex.gen=0.7, xrange=NULL,
+ warn.ord=TRUE, warn.ord.colour="black",
+ irug=TRUE, pp=NULL)
{
def.par <- par(no.readonly = TRUE) # save default, for resetting...
@@ -21,15 +23,15 @@ function(object, item.subset="all", sorted = FALSE, main="Person-Item Map",
}
tr<-as.matrix(threshtable)
if (is.character(item.subset)){
- if ( all(item.subset %in% rownames(threshtable)))
+ if (length(item.subset)>1 && all(item.subset %in% rownames(threshtable)))
tr<-tr[item.subset,]
- else if(!(item.subset=="all"))
- stop("item.subset misspecified. Use 'all' or vector of valid item indices.")
+ else if(length(item.subset)!=1 || !(item.subset=="all"))
+ stop("item.subset misspecified. Use 'all' or vector of at least two valid item indices/names.")
} else {
- if ( all(item.subset %in% 1:ncol(tr)) && length(item.subset>1))
+ if (length(item.subset)>1 && all(item.subset %in% 1:nrow(tr)))
tr<-tr[item.subset,]
else
- stop("item.subset misspecified. Use 'all' or vector of valid item indices.")
+ stop("item.subset misspecified. Use 'all' or vector of at least two valid item indices/names.")
}
if (sorted)
@@ -39,7 +41,11 @@ function(object, item.subset="all", sorted = FALSE, main="Person-Item Map",
tr<-as.matrix(tr[,-1])
# person parameters unlist in case of several for NA groups
- suppressWarnings(pp<-person.parameter(object))
+ if (is.null(pp))
+ suppressWarnings(pp<-person.parameter(object))
+ else if (class(pp) != "ppar" || !identical(pp$X,object$X))
+ stop("pp is not a person.parameter object which matches the main Rasch data object!")
+
theta<-unlist(pp$thetapar)
tt<-table(theta)
@@ -79,21 +85,29 @@ function(object, item.subset="all", sorted = FALSE, main="Person-Item Map",
i<-nrow(tr)+1-j
assign("trpoints",tr[i,!is.na(tr[i,])])
npnts<-length(trpoints)
- points(sort(trpoints),rep(j,npnts),type="b")
+ if (!dRm && !all(sort(trpoints)==trpoints))
+ ptcol=warn.ord.colour
+ else
+ ptcol="black"
+
+ if(npnts>1) points(sort(trpoints),rep(j,npnts),type="b",cex=1,col=ptcol)
if (dRm) {
lines(xrange*1.5,rep(j,2),lty="dotted")
- text(sort(trpoints),rep(j,npnts),rownames(tr)[i], cex=cex.gen,pos=3) # different labelling for dRm
+ ## superfluous
+ ##text(sort(trpoints),rep(j,npnts),rownames(tr)[i], cex=cex.gen,pos=3,col=ptcol) # different labelling for dRm
} else {
#lines(xrange*1.5,rep(j,2),lty="dotted")
- text(sort(trpoints),rep(j,npnts),(1:npnts)[order(trpoints)],cex=cex.gen,pos=1)
+ if(npnts>1)
+ text(sort(trpoints),rep(j,npnts),(1:npnts)[order(trpoints)],cex=cex.gen,pos=1,col=ptcol)
if(!all(sort(trpoints)==trpoints)) warn[j]<-"*"
}
- points(loc[i],j,pch=20,cex=1.5) # plot item locations
- text(loc[i],j,rev(rownames(tr)[i]),cex=cex.gen,pos=3)
+ points(loc[i],j,pch=20,cex=1.5,col=ptcol) # plot item locations
+ # this is too much; obscures the dots with too many data points present
+ # text(loc[i],j,rev(rownames(tr)[i]),cex=cex.gen,pos=3,col=ptcol)
}
- if (warn.ord) axis(4,at=1:nrow(tr),tick=FALSE, labels=warn, padj=-1.5)#,cex.axis=cex.gen)
+ if (warn.ord) axis(4,at=1:nrow(tr),tick=FALSE, labels=warn, hadj=2.5, padj=0.7, las=2)#,cex.axis=cex.gen)
# person parameters
par(mar=c(0,4,3,1))
diff --git a/R/plotPWmap.R b/R/plotPWmap.R
new file mode 100755
index 0000000..e084728
--- /dev/null
+++ b/R/plotPWmap.R
@@ -0,0 +1,228 @@
+`plotPWmap` <-
+function(object, pmap=FALSE, imap=TRUE, item.subset="all", person.subset="all",
+ mainitem="Item Map", mainperson="Person Map",
+ mainboth="Item/Person Map", latdim="Latent Dimension",
+ tlab="Infit t statistic", pp=NULL, cex.gen=0.6,
+ person.pch=22, item.pch=23, personCI=NULL, itemCI=NULL)
+{
+ def.par <- par(no.readonly = TRUE) ## save default, for resetting...
+
+ ## Pathway map currently only for RM, PCM and RSM
+
+ ## The next part of the code finds locations and standard errors for
+ ## the item thresholds
+ if ((object$model == "LLTM") || (object$model == "LRSM") || (object$model == "LPCM"))
+ stop("Pathway Map can only be computed for RM, RSM, and PCM!")
+
+ if (!pmap && !imap)
+ stop("Pathway Map requires you to request at least one map (item or person)!")
+
+ ## compute threshtable (from betapars for dichotomous models) and item names
+ if (object$model == "RM" || max(object$X, na.rm=TRUE) < 2 ) { # dichotomous model
+ dRm <- TRUE
+
+ ## betapars are easiness parameters; only the pars need negating
+ threshtable<-cbind(object$betapar * -1, object$se.beta)
+ rownames(threshtable) <- colnames(object$X)
+
+ ## shorter synonym
+ tt<-threshtable
+ } else { ## polytomous model
+ dRm <- FALSE
+
+ thresh <- thresholds(object)
+ threshtable <- cbind(thresh$threshpar, thresh$se.thresh)
+ tlevels<-apply(thresh$threshtable[[1]], 1,
+ function(x) length(na.exclude(x))) - 1
+ if (!(sum(tlevels)==nrow(threshtable)))
+ stop("Threshtable rows not equal to number of thresholds - oops!")
+
+ ttl<-NULL ## threshtable labels
+ for (i in rownames(as.matrix(tlevels)))
+ if (tlevels[i]==1)
+ ttl<-c(ttl,i)
+ else
+ ttl<-c(ttl,paste(i,1:tlevels[i],sep=":"))
+ rownames(threshtable)<-ttl
+
+ ## shorter synonyms
+ tt<-threshtable
+ tl<-tlevels
+ }
+
+ ## Item subsetting is pretty ugly as there are multiple cases.
+ if (imap && is.character(item.subset)) {
+ ## Case 1: item subsetting by item names
+ if (dRm) {
+ if (length(item.subset)>1 && all(item.subset %in% rownames(tt)))
+ tt<-tt[item.subset,]
+ else if(length(item.subset)!=1 || !(item.subset=="all"))
+ stop("item.subset misspecified. Use 'all' or vector of at least two valid item indices/names.")
+ } else {
+ if (length(item.subset)>1 && all(item.subset %in% rownames(as.matrix(tl)))) {
+ keep.subset<-NULL
+ tl<-tl[item.subset]
+ for (i in rownames(as.matrix(tl)))
+ if (tl[i]==1)
+ keep.subset<-c(keep.subset,i)
+ else
+ keep.subset<-c(keep.subset,paste(i,1:tl[i],sep=":"))
+ tt<-tt[keep.subset,]
+ }
+ else if(length(item.subset)!=1 || !(item.subset=="all"))
+ stop("item.subset misspecified. Use 'all' or vector of at least two valid item indices/names.")
+ }
+ } else if (imap) {
+ ## Case 2: item subsetting by item numbers
+ if (dRm) {
+ if (length(item.subset)>1 && all(item.subset %in% 1:nrow(tt)))
+ tt<-tt[item.subset,]
+ else
+ stop("item.subset misspecified. Use 'all' or vector of at least two valid item indices/names.")
+ }
+ else {
+ if (length(item.subset)>1 && all(item.subset %in% 1:length(tl))) {
+ tl<-tl[item.subset]
+ for (i in rownames(as.matrix(tl)))
+ if (tl[i]==1)
+ keep.subset<-c(keep.subset,i)
+ else
+ keep.subset<-c(keep.subset,paste(i,1:tl[i],sep=":"))
+ tt<-tt[keep.subset,]
+ }
+ else
+ stop("item.subset misspecified. Use 'all' or vector of at least two valid item indices/names.")
+ }
+ }
+
+ ## We have to postpone the person subsetting code until after we have
+ ## done the person plot calculations
+
+ if (is.null(pp))
+ suppressWarnings(pp<-person.parameter(object))
+ else if (class(pp) != "ppar" || !identical(pp$X,object$X))
+ stop("pp is not a person.parameter object which matches the main Rasch data object!")
+
+ ## We plot the infit data versus the parameters for both items and persons
+ iloc<-tt[,1]
+ ise<-tt[,2]
+ ifit <- itemfit(pp)
+ ifitZ <- ifit$i.infitZ
+
+ ploc <- as.matrix(pp$theta.table['Person Parameter'])
+ pse <- unlist(pp$se.theta, recursive=FALSE)
+ names(pse) <- sub("^NAgroup[0-9]*\\.","",names(pse))
+ pse <- as.matrix(pse)
+ pfit <- personfit(pp)
+ pfitZ <- pfit$p.infitZ
+
+ ## We can now do person subsetting; this is significantly easier than
+ ## item subsetting, as there is no dRM/eRm distinction.
+ if (pmap && is.character(person.subset)) {
+ ## Case 1: person subsetting by person names
+ if (length(person.subset)>1 && all(person.subset %in% rownames(ploc))) {
+ ploc<-ploc[person.subset,]
+ pse<-pse[person.subset,]
+ pfitZ<-pfitZ[person.subset]
+ }
+ else if(length(person.subset)!=1 || !(person.subset=="all"))
+ stop("person.subset misspecified. Use 'all' or vector of at least two valid person indices/names.")
+ } else if (pmap) {
+ ## Case 2: person subsetting by person numbers
+ if (length(person.subset)>1 && all(person.subset %in% 1:nrow(ploc))) {
+ ploc<-ploc[person.subset,]
+ pse<-pse[person.subset,]
+ pfitZ<-pfitZ[person.subset]
+ }
+ else
+ stop("person.subset misspecified. Use 'all' or vector of at least two valid person indices/names.")
+ }
+
+ ## Confidence intervals for persons and items
+ ##
+ ## Need defaults for multiple of standard error for purpose of range
+ ## calculation; these are zero as default is not to draw confidence
+ ## intervals
+ pci=0
+ ici=0
+
+ ## Our calculation is simplistic; we use the normal distribution to
+ ## estimate our confidence interval from our standard error. However,
+ ## since this is likely to only be approximate and indicative anyway, we
+ ## are not concerned by this.
+ if(pmap && !is.null(personCI)) {
+ if(is.null(personCI$clevel)) personCI$clevel <- 0.95
+ if(is.null(personCI$col)) personCI$col <- "orange"
+ if(is.null(personCI$lty)) personCI$lty <- "dotted"
+ pci <- qnorm((1-personCI$clevel)/2, lower.tail=FALSE)
+ }
+ if(imap && !is.null(itemCI)) {
+ if(is.null(itemCI$clevel)) itemCI$clevel <- 0.95
+ if(is.null(itemCI$col)) itemCI$col <- "red"
+ if(is.null(itemCI$lty)) itemCI$lty <- "dotted"
+ ici <- qnorm((1-itemCI$clevel)/2, lower.tail=FALSE)
+ }
+
+ ## Now we can plot the Pathway Map
+
+ if (pmap) { ## person map
+ xrange.pmap <- range(pfitZ,na.rm=TRUE)
+ xrange.pmap[1] <- min(-2.5,xrange.pmap[1])
+ xrange.pmap[2] <- max(2.5,xrange.pmap[2]+1) ## need space for labels
+ yrange.pmap<-range(ploc,na.rm=TRUE)
+ yrange.pmap[1]<-yrange.pmap[1]-pci*max(pse)
+ yrange.pmap[2]<-yrange.pmap[2]+pci*max(pse)
+ }
+ if (imap) { ## item map
+ xrange.imap <- range(ifitZ,na.rm=TRUE)
+ xrange.imap[1] <- min(-2.5,xrange.imap[1])
+ xrange.imap[2] <- max(2.5,xrange.imap[2]+1) ## need space for labels
+ yrange.imap<-range(iloc,na.rm=TRUE)
+ yrange.imap[1]<-yrange.imap[1]-ici*max(ise)
+ yrange.imap[2]<-yrange.imap[2]+ici*max(ise)
+ }
+
+ if (pmap && !imap) {
+ xrange = xrange.pmap
+ yrange = yrange.pmap
+ maintitle = mainperson
+ } else if (!pmap && imap) {
+ xrange = xrange.imap
+ yrange = yrange.imap
+ maintitle = mainitem
+ } else {
+ xrange[1] <- min(xrange.pmap[1], xrange.imap[1])
+ xrange[2] <- max(xrange.pmap[2], xrange.imap[2])
+ yrange[1] <- min(yrange.pmap[1], yrange.imap[1])
+ yrange[2] <- max(yrange.pmap[2], yrange.imap[2])
+ maintitle = mainboth
+ }
+
+ par(mar=c(5,4,4,2))
+ plot(xrange,yrange, xlim=xrange, ylim=yrange, main=maintitle,
+ ylab=latdim, xlab=tlab, type="n")
+ abline(v=c(-2,2),col="lightgreen")
+
+ if (pmap) { ## person map
+ zt <- pfitZ
+ if (pci>0) ## draw confidence intervals
+ arrows(zt,ploc+pci*pse, zt,ploc-pci*pse, angle=90, code=3, length=0.04,
+ col=personCI$col, lty=personCI$lty)
+ points(zt,ploc,pch=person.pch,cex=0.6)
+ text(zt,ploc,rownames(ploc),cex=cex.gen,pos=4)
+ }
+ if (imap) { ## item map
+ if (dRm)
+ zt <- ifitZ
+ else
+ zt <- rep(ifitZ,times=tl)
+
+ if (ici>0) ## draw confidence intervals
+ arrows(zt,iloc+ici*ise, zt,iloc-ici*ise, angle=90, code=3, length=0.04,
+ col=itemCI$col, lty=itemCI$lty)
+ points(zt,iloc,pch=item.pch,cex=0.6)
+ text(zt,iloc,rownames(tt),cex=cex.gen,pos=4)
+ }
+
+ par(def.par)
+}
diff --git a/R/print.ifit.R b/R/print.ifit.R
index 827363d..6b92fb5 100755
--- a/R/print.ifit.R
+++ b/R/print.ifit.R
@@ -4,8 +4,8 @@ function(x, visible=TRUE, ...)
# x...object of class "ifit" from (itemfit)
{
pvalues <- 1-pchisq(x$i.fit,x$i.df-1) # df correction rh 10-01-20
- coef.table <- cbind(round(x$i.fit,3),x$i.df-1,round(pvalues,3),round(x$i.outfitMSQ,3),round(x$i.infitMSQ,3))
- colnames(coef.table) <- c("Chisq","df","p-value","Outfit MSQ", "Infit MSQ" )
+ coef.table <- cbind(round(x$i.fit,3),x$i.df-1,round(pvalues,3),round(x$i.outfitMSQ,3),round(x$i.infitMSQ,3),round(x$i.outfitZ,2),round(x$i.infitZ,2))
+ colnames(coef.table) <- c("Chisq","df","p-value","Outfit MSQ", "Infit MSQ", "Outfit t", "Infit t" )
rownames(coef.table) <- names(x$i.fit)
if (visible){ # added rh 10-01-20
cat("\nItemfit Statistics: \n")
diff --git a/R/print.pfit.R b/R/print.pfit.R
index 29cb3b8..c545023 100755
--- a/R/print.pfit.R
+++ b/R/print.pfit.R
@@ -4,8 +4,8 @@ function(x, visible=TRUE, ...)
# x...object of class "pfit" from (personfit)
{
pvalues <- 1-pchisq(x$p.fit,x$p.df-1) # df correction rh 10-01-20
- coef.table <- cbind(round(x$p.fit,3),x$p.df-1,round(pvalues,3),round(x$p.outfitMSQ,3),round(x$p.infitMSQ,3))
- colnames(coef.table) <- c("Chisq","df","p-value","Outfit MSQ", "Infit MSQ" )
+ coef.table <- cbind(round(x$p.fit,3),x$p.df-1,round(pvalues,3),round(x$p.outfitMSQ,3),round(x$p.infitMSQ,3),round(x$p.outfitZ,2),round(x$p.infitZ,2))
+ colnames(coef.table) <- c("Chisq","df","p-value","Outfit MSQ", "Infit MSQ", "Outfit t", "Infit t" )
rownames(coef.table) <- names(x$p.fit)
if (visible){ # added rh 10-01-20
cat("\nPersonfit Statistics: \n")
diff --git a/inst/doc/Rplots.pdf b/inst/doc/Rplots.pdf
index 4b0242b..db82773 100755
--- a/inst/doc/Rplots.pdf
+++ b/inst/doc/Rplots.pdf
@@ -2,10 +2,10 @@
%���ρ�\r
1 0 obj
<<
-/CreationDate (D:20100408161643)
-/ModDate (D:20100408161643)
+/CreationDate (D:20100602110602)
+/ModDate (D:20100602110602)
/Title (R Graphics Output)
-/Producer (R 2.10.1)
+/Producer (R 2.11.0)
/Creator (R)
>>
endobj
@@ -28,7 +28,7 @@ endobj
/Length 7 0 R
>>
stream
-q
+1 J 1 j q
Q q 59.04 73.44 414.72 371.52 re W n
0.000 0.000 0.000 RG
0.75 w
@@ -1239,7 +1239,7 @@ Q
endstream
endobj
7 0 obj
-19674
+19682
endobj
8 0 obj
<<
@@ -1254,7 +1254,7 @@ endobj
/Length 10 0 R
>>
stream
-q
+1 J 1 j q
Q q 49.00 312.96 177.90 142.04 re W n
Q q 49.00 312.96 177.90 142.04 re W n
0.000 0.000 0.000 RG
@@ -2591,7 +2591,7 @@ Q
endstream
endobj
10 0 obj
-22433
+22441
endobj
11 0 obj
<<
@@ -2606,7 +2606,7 @@ endobj
/Length 13 0 R
>>
stream
-q
+1 J 1 j q
Q q 49.00 312.96 177.90 142.04 re W n
Q q 49.00 312.96 177.90 142.04 re W n
0.000 0.000 0.000 RG
@@ -3943,7 +3943,7 @@ Q
endstream
endobj
13 0 obj
-22433
+22441
endobj
14 0 obj
<<
@@ -3958,7 +3958,7 @@ endobj
/Length 16 0 R
>>
stream
-q
+1 J 1 j q
Q q 57.60 36.00 432.00 342.00 re W n
Q q
0.000 0.000 0.000 RG
@@ -4055,9 +4055,6 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 353.48 109.40 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 353.11 119.20 Tm (I2) Tj
-ET
254.55 175.33 m 419.73 175.33 l S
BT
/F1 1 Tf 1 Tr 7.48 0 0 7.48 244.39 172.74 Tm (l) Tj 0 Tr
@@ -4074,9 +4071,6 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 334.18 172.74 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 333.81 182.53 Tm (I1) Tj
-ET
185.46 238.67 m 318.25 238.67 l S
BT
/F1 1 Tf 1 Tr 7.48 0 0 7.48 175.30 236.07 Tm (l) Tj 0 Tr
@@ -4093,9 +4087,6 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 248.89 236.07 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 248.52 245.87 Tm (I4) Tj
-ET
80.80 302.00 m 295.26 302.00 l S
BT
/F1 1 Tf 1 Tr 7.48 0 0 7.48 70.64 299.40 Tm (l) Tj 0 Tr
@@ -4112,22 +4103,19 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 185.07 299.40 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 184.70 309.20 Tm (I3) Tj
-ET
Q q
BT
0.000 0.000 0.000 rg
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 110.33 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 105.97 Tm ( ) Tj
ET
BT
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 173.67 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 169.30 Tm ( ) Tj
ET
BT
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 237.00 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 232.64 Tm ( ) Tj
ET
BT
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 300.33 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 295.97 Tm ( ) Tj
ET
Q q 57.60 378.00 432.00 82.80 re W n
Q q 0.00 378.00 504.00 126.00 re W n
@@ -4180,7 +4168,7 @@ Q
endstream
endobj
16 0 obj
-4484
+4248
endobj
17 0 obj
<<
@@ -4195,7 +4183,7 @@ endobj
/Length 19 0 R
>>
stream
-q
+1 J 1 j q
Q q 57.60 36.00 432.00 342.00 re W n
Q q
0.000 0.000 0.000 RG
@@ -4292,9 +4280,6 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 353.48 109.40 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 353.11 119.20 Tm (I2) Tj
-ET
254.55 175.33 m 419.73 175.33 l S
BT
/F1 1 Tf 1 Tr 7.48 0 0 7.48 244.39 172.74 Tm (l) Tj 0 Tr
@@ -4311,9 +4296,6 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 334.18 172.74 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 333.81 182.53 Tm (I1) Tj
-ET
185.46 238.67 m 318.25 238.67 l S
BT
/F1 1 Tf 1 Tr 7.48 0 0 7.48 175.30 236.07 Tm (l) Tj 0 Tr
@@ -4330,9 +4312,6 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 248.89 236.07 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 248.52 245.87 Tm (I4) Tj
-ET
80.80 302.00 m 295.26 302.00 l S
BT
/F1 1 Tf 1 Tr 7.48 0 0 7.48 70.64 299.40 Tm (l) Tj 0 Tr
@@ -4349,22 +4328,19 @@ ET
BT
/F1 1 Tf 2 Tr 7.48 0 0 7.48 185.07 299.40 Tm (l) Tj 0 Tr
ET
-BT
-/F2 1 Tf 8.00 0.00 0.00 8.00 184.70 309.20 Tm (I3) Tj
-ET
Q q
BT
0.000 0.000 0.000 rg
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 110.33 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 105.97 Tm ( ) Tj
ET
BT
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 173.67 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 169.30 Tm ( ) Tj
ET
BT
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 237.00 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 232.64 Tm ( ) Tj
ET
BT
-/F2 1 Tf 0.00 12.00 -12.00 0.00 502.60 300.33 Tm ( ) Tj
+/F2 1 Tf 12.00 0.00 0.00 12.00 495.66 295.97 Tm ( ) Tj
ET
Q q 57.60 378.00 432.00 82.80 re W n
Q q 0.00 378.00 504.00 126.00 re W n
@@ -4417,7 +4393,7 @@ Q
endstream
endobj
19 0 obj
-4484
+4248
endobj
3 0 obj
<<
@@ -4437,7 +4413,7 @@ endobj
<<
/ProcSet [/PDF /Text]
/Font << /F1 21 0 R /F2 22 0 R /F3 23 0 R >>
-/ExtGState << >>
+/ExtGState << /GSais 24 0 R >>
>>
endobj
20 0 obj
@@ -4469,38 +4445,45 @@ endobj
/BaseFont /Helvetica-Bold
/Encoding 20 0 R
>> endobj
+24 0 obj
+<<
+/Type /ExtGState
+/AIS false
+>>
+endobj
xref
-0 24
+0 25
0000000000 65535 f
0000000021 00000 n
0000000164 00000 n
-0000074506 00000 n
-0000074616 00000 n
+0000074058 00000 n
+0000074168 00000 n
0000000213 00000 n
0000000293 00000 n
-0000020020 00000 n
-0000020041 00000 n
-0000020121 00000 n
-0000042608 00000 n
-0000042630 00000 n
-0000042712 00000 n
-0000065200 00000 n
-0000065222 00000 n
-0000065304 00000 n
-0000069843 00000 n
-0000069864 00000 n
-0000069946 00000 n
-0000074485 00000 n
-0000074721 00000 n
-0000074816 00000 n
-0000074900 00000 n
-0000074998 00000 n
+0000020028 00000 n
+0000020049 00000 n
+0000020129 00000 n
+0000042624 00000 n
+0000042646 00000 n
+0000042728 00000 n
+0000065224 00000 n
+0000065246 00000 n
+0000065328 00000 n
+0000069631 00000 n
+0000069652 00000 n
+0000069734 00000 n
+0000074037 00000 n
+0000074287 00000 n
+0000074382 00000 n
+0000074466 00000 n
+0000074564 00000 n
+0000074667 00000 n
trailer
<<
-/Size 24
+/Size 25
/Info 1 0 R
/Root 2 0 R
>>
startxref
-75101
+74717
%%EOF
diff --git a/inst/doc/eRmvig.R b/inst/doc/eRm.R
similarity index 100%
rename from inst/doc/eRmvig.R
rename to inst/doc/eRm.R
diff --git a/inst/doc/eRmvig.Rnw b/inst/doc/eRm.Rnw
similarity index 100%
rename from inst/doc/eRmvig.Rnw
rename to inst/doc/eRm.Rnw
diff --git a/inst/doc/eRmvig.pdf b/inst/doc/eRm.pdf
similarity index 94%
rename from inst/doc/eRmvig.pdf
rename to inst/doc/eRm.pdf
index d9d1b73..f46d63b 100755
Binary files a/inst/doc/eRmvig.pdf and b/inst/doc/eRm.pdf differ
diff --git a/man/LRtest.Rd b/man/LRtest.Rd
index a30bbaf..daeb790 100755
--- a/man/LRtest.Rd
+++ b/man/LRtest.Rd
@@ -90,6 +90,7 @@
\item{etalist}{List of eta parameters for the subgroups.}
\item{spl.gr}{Names and levels for \code{splitcr}.}
\item{call}{The matched call.}
+ \item{fitobj}{List containing model objects from subgroup fit.}
}
\references{
Fischer, G. H., and Molenaar, I. (1995). Rasch Models - Foundations, Recent Developements, and Applications. Springer.
diff --git a/man/MLoef.Rd b/man/MLoef.Rd
index 649cfd3..0a5ad65 100755
--- a/man/MLoef.Rd
+++ b/man/MLoef.Rd
@@ -15,8 +15,9 @@ MLoef(robj, splitcr = "median")
denotes the number of items) that takes two distinct values to define groups
used for the Martin-L�f Test.}
}
-\details{The function can handle missing values, as long as every subject has at
- least 2 valid responses in each group of items.
+\details{The function currently does not allow for missing values.
+ %The function can handle missing values, as long as every subject has at
+ %least 2 valid responses in each group of items.
If the split criterion is \code{"median"} or \code{"mean"} and one or more items'
raw scores are equal the median resp. mean, \code{MLoef} will issue a warning
diff --git a/man/eRm-package.Rd b/man/eRm-package.Rd
index 4c8a345..3e2cfd3 100755
--- a/man/eRm-package.Rd
+++ b/man/eRm-package.Rd
@@ -12,7 +12,7 @@ the rating scale model (RSM) and its linear extension (LRSM), the partial credit
and its linear extension (LPCM). The parameters are estimated by conditional maximum
likelihood (CML). Missing values are allowed in the data matrix. Additional features
are the estimation of the person parameters, LR-Model test, item-spefific Wald test,
-Martin-L�f test, nonparametric Monte-Carlo tests,
+Martin-Loef test, nonparametric Monte-Carlo tests,
itemfit and personfit statistics, various ICC plots. An eRm platform is provided at
http://r-forge.r-project.org/projects/erm/.
}
@@ -20,8 +20,8 @@ http://r-forge.r-project.org/projects/erm/.
\tabular{ll}{
Package: \tab eRm\cr
Type: \tab Package\cr
-Version: \tab 0.12-0\cr
-Date: \tab 2010-04-07\cr
+Version: \tab 0.12-2.3\cr
+Date: \tab 2010-05-31\cr
License: \tab GPL\cr
}
The basic input units for the functions are the person-item matrix X and the design matrix W.
@@ -45,10 +45,15 @@ ordered according to the rows of the data matrix.
\code{eRm}. \code{PCM} and \code{RSM} produce objects belonging to the classes
\code{RM} and \code{eRm}, whereas results of \code{LLTM}, \code{LRSM}, and \code{LLTM} are object of class \code{eRm}.
-The \code{eRm} package contains functions from the packages \code{sna} and \code{ROCR}.
-Thanks to Carter T. Butts and Tobias Sing et al.
+The \code{eRm} package contains functions from the packages \code{sna}, \code{gtools} and \code{ROCR}.
+Thanks to Carter T. Butts, Gregory R. Warnes, and Tobias Sing et al.
}
-\author{Patrick Mair, Reinhold Hatzinger, Marco Maier
+\note{The fitting engine by default is \code{\link{nlm}} unless changed to \code{\link{optim}}.
+ For specification of the optimizer the global variable \code{fitctrl} has to be used, i.e.,
+ \code{fitctrl <- "nlm"} or \code{fitctrl <- "optim"}.}
+
+
+\author{Patrick Mair, Reinhold Hatzinger, Marco Maier, Julian Gilbey
Maintainer: Patrick Mair <patrick.mair at wu.ac.at>
}
diff --git a/man/plotPImap.Rd b/man/plotPImap.Rd
index ac536b2..5aee890 100755
--- a/man/plotPImap.Rd
+++ b/man/plotPImap.Rd
@@ -14,7 +14,8 @@
plotPImap(object, item.subset = "all", sorted = FALSE,
main = "Person-Item Map", latdim = "Latent Dimension",
pplabel = "Person\nParameter\nDistribution", cex.gen = 0.7,
- xrange = NULL, warn.ord = TRUE, irug = TRUE)
+ xrange = NULL, warn.ord = TRUE, warn.ord.colour = "black",
+ irug = TRUE, pp = NULL)
}
\arguments{
\item{object}{Object of class \code{Rm} or \code{dRm}}
@@ -32,8 +33,16 @@ plotPImap(object, item.subset = "all", sorted = FALSE,
\item{xrange}{Range for the x-axis}
\item{warn.ord}{If \code{TRUE} (the default) asterisks are displayed in the right margin of the lower
panel to indicate nonordinal threshold locations for polytomous items.}
+ \item{warn.ord.colour}{Nonordinal threshold locations for polytomous
+ items are coloured with this colour to make them more visible. This
+ is especially useful when there are many items so that the plot is
+ quite dense. The default is \code{"black"}, so that there is no
+ distinction made.}
\item{irug}{If \code{TRUE} (the default), all thresholds are plotted below the person distribution
to indicate where the included items are most informative.}
+ \item{pp}{If non-\code{NULL}, this contains the
+ \code{person.parameter} data of the data object, avoiding the
+ need to recalculate it.}
}
\details{
Item locations are displayed with bullets, threshold locations with circles.
@@ -42,7 +51,7 @@ plotPImap(object, item.subset = "all", sorted = FALSE,
\references{Bond, T.G., and Fox Ch.M. (2007) Applying the Rasch Model. Fundamental Measurement in the Human Sciences.
2nd Edition. Lawrence Erlbaum Associates.
}
-\author{Patrick Mair, Reinhold Hatzinger}
+\author{Patrick Mair, Reinhold Hatzinger, patches from Julian Gilbey and Marco Maier}
%\note{}
%\seealso{}
\examples{
diff --git a/man/plotPWmap.Rd b/man/plotPWmap.Rd
new file mode 100755
index 0000000..efc69de
--- /dev/null
+++ b/man/plotPWmap.Rd
@@ -0,0 +1,106 @@
+\name{plotPWmap}
+\alias{plotPWmap}
+\title{Pathway Map}
+\description{
+ A Bond-and-Fox Pathway Map displays the location of each item or
+ each person against its infit t-statistic. Pathway maps are useful
+ for identifying misfitting items or misfitting persons. Items or
+ people should ideally have a infit t-statistic lying between about
+ -2 and +2, and these values are marked.
+}
+\usage{
+plotPWmap(object, pmap = FALSE, imap=TRUE,
+ item.subset = "all", person.subset = "all",
+ mainitem = "Item Map", mainperson = "Person Map",
+ mainboth="Item/Person Map",
+ latdim = "Latent Dimension",
+ tlab = "Infit t statistic",
+ pp = NULL, cex.gen = 0.6,
+ person.pch = 22, item.pch = 23,
+ personCI = NULL, itemCI = NULL)
+}
+\arguments{
+ \item{object}{Object of class \code{Rm} or \code{dRm}}
+ \item{pmap}{Plot a person map if \code{TRUE}; the default is
+ \code{FALSE}.}
+ \item{imap}{Plot an item map if \code{TRUE} (the default); do not plot
+ if \code{FALSE}. At least one of \code{pmap} and \code{imap} must
+ be \code{TRUE}.}
+ \item{item.subset}{Subset of items to be plotted for an item map.
+ Either a numeric vector indicating the item numbers or a character
+ vector indicating the item names. If \code{"all"}, all items are
+ plotted. The number of items to be plotted must be > 1.}
+ \item{person.subset}{Subset of persons to be plotted for a person map.
+ Either a numeric vector indicating the person numbers or a character
+ vector indicating the person names. If \code{"all"}, all persons are
+ plotted. The number of persons to be plotted must be > 1.}
+ \item{mainitem}{Main title of an item plot.}
+ \item{mainperson}{Main title of a person plot.}
+ \item{mainboth}{Main title of a person/item joint plot.}
+ \item{latdim}{Label of the y-axis, i.e., the latent dimension.}
+ \item{tlab}{Label of the x-axis, i.e., the t-statistic dimension.}
+ \item{pp}{If non-\code{NULL}, this contains the
+ \code{person.parameter} data of the data object, avoiding the
+ need to recalculate it.}
+ \item{cex.gen}{\code{cex} as a graphical parameter
+ specifies a numerical value giving the amount by which plotting
+ text and symbols should be magnified relative to the
+ default. Here \code{cex.gen} applies to all text labels. The
+ default is 0.6.}
+ \item{person.pch, item.pch}{Specifies the symbol used for plotting
+ person data and item data respectively; the defaults are 22 and 23
+ respectively. See \code{\link{points}} for more information
+ about \code{pch} values.}
+ \item{personCI, itemCI}{Plotting confidence intervals for the the
+ person abilities and item difficulties. If \code{personCI=NULL}
+ (the default) no confidence intervals are drawn for person
+ abilities. Otherwise, specifying \code{personCI} draws
+ approximate confidence intervals for each person's ability.
+ \code{personCI} must be specified as a list, and the optional
+ elements of this list are \code{gamma}, the confidence level,
+ \code{col}, colour, and \code{lty}, line type. If \code{personCI}
+ is specified as an empty list, or not all of the list items are
+ specified, the default values
+ \code{personCI=list(gamma=0.95,col="orange",lty="dotted")} will be
+ used.
+
+ The same goes for \code{itemCI}, except that the default settings
+ are \code{itemCI=list(gamma=0.95,col="red",lty="dotted")}.}
+}
+\details{
+ This code uses vertical error bars rather than circles or boxes to
+ indicate standard errors. It also offers the possibility of plotting
+ item or person data on it own; this can considerably simplify the
+ reading of the plots for large datasets.
+}
+%\value{}
+\references{
+ Bond T.G., Fox C.M. (2007) \emph{Applying the Rasch Model: Fundamental
+ Measurement in the Human Sciences} (2nd ed.) chapter 3, Lawrence
+ Erlbaum Associates, Inc.
+
+ Linacre J.M., Wright B.D. (1994) Dichotomous Infit and
+ Outfit Mean-Square Fit Statistics / Chi-Square Fit Statistics.
+ \emph{Rasch Measurement Transactions} \bold{8:2} p. 350,
+ \url{http://www.rasch.org/rmt/rmt82a.htm}
+
+ Linacre J.M. (2002) What do Infit and Outfit, Mean-square and
+ Standardized mean? \emph{Rasch Measurement Transactions} \bold{16:2}
+ p. 878, \url{http://www.rasch.org/rmt/rmt162f.htm}
+
+ Wright B.D., Masters G.N. (1990) Computation of OUTFIT and INFIT
+ Statistics. \emph{Rasch Measurement Transactions} \bold{3:4}
+ p. 84--85, \url{http://www.rasch.org/rmt/rmt34e.htm}
+
+}
+\author{Julian Gilbey}
+%\note{}
+%\seealso{}
+\examples{
+data(pcmdat)
+res<-PCM(pcmdat)
+pparm<-person.parameter(res)
+plotPWmap(res, pp=pparm)
+plotPWmap(res, pp=pparm, pmap=TRUE)
+}
+\keyword{models}
diff --git a/src/eRm.dll b/src/eRm.dll
new file mode 100755
index 0000000..f1b40ac
Binary files /dev/null and b/src/eRm.dll differ
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-erm.git
More information about the debian-science-commits
mailing list