R循环匹配data.table列答案

【问题标题】：R Loop for matched data.table columnsR循环匹配data.table列
【发布时间】：2016-08-25 11:56:29
【问题描述】：

我真的很难创建一个运行模型的函数，其中所有变量 a、b、d、g 和 N 都有多个版本，如下面的 data.table 所示我已经命名为crm：

crm = data.table(
  East = 26500,
  North = c(115000, 120000, 125000, 130000, 135000, 140000), 
  rain = c(1049.61, 1114.31, 1361.61, 1407.2, 1499.56, 1654.13), 
  crop = 'Wheat', area = c(0.1718, 0.1629, 0.1082, 0.0494, 0.02, 0.004), 
  rn = c("10007", "10018", "10023", "10024", "10025", "10026"), 
  N1 = 184.262648839489, N2 = 180.312874871521, N3 = 178.615847839997,
  N4 = 182.531626054579, a1 = 0.186117715072018, a2 = -0.0232731908915799,
  a3 = 0.227017532149122, a4 = 0.162943230565506, b1 = 0.000478900233700419,
  b2 = 0.000787931973696371, b3 = 0.000458478256537521, b4 = 0.000517304324750896,
  d1 = -0.000328164576390286, d2 = -0.000112122093240884, d3 = 0.000112702113716146,
  d4 = 7.40875908059628e-05, g1 = 4.04709473710477e-06, g2 = 3.68724096485995e-06,
  g3 = 3.47214450131546e-06, g4 = 3.55825543257538e-06, key = 'rn'
)

我要做的是运行下面的函数来计算lnN 的值，并将其放入标题中与输入模型的变量具有相同数字的列中。 IE。使用 a1,b1,d1,g1 & N1 将为所有 2s、3s 和 4s 生成列 lnN1 等等。

n <- 1:4
cols <- paste0("lnN",n)
for(i in 1:length(n)){
crm[,(cols) := lapply(.SD ,function (x) {
  N = crm[,7+i]
  a = crm[,11+i]
  b = crm[,15+i]
  d = crm[,19+i]
  g = crm[,23+i]
a + (b*crm[,rain]) + (g*N) + (d*crm[,rain]*N)}), .SDcols = paste0("N",n)]

}

我还没有在任何地方找到有关如何完成此操作的示例。我试过使用mapply，但我看不到如何通过每个变量的所有迭代来迭代mapply。感谢您的帮助！

【问题讨论】：

“我还没有在任何地方找到一个例子来说明如何做到这一点。”在这种情况下，我认为这暗示您的数据结构存在缺陷。我发现很难理解您正在尝试什么，因为您覆盖了 (cols) := 四次，这看起来不是一件有用的事情。无论如何，我会从melt(crm, meas=patterns("^N", "^a", "^b", "^d", "^g"), value.name=c("N","a","b","d","g")) 开始，然后找到一种从那里开始工作的方法，而不是摆弄列号，我认为（？）你在这里做什么。
@Frank 感谢您的建议。我想不出其他方法来构造我的数据，因为我需要为每个变量生成多元数据作为蒙特卡洛方法的一部分以获得不确定值。我会看看你的建议，看看我能做些什么。
我会支持@Frank 所说的，在您迭代分析时考虑（但"^N" 可能类似于"^N[0-9]" 以避免拿起North）。完成后，您可以通过dd[, lnN:=.(a + (b*rain) + (g*N) + (d*rain*N))] 应用您的公式，并根据需要使用group_by 继续您的分析。

标签： r for-loop data.table apply

【解决方案1】：

怎么样：

library(dplyr)
cbind(crm, do.call(cbind, 
  lapply(1:4, function(x) {
    select(crm, c(contains(as.character(x)), rain)) %>% 
      setnames(gsub("[0-9]", "", names(.))) %>%
      transmute(lnN = a + (b*rain) + (g*N) + (d*rain*N)) %>%
      setnames(paste0("lnN", x))
  })
))

主要思想是，对于每个数字，仅选择包含数字的列（以及 rain），重命名列以删除数字，应用公式，重命名结果列以附加数字，然后然后cbind 将结果放到原始表中。

【讨论】：

有趣。它似乎没有在 data.table 的末尾创建任何 lnN 列，但我可以看到代码中的逻辑。我会玩一下，看看我做错了什么！
在我的机器上工作正常...您是否为输出分配了名称？ IE。 output <- cbind(crm, do.call(cbind, ... 或原始对象crm <- cbind(crm...。
哦，天哪……我会把它归结为漫长的一天！感谢您的帮助！

【解决方案2】：

因此，在查看了上面的 cmets 后，意识到尝试将迭代次数更改为数千次时可能会出现问题，正如 Frank 和 Weihuang 建议的那样，我重新考虑了我的数据结构。

我所做的是将随机生成的变量矩阵保留为单独的数据框。 e 在rnm 中包含a、b、g 和d 与N（现在称为Nit）的多元随机值。所以crm 现在只有前六列。代码如下所示：

for(i in 1:n){
  a = e[1,i]
  b = e[2,i]
  g = e[3,i]
  d = e[4,i]
Nit = rnm[i]
bob = a + (b*crm$rain) + (g*Nit) + (d*crm$rain*Nit)
data.y <- cbind(data.y, bob)
}
crm <- cbind(crm, data.y)
names(crm)[c(7:n)] = names(bobs)

对于 1:n 的每次迭代，它读取每个参数的 i 值（所有 1、所有 2 等）并将其放入模型中并创建一个名为 bob 的列。 bob 然后合并到我在函数之前创建的一个空数据框 (data.y)。这样循环，直到达到所需的循环次数。

然后我使用cbind 将两者合并在一起，然后使用存储在数据框bobs 中的名称顺序重命名所有bob 列，该数据框包含编号为bob.1 的列标题列表@ 到bob.n这是从我在 Excel 中生成的.csv 文件中读取的。

【讨论】：

【解决方案3】：

这是一个melt-and-dcast (recast) 版本，它利用melt 的newly implemented 功能为patterns 使用提供的名称。有关说明，请参阅 Installation wiki，因为这是目前正在开发的功能。

library(data.table) 1.10.5+
# create character version of 1:N (Number of output columns)
N = paste0(seq_len(length(grep('^b', names(crm)))))
# join crm to a melt & recast version of itself using rain as 
#   the join key (note this will fail if the amount of rain may
#   not be unique -- in this case, we should include some ID in
#   id.vars, like rn, and adjust accordingly)
crm = crm[crm[ , melt(.SD, id.vars = 'rain', 
                      measure.vars = patterns(N = '^N[0-9]', a = '^a[0-9]', 
                                              b = '^b', d = '^d', g = '^g'))
               # use the formula to generate ln
               ][ , ln := a + b*rain + g * N + d * rain * N
                  # reshape wide
                  ][ , dcast(.SD, rain ~ variable, value.var = 'ln')
                     # rename the columns here
                     ][ , setnames(.SD, N, paste0('ln', N))],
          on = 'rain']

# by-reference version
crm[crm[ , melt(.SD, id.vars = 'rain', 
                measure.vars = patterns(N = '^N[0-9]', a = '^a[0-9]', 
                                        b = '^b', d = '^d', g = '^g'))
         # use the formula to generate ln
         ][ , ln := a + b*rain + g * N + d * rain * N
            # reshape wide
            ][ , dcast(.SD, rain ~ variable, value.var = 'ln')],
    # mget tends to be sort of slow, which is why I used the
    #   assign-by-copy approach first above; in larger examples,
    #   this slow-down may be outweighed by the cost of copying
    paste0('ln', N) := mget(N), on = 'rain']

【讨论】：