检查数据帧列之间的多种操作组合的函数

Function that checks multiple combinations of operations between columns of a dataframe

这是原始数据框的示例(最后提供的数据)

> DATA
     N_b N_l  A   x.sqr_sum  e_1  e_2  e_3   e_4   e_5   e_6 e_7 e_8 
1    7   6   -36      4032   33.8 21.8  9.8  -2.2 -14.2 -26.2   0   0 
2    7   4   -27      2268   23.6 11.6 -0.4 -12.4   0.0   0.0   0   0 
3    7   4   -27      2268   23.6 11.6 -0.4 -12.4   0.0   0.0   0   0 
4    7   6   -36      4032   33.8 21.8  9.8  -2.2 -14.2 -26.2   0   0 
5    7   6   -36      4032   33.8 21.8  9.8  -2.2 -14.2 -26.2   0   0 
6    7   6   -36      4032   33.8 21.8  9.8  -2.2 -14.2 -26.2   0   0 
7    7   8   -45      6300   44.0 32.0 20.0   8.0  -4.0 -16.0 -28 -40 
8    7   8   -45      6300   44.0 32.0 20.0   8.0  -4.0 -16.0 -28 -40 
9    7   8   -45      6300   44.0 32.0 20.0   8.0  -4.0 -16.0 -28 -40 

我想写一个函数来根据等式

计算R

我写下面的代码来计算R和负责最大RN_l

R <- function(x){
  N_b <- x[1]
  N_l <- x[2]
  N_l_seq <- seq(N_l)
  A <- x[3]
  x.sqr_sum <- x[4]
  e <- x[5:12]
  m <- Multi.Presence$m[N_l_seq]
  f <- m * (N_l_seq/N_b + A * cumsum(e) / x.sqr_sum)
  c(val = max(f), pos = which.max(f))
}

DATA <- cbind(DATA, vars = t(apply(DATA, 1, R)))

在上面的函数中,通过定义 N_l_seq <- seq(N_l)N_l 的所有可能值计算 R。问题是我不想只乘以函数中所写的 cumsum(e) 。我想对其进行修改,以便它可以针对与 N_l.

的当前值相同数量的 e_1, e_2, e_3,... 计算所有可能的组合 R

例子

如果N_l = 3,则f的等式是针对e_1, e_2, e_3, e_4, e_5, e_6, e_7, e_8的3个所有可能组合的cumsum计算的,例如cumsum(e_1, e_8, e_6) cumsum(e_7, e_2, e_4)。当N_l = 5时,f的等式是对e_1, e_2, e_3, e_4, e_5, e_6, e_7, e_8的5种所有可能组合的cumsum进行计算的,依此类推。

问题

我不确定如何更新 f 方程,所以它计算的不是所有可能 e 值的 cumsum(),而是所有组合的 cumsum()等于 e 值的当前 N_l 的数字。

数据

> dput(DATA)
structure(list(N_b = c(7, 7, 7, 7, 7, 7, 7, 7, 7), N_l = c(6, 
4, 4, 6, 6, 6, 8, 8, 8), A = c(-36, -27, -27, -36, -36, -36, 
-45, -45, -45), x.sqr_sum = c(4032, 2268, 2268, 4032, 4032, 4032, 
6300, 6300, 6300), e_1 = c(33.8, 23.6, 23.6, 33.8, 33.8, 33.8, 
44, 44, 44), e_2 = c(21.8, 11.6, 11.6, 21.8, 21.8, 21.8, 32, 
32, 32), e_3 = c(9.8, -0.399, -0.399, 9.8, 9.8, 9.8, 20, 20, 20), 
e_4 = c(-2.2, -12.4, -12.4, -2.2, -2.2, -2.2, 8, 8, 8), e_5 = 
c(-14.2, 0, 0, -14.2, -14.2, -14.2, -4, -4, -4), e_6 = c(-26.2, 
0, 0, -26.2, -26.2, -26.2, -16, -16, -16), e_7 = c(0, 0, 0, 0, 
0, 0, -28, -28, -28), e_8 = c(0, 0, 0, 0, 0, 0, -40, -40, -40), 
S = c(12, 9, 9, 12, 12, 12, 15, 15, 15)), row.names = c(1L, 3L, 
4L, 115L, 116L, 117L, 199L, 200L, 201L), class = "data.frame")

因变量 m 在下面的数据框中定义:

> dput(Multi.Presence)
structure(list(N_l = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), m = c(1.2, 
1, 0.85, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65)), row.names = c(NA, 
-10L), class = "data.frame")

我不确定这是否是您想要的。我猜你应该在函数 R.

中使用 combn 而不是 cumsum
  • 作为第一步,我将 Multi.Presence 合并到 DATA 这样你就可以读取 m 相对于 N_l
  • 的对应值
df <- merge(DATA, Multi.Presence, by = "N_l")
  • 然后,我重写了函数 R,使其接受 df 的行作为参数
R <- function(x){
  N_l <- x["N_l"]
  N_b <- x["N_b"]
  N_l_seq <- seq(N_l)
  A <- x["X_ext"]
  x.sqr_sum <- x["x.sqr_sum"]
  e <- x[grepl("e_\d",names(x))]
  m <- x["m"]
  f <- m * (N_l/N_b + A * combn(e,N_l,sum) / x.sqr_sum)
  c(val = max(f), pos = which.max(f))
}
  • 最后,您可以按行在 apply 内执行函数 R,例如,
> apply(df,1,R)
          [,1]       [,2]    [,3]    [,4]    [,5]    [,6]      [,7]      [,8]
val  0.4704685  0.4704685  0.7475  0.7475  0.7475  0.7475 0.6685714 0.6685714
pos 56.0000000 56.0000000 28.0000 28.0000 28.0000 28.0000 1.0000000 1.0000000
         [,9]
val 0.6685714
pos 1.0000000

更新

我不知道你想如何处理 combn,但下面是一个更新

R <- function(x){
  # browser()
  N_l <- x["N_l"]
  N_b <- x["N_b"]
  N_l_seq <- seq(N_l)
  A <- x["A"]
  x.sqr_sum <- x["x.sqr_sum"]
  e <- x[grepl("e_\d",names(x))]
  m <- Multi.Presence$m[N_l_seq]
  f <- m * sapply(N_l_seq,function(k) N_l/N_b + A * max(combn(e,k,sum)) / x.sqr_sum)
  c(val = max(f), pos = which.max(f))
}