From: Haynes, Maurice (NIH/NICHD)
Dear list members,
How can I replace the nested for loops at then end of the script
below with more efficient code?
# Begin script__________________________________________________
# Dichotomous scores for 100 respondents on 3 items with
# probabilities of a correct response = .6, .4, and .7,
# respectively
x1 <- rbinom(100,1,.6)
x2 <- rbinom(100,1,.4)
x3 <- rbinom(100,1,.7)
# 'theta.vec' is a vector holding 31 possible levels of theta
# ranging from -3 to +3 in intervals of .2.
theta.vec <- seq(-3,3,.2)
theta <- sample(rep(theta.vec,5),100)
x.mat <- (cbind(x1,x2,x3,theta))
rm(x1,x2,x3,theta)
nc <- ncol(x.mat)
ni <- nc - 1
nr <- nrow(x.mat)
ntheta <- length(theta.vec)
# 'opt.mat' is a matrix which will hold the observed proportions
# correct at each level of theta for each item. Rows have
# dimnames corresponding to the 31 levels of theta and columns
# have dimnames corresponding to the item names.
opt.mat <- matrix(rep(NA,ni*ntheta),nrow=ntheta, ncol=ni,
dimnames=list(round(theta.vec,1),c(dimnames(x.mat)[[2]][1:ni])))
# Set of nested for-loops to compute the observed proportions
# correct at each level of theta for each item and store them in
# the appropriate row and column locations of the 'opt.mat'.
system.time(
for(j in 1:ni)
{for (k in 1:ntheta) {
n.theta.cat <- 0
sum.theta.cat <- 0
kt <- theta.vec[k]
for(i in 1:nr) {
it <- x.mat[i,nc]
if(identical(all.equal(kt,it),TRUE)) n.theta.cat
<- n.theta.cat
+ 1
if(identical(all.equal(kt,it),TRUE)) sum.theta.cat <-
sum.theta.cat + x.mat[i,j]
if(n.theta.cat > 0) opt.mat[k,j] <- sum.theta.cat
/ n.theta.cat
}
}
}
)
# End script____________________________________________________
On my Dell 863 MHz machine with 512 MB RAM running Windows XP SP2,
the loop to 21 sec to execute.
Thanks,
Maurice Haynes
National Institute of Child Health and Human Development
Child and Family Research Section
6705 Rockledge Drive, Suite 8030
Bethesda, MD 20892
Voice: 301-496-8180
Fax: 301-496-2766
E-Mail: mh192j at nih.gov