# [R] Deleting for() loop in function

Dong-hyun Oh r.arecibo at gmail.com
Wed Oct 10 17:03:26 CEST 2007

```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) - s

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

# 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
}
}

# 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
}
}
return(result)
}
------------------------------------------------------------------------
--------------------