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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
i_info<-function(hvec,itembeta,theta)
#calculates information (Samejima, 1969) for an item i as a function of theta
#
#@input: hvec...number of categories of item
# itembeta...cumulative item parameters
# theta ... supporting or sampling points on latent trait
#@output: a list with
# $c.info...matrix of category information in columns for theta (rows)
# $i.info...vector of item information at values of theta
#@author: Thomas Rusch
#@date:6.12.2013 Happy Nikolaus!
#
{
if(missing(theta)) theta <-seq(-5,5,0.01)
p.ih<-function(hvec,itembeta,theta)
#Calculates p.ih of given item i and the weird expression in its first derivative
#needs categories given (hvec) and the cumulative item parameters of the item (itembeta)
#@output: a list with
# $p.ih...matrix of probabilities to fall into category h (colums) for given items as a function of theta (rows).
# $weird...the weird expression from the derivative
{
beta <- c(0,itembeta) #eRm gives itempar with first fixed to zero
numerator<-exp(outer(hvec,theta)+beta) #Numerator
tmp<-hvec*numerator
weird.exp.num <- apply(tmp,2,sum) #numerator of weird expression in the derivative
denom <- apply(numerator,2,sum) #denominator
p.ih<-t(numerator)/denom #categories in column,thetas in rows
weird.exp<- weird.exp.num/denom #weird expression in derivative
return(list("p.ih"=p.ih,"weird"=weird.exp))
}
ic.derivative<-function(hvec,itembeta,theta)
{
#Calculates first derivative of p.ih of given item i, needs number of categories and cumulative item parameters
#
#@output: a list with
# $out...first derivative of p.ih with categories h in columns and theta in ro ws
f1<-p.ih(hvec,itembeta,theta) #to get p.ih and weird expression
out <- t(hvec*t(f1$p.ih))-f1$p.ih*f1$weird #first derivative
return(out)
}
tmp <- ic.derivative(hvec,itembeta,theta)#call ic.derivative
c.info <- tmp^2/p.ih(hvec,itembeta,theta)$p.ih #calculates category info (columns) for all theta(rows)
i.info <-apply(c.info,1,sum)#calculates item for all theta(rows)
return(list("c.info"=c.info,"i.info"=i.info))
}
item_info <- function(ermobject,theta=seq(-5,5,0.01))
##Calculates information (Samejima, 1969) of all items as a function of the latent trait, theta
# ermobject ... object of class eRm
# theta ... supporting or sampling points on latent trait
#@output: a list where each element corresponds to an item and contains
# $c.info...matrix of category information in columns for theta (rows)
# $i.info...vector of item information at values of theta
#@author: Thomas Rusch
#@date:13.6.2011
#
{
vec.tmp <- get_item_cats(X=ermobject$X,nitems=dim(ermobject$X)[2],grp_n=dim(ermobject$X)[1])
betapar <- ermobject$betapar
veco <- unlist(lapply(vec.tmp,max))
alloc.list<-vector("list",length(veco))
hvec.list <- vector("list",length(veco))
out.list <- vector("list",length(veco))
for (i in 1:length(veco))
{
alloc.list[[i]] <- rep(i,veco[i])
hvec.list[[i]] <- 0:veco[i]
}
uu<-unlist(alloc.list)
itembeta.list <- split(betapar,uu)
for (i in 1:length(itembeta.list))
{
out.list[[i]] <- i_info(hvec.list[[i]],itembeta.list[[i]],theta) #patch
}
return(out.list)
}
#THANK YOU FOR READING THE SOURCE
|
