Add a condition within the function with apply - r

Question

I want to write a conditional function to apply to my dataframe.
The existing function is:
Proposed <- function(N_b,N_l,m,A,x.sqr,e_1,e_2,e_3,e_4,e_5,K_g,a,b,c,d) {
e <- data.frame(e_1,e_2,e_3,e_4,e_5,N_l)
ee <- e[e != 0]
CSi <- m * ((N_l/N_b) * ((a*K_g)^b) +
((A * apply(ee,1,function(v) max(combn(v[1:ncol(ee)],v["N_l"],sum))))
/ x.sqr) * ((c*K_g)^d))
return(CSi)
}
There are two folds to the conditions:
I want to add the condition that if A > 0 then select max(combn(v[1:5],v["N_l"],sum)). But if A < 0 select min(combn(v[1:5],v["N_l"],sum))
Data
A sample dataframe is provided (just a couple of rows)
dput(DATA)
structure(list(N_l = c(2, 4, 2, 4, 1, 2, 1, 3), N_b = c(5, 5,
5, 5, 5, 5, 5, 5), m = c(1, 0.65, 1, 0.65, 1.2, 1, 1.2, 0.85),
A = c(-12, -12, -15, -15, -9, -9, -9, -9), x.sqr = c(1440,
1440, 2250, 2250, 810, 810, 810, 810), e_1 = c(21.8, 21.8,
29, 29, 14.6, 14.6, 14.6, 14.6), e_2 = c(9.8, 9.8, 17, 17,
2.6, 2.6, 2.6, 2.6), e_3 = c(-2.2, -2.2, 5, 5, -9.4, -9.4,
-9.4, -9.4), e_4 = c(-14.2, -14.2, -7, -7, 0, 0, 0, 0), e_5 = c(0,
0, -19, -19, 0, 0, 0, 0), K_g = c(6340598.65753794, 6340598.65753794,
6429472.98493414, 6429472.98493414, 6296482.86883766, 6296482.86883766,
8140521.8248051, 8140521.8248051)), row.names = c(20L, 40L,
60L, 80L, 100L, 120L, 140L, 160L), class = "data.frame")

Answer 1

max(combn(v, n, sum)) is the same as sum(tail(v,n)), no combn necessary. For example,
v <- 1:5
n <- 3
combn(v, n, sum)
# [1] 6 7 8 8 9 10 9 10 11 12
sum(tail(sort(v), n))
# [1] 12
Similarly, min(combn(...)) is just sum of the smallest two. With this, your combn calls can be simplified.
A simple function:
func2 <- function(x) { # A=x[1], N_l=x[2], e_*=x[-(1:2)]
decr <- (x[1] > 0)
sum(head(sort(x[-(1:2)], decreasing = decr), x[2]))
}
For the sake of "interesting data", I'll negate A in every other row:
dat$A
# [1] -12 -12 -15 -15 -9 -9 -9 -9
dat$A[c(2,4,6,8)] <- (-dat$A[c(2,4,6,8)])
dat$A
# [1] -12 12 -15 15 -9 9 -9 9
The use of it:
apply(dat[,c("A", "N_l", grep("^e_", colnames(dat), value = TRUE))],
1, func2)
# 20 40 60 80 100 120 140 160
# -16.4 29.4 -26.0 44.0 -9.4 17.2 -9.4 17.2
(Assign this to a new variable in your frame if you'd like.)
Decomposition: let's debug it and run through the first row:
debug(func2)
# debugging in: FUN(newX[, i], ...)
# debug at #1: {
# decr <- (x[1] > 0)
# sum(head(sort(x[-(1:2)], decreasing = decr), x[2]))
# }
# Browse[2]>
x
# A N_l e_1 e_2 e_3 e_4 e_5
# -12.0 2.0 21.8 9.8 -2.2 -14.2 0.0
Our x variable has everything, so we'll need to reference them individually. We could use x["A"] instead of x[1], which would be clearer to read. Over to you.
# Browse[2]>
decr <- (x[1] > 0)
# Browse[2]>
decr
# A
# FALSE
# Browse[2]>
sort(x[-(1:2)], decreasing = decr)
# e_4 e_3 e_5 e_2 e_1
# -14.2 -2.2 0.0 9.8 21.8
Okay, so in this row, A is less than 0, so we want the N_l (2) lowest values, so when we sort them, the lowest are first.
# Browse[2]>
head(sort(x[-(1:2)], decreasing = decr), x[2])
# e_4 e_3
# -14.2 -2.2
# Browse[2]>
sum(head(sort(x[-(1:2)], decreasing = decr), x[2]))
# [1] -16.4
We'll repeat for the second row, where I changed A to be positive (and now N_l is 4):
# debugging in: FUN(newX[, i], ...)
# debug at #1: {
# decr <- (x[1] > 0)
# sum(head(sort(x[-(1:2)], decreasing = decr), x[2]))
# }
x
# A N_l e_1 e_2 e_3 e_4 e_5
# 12.0 4.0 21.8 9.8 -2.2 -14.2 0.0
decr <- (x[1] > 0)
decr
# A
# TRUE
sort(x[-(1:2)], decreasing = decr)
# e_1 e_2 e_5 e_3 e_4
# 21.8 9.8 0.0 -2.2 -14.2
head(sort(x[-(1:2)], decreasing = decr), x[2])
# e_1 e_2 e_5 e_3
# 21.8 9.8 0.0 -2.2
sum(head(sort(x[-(1:2)], decreasing = decr), x[2]))
# [1] 29.4
Repeating through them all. (If you're doing this on the console, either reload/redefine the function, or call undebug(func2).