You may be able to simplify it further, but just by replacing the whole inner-most loop with
opt.mat2[k,j] <- mean(x.mat[kt == x.mat[, nc], j]) the computation is instantaneous on my 1.6GHz Pentium M laptop (whereas your code took just over 7 seconds). HTH, Andy > 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: [EMAIL PROTECTED] > > ______________________________________________ > R-help@stat.math.ethz.ch mailing list > https://stat.ethz.ch/mailman/listinfo/r-help > PLEASE do read the posting guide! > http://www.R-project.org/posting-guide.html > > > ______________________________________________ R-help@stat.math.ethz.ch mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html