1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
`RSM` <-
function(X, W, se = TRUE, sum0 = TRUE, etaStart)
{
#...X: person*item scores matrix (starting from 0)
#-------------------main programm-------------------
call<-match.call()
groupvec <- 1
mpoints <- 1
model <- "RSM"
if (missing(W)) W <- NA
else W <- as.matrix(W)
if (missing(etaStart)) etaStart <- NA
else etaStart <- as.vector(etaStart)
XWcheck <- datcheck(X,W,mpoints,groupvec,model) #inital check of X and W
X <- XWcheck$X
lres <- likLR(X,W,mpoints,groupvec,model,st.err=se,sum0,etaStart)
parest <- lres$parest #full groups for parameter estimation
loglik <- -parest$minimum #log-likelihood value
iter <- parest$iterations #number of iterations
convergence <- parest$code
etapar <- parest$estimate #eta estimates
betapar <- as.vector(lres$W%*% etapar) #beta estimates
if (se) {
se.eta <- sqrt(diag(solve(parest$hessian))) #standard errors
se.beta <- sqrt(diag(lres$W%*%solve(parest$hessian)%*%t(lres$W))) #se beta
} else {
se.eta <- rep(NA,length(etapar))
se.beta <- rep(NA,length(betapar))
}
X01 <- lres$X01
labs <- labeling.internal(model,X,X01,lres$W,etapar,betapar,mpoints,max(groupvec)) #labeling for L-models
W <- labs$W
etapar <- labs$etapar
betapar <- labs$betapar
etapar <- -etapar # output difficulty rh 25-03-2010
npar <- dim(lres$W)[2] #number of parameters
result <- list(X=X,X01=X01,model=model,loglik=loglik,npar=npar,iter=iter,convergence=convergence,
etapar=etapar,se.eta=se.eta,hessian=parest$hessian,betapar=betapar,
se.beta=se.beta,W=W,call=call)
class(result) <- c("Rm","eRm") #classes: simple RM and extended RM
result
}
|
