[R] Deleting for() loop in function

[jim holtman]

One of the things that you should do is to use Rprof to see where time
is being spent.  I would guess that is the not the 'for' loop, but
instead what is being done inside it.  My guess it that most of the
time is being spent in the number of times that 'lp' is being called.
So the real problem might be in the way that you have the function
structured and the number of times that 'lp' is called.  You might
look at other ways to restructure the data to see if there are other
ways of doing it that will reduce the number of iterations.

On 10/10/07, Dong-hyun Oh <r.arecibo at gmail.com> wrote:
> 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.
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>


-- 
Jim Holtman
Cincinnati, OH
+1 513 646 9390

What is the problem you are trying to solve?