R help - Mar 2005 - Code to replace nested for loops

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

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: mh192j at nih.gov
> 
> ______________________________________________
> R-help at 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
> 
> 
>