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

问题描述

以下是原始数据帧的示例(最后提供了数据)

> 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

enter image description here

我编写下面的代码来计算RN_l,它们负责最大的R

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

在上面的函数中,通过定义R,为N_l的所有可能值计算N_l_seq <- seq(N_l)。问题是我不想像函数中所写的那样乘以cumsum(e)。我想对其进行修改,以便针对与R的当前值相同的e_1,e_2,e_3,...数目的所有可能组合计算N_l

示例

如果N_l = 3,则为f中3个的所有可能组合中的cumsum计算e_1,e_4,e_5,e_6,e_7,e_8的等式,例如cumsum(e_1,e_8,e_6)和{ {1}}。当cumsum(e_7,e_4)时,将为N_l = 5中5个的所有可能组合中的f计算cumsum的等式。

问题

我不确定如何更新e_1,e_8公式,因此它会计算a的所有组合的f而不是所有可能的cumsum()值的e。等于cumsum()值中当前N_l的数字。

数据

e

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

m

解决方法

我不确定这是否是您想要的。我猜您应该在函数combn中使用cumsum而不是R

  • 第一步,我将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))
}
  • 最后,您可以在R中按行执行函数apply,例如
> 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))
}