匹配列名以在 lapply 函数中获取相应的其他值答案

【问题标题】：Match column names to get corresponding other values inside lapply function匹配列名以在 lapply 函数中获取相应的其他值
【发布时间】：2019-12-13 12:31:16
【问题描述】：

我有一个包含以下列的基本数据框：

Base <- data.frame(Currency = c("EUR.", "EUR.", "USD.", "USD.", "GBP."), Quantity = c(393858,597184,673522,110204,38051625), Price_local = c(168,119.2,168.29,1221.14,1.45), FX_rate = c(1.0898, 1.0898, 1, 1, 1.2287), Exposure.USD = c(72110043,77576686,113347017,134574513,67723215))

我有另一个名为 FX_Stress 的数据框，由以下列组成：

FX_Stress <- data.frame(V1 = c("FXDown5", FXDown10", "FXUp5", "FXUp10"), V2 = c(0.95,0.90,1.05,1.10))

我想要的是将新列添加到具有 FX_Stress 数据帧第一列的列名的基本数据帧，即 FXDown5、FXDown10、FXUp5 和 FXUp10。此外，我希望这些新列由特定公式填充。例如，对于新列 Base$FXDown5，公式为：

Base$FXDown5 <- ifelse(Base$Currency == "USD.", 0, ((1/((1/Base$FX_rate)*0.95))*(Base$Price_local)*Base$Quantity)-Base$Exposure.USD)

上面公式中使用的0.95是从FX_Stress中的V2列得到的，对应于V1列中的FXDown5。这是这样工作的，新列 Base$FXDown5 下的正确值是 3795265.77、4082983.35、0、0、3638201.71。但是我必须填写很多列，我不能为每个新列编写一个新公式。因此，我尝试使用 lapply 函数一次填充所有新列。这些在下面提到：

Base[FX_Stress[,1]] <- 0
Base[FX_Stress[,1]] <- lapply(Base[FX_Stress[,1]], function(x) {ifelse(Base$Currency == "USD.", 0, ((1/((1/Base$FX_rate)* FX_Stress$V2[match(names(x), FX_Stress$V1)]))*(Base$Price_local)*Base$Quantity)-Base$Exposure.USD)})

但在输出中，我得到了非美元货币的 NA 值。（对于美元。货币为 0，这是正确的）。如果我为每列单独执行它，那么它会正确出现，但是当我使用 lapply 匹配列名时，NA 值将用于非美元的货币。任何人都可以帮助了解我用来立即为新列获取正确值的 lapply 公式。这可以通过使用 dplyr 和诸如收集和传播之类的功能来完成，但我会请求有关如何使用 lapply/sapply 完成它的帮助。

【问题讨论】：

标签： r match lapply sapply

【解决方案1】：

或许你可以这样使用sapply()

Base <- cbind(Base,`colnames<-`(sapply(FX_Stress$V2, function(x) with(Base,ifelse(Currency == "USD.", 0, FX_rate/x * Price_local * Quantity - Exposure.USD))),FX_Stress$V1))

这样

> Base
  Currency Quantity Price_local FX_rate Exposure.USD FXDown5 FXDown10    FXUp5   FXUp10
1     EUR.   393858      168.00  1.0898     72110043 3795266  8012227 -3433811 -6555458
2     EUR.   597184      119.20  1.0898     77576686 4082983  8619632 -3694128 -7052426
3     USD.   673522      168.29  1.0000    113347017       0        0        0        0
4     USD.   110204     1221.14  1.0000    134574513       0        0        0        0
5     GBP. 38051625        1.45  1.2287     67723215 3638202  7602725 -3158124 -6092901

数据

Base <- data.frame(Currency = c("EUR.", "EUR.", "USD.", "USD.", "GBP."), Quantity = c(393858,597184,673522,110204,38051625), Price_local = c(168,119.2,168.29,1221.14,1.45), FX_rate = c(1.0898, 1.0898, 1, 1, 1.2287), Exposure.USD = c(72110043,77576686,113347017,134574513,67723215))

FX_Stress <- data.frame(V1 = c("FXDown5", "FXDown10", "FXUp5", "FXUp10"), V2 = c(0.95,0.90,1.05,1.10))

用OP的原始公式

Base <- data.frame(Currency = c("EUR.", "EUR.", "USD.", "USD.", "GBP."), Quantity = c(393858,597184,673522,110204,38051625), Price_local = c(168,119.2,168.29,1221.14,1.45), FX_rate = c(1.0898, 1.0898, 1, 1, 1.2287), Exposure.USD = c(72110043,77576686,113347017,134574513,67723215))

FX_Stress <- data.frame(V1 = c("FXDown5", "FXDown10", "FXUp5", "FXUp10"), V2 = c(0.95,0.90,1.05,1.10))

Base <- cbind(Base,`colnames<-`(sapply(FX_Stress$V2, function(x) ifelse(Base$Currency == "USD.", 0, ((1/((1/Base$FX_rate)*0.95))*(Base$Price_local)*Base$Quantity)-Base$Exposure.USD)),FX_Stress$V1))

【讨论】：

可能还值得指出的是，公式比它需要的更复杂。 ((1/((1/Base$FX_rate)*x))*(Base$Price_local)*Base$Quantity)-Base$Exposure.USD)) 简化为 Base$FX_rate/x * Base$Price_local * Base$Quantity - Base$Exposure.USD
@ThomasIsCoding 我仍然得到非美元的 NA 值。当我使用你的公式时的货币。不知道是什么问题
@ss003 你在运行代码之前清理了你的全局环境吗？对我来说效果很好。也许您可以使用我的代码以及我的答案中的数据来尝试一下
@ThomasIsCoding 它的工作......非常感谢你......你能否更详细地解释一下你是如何应用 sapply 函数的，这样我就可以在类似的情况下做同样的事情......并且可以我提供的公式没有修改，其中使用了 lapply 和 match 函数。如果可以的话，您能否指出我公式中的错误。
@ss003 在sapply() 函数中，我只使用V2 列作为将传递给您的公式的参数...注意V2 包含4 个值，所以@ 987654331@ 会将所有 4 个值传递给您的公式，生成一个包含 4 列的矩阵