[R] Deleting for() loop in function

[Dong-hyun Oh]

Dear UseRs,

I wrote following function in order to solve Data Envelopment Analysis.
Reason for posting is that the function is slow when nrow(dat) is large.
I wonder if other functions could substitute the for() loop in the  
code, such as mapply().

Can anybody help to rewrite the dea() function as efficiently as  
possible?

The code is as follows:

------------------------------------------------------------------------ 
-------------------
   dea <- function(dta, noutput = 1, rts = 1) {
     #rts = 1: CRS
     #rts = 2: VRS

     # lpSolve library call
     require(lpSolve)

     # set number of outputs
     s <- noutput

     # set number of inputs
     m <- dim(dta)[2] - s

     # set number of observations
     n <- dim(dta)[1]


     # make output matrix
     Y <- as.matrix(dta[,1:s])

     # make input matrix
     X <- as.matrix(dta[,-(1:s)])

     # allocate result matrix
     result <- matrix(0, nrow=n, ncol=1)
     # define column names of result as ``eff''
     colnames(result) <- "eff"

     # If RTS is CRS
     if(rts==1){
       # make part of lhs constraint matrix
       cond1 <- rbind(t(Y), -t(X))

       # make inequality matrix
       f.dir <- rep(">=", s+m)

       # make objective matrix
       f.obj <- c(1, rep(0,n))

       # solve LP for all DMUs by using for syntax
       for(i in 1:n){
         # make part of lhs constraint matrix
         cond2 <- matrix(c(rep(0, s), X[i,]), byrow=T)

         # make final constraint matrix
         f.con <- cbind(cond2, cond1)

         # make rhs constraint
         f.rhs <- c(Y[i,], rep(0, m))

         # solve LP problem
         result[i,'eff'] <- lp("min", f.obj, f.con, f.dir, f.rhs) 
$solution[1]
       }
     }

     # if RTS is VRS
     if(rts == 2) {
       cond1 <- rbind(t(Y), -t(X), matrix(rep(1, n), ncol=n))

      # make inequality/equality matrix
       f.dir <- c(rep(">=", s+m), "=")
       f.obj <- c(1, rep(0, n))

       for(i in 1:n){
         # note that 0 is added in the part of lhs constraint matrix
         cond2 <- matrix(c(rep(0, s), X[i,], 0), byrow=T)

         f.con <- cbind(cond2, cond1)

         # note that 1 is added in the rhs constraint matrix
         f.rhs <- c(Y[i,], rep(0, m), 1)

         result[i,'eff'] <- lp("min", f.obj, f.con, f.dir, f.rhs) 
$solution[1]
       }
     }
     return(result)
   }
------------------------------------------------------------------------ 
--------------------

Thank you in advance.