Question

当我想要灵活的列数和参数时，我在为map的语法苦苦挣扎...很难动态地编写这个代码。

一个具体的例子...

假设对于任意 J 我有以下矩阵：

set.seed(1) 
J=2 
n = 100
BB = data.table(r=1:n) 
for(i in seq(J)) set(x = BB, j = paste0('a',i), value = rnorm(n, 1, 7)) 
for(i in seq(J^2)) set(x = BB, j = paste0('b',i), value = rnorm(n, 1, 7)) 
for(i in seq(J)) set(x = BB, j = paste0('p',i), value = rnorm(n, 1, 7))

所以输出是...

> head(BB)
   r        a1        a2         b1        b2        b3        b4          p1         p2
1: 1 -3.385177 -3.342567   3.865813  7.255716  8.521087  1.541122 -1.38746886 -3.9529776
2: 2  2.285503  1.294811  12.822113 -6.331087 14.269583 -1.078080 11.51697174 14.8010041
3: 3 -4.849400 -5.376452  12.106119 14.799362 -3.220981 -7.282696  4.69815399  0.3700092

我想创建一个函数，该函数以下列方式从现有列中创建新列。

（因为 J = 2）：

Lambda1 = exp(a1 + b1p1 + b2p2) 
Lambda2 = exp(a2 + b3p1 + b4p2)

如果 J = 1，则为：

Lambda1 = exp(a1 + b1p1)

如果 J = 3…

Lambda1 = exp(a1 + b1p1 + b2p2 + b3p3) 
Lambda2 = exp(a2 + b4p1 + b5p2 + b6p3)
Lambda3 = exp(a3 + b7p1 + b8p2 + b9p3)

输出应为：

> head(BB)
   r        a1        a2         b1        b2        b3        b4          p1         p2       lambda1      lambda2
1: 1 -3.385177 -3.342567   3.865813  7.255716  8.521087  1.541122 -1.38746886 -3.9529776  5.547749e-17 5.862180e-10
2: 2  2.285503  1.294811  12.822113 -6.331087 14.269583 -1.078080 11.51697174 14.8010041  2.688353e+24 1.012574e+65
3: 3 -4.849400 -5.376452  12.106119 14.799362 -3.220981 -7.282696  4.69815399  0.3700092  9.401501e+24 8.370005e-11

我尝试的解决方案：

我认为它应该看起来像这样，尽管 J ^ 2 p部分正在淘汰它。此解决方案将其忽略。

BB[,
      (paste0("lambda",seq(J))) := Map(
        function(a,b,p) exp(a + b * p),
        mget(paste0("a", seq(J))),
        mget(paste0("b", seq(J))),
        mget(paste0("p", seq(J)))
      )
      ]

Answer 1

我不熟悉data.table术语，但这里有解决方案

# Find the relevant columns
colA <- which(names(BB) %in% paste0("a",seq(J)))
colB <- which(names(BB) %in% paste0("b",seq(J^2)))
colP <- which(names(BB) %in% paste0("p",seq(J)))
# Extract the a's, b's & p's
a <- BB[ ,colA, with = FALSE]
b <- BB[, colB, with = FALSE]
p <- BB[, colP, with = FALSE]
# Multiply the b's and p's - expand the p's before multiplication
bp <- b * do.call("cbind.data.frame", replicate(J, p, simplify = FALSE))
# Loop through the columns to add
for (k in 1:J){ 
  tmpLambda <- exp(rowSums(bp[,((k-1)*J+1):(k*J)]) + a[, k, with = FALSE])
  BB$tmpLambda <- tmpLambda
  names(BB)[ncol(BB)] <- paste0("Lambda",k)
}
# Result
>   head(BB)
   r        a1        a2         b1        b2        b3        b4          p1         p2       Lambda1      Lambda2
1: 1 -3.385177 -3.342567   3.865813  7.255716  8.521087  1.541122 -1.38746886 -3.9529776  5.547749e-17 5.862180e-10
2: 2  2.285503  1.294811  12.822113 -6.331087 14.269583 -1.078080 11.51697174 14.8010041  2.688353e+24 1.012574e+65
3: 3 -4.849400 -5.376452  12.106119 14.799362 -3.220981 -7.282696  4.69815399  0.3700092  9.401501e+24 8.370005e-11

这可以包装成一个函数和/或也可以进行优化。这是使用J=3进行的测试：

> str(BB)
Classes ‘data.table’ and 'data.frame':  100 obs. of  19 variables:
 $ r      : int  1 2 3 4 5 6 7 8 9 10 ...
...
 $ Lambda1: num  6.21e-13 2.93e+23 7.46e-69 8.01e+18 1.45e+13 ...
 $ Lambda2: num  5.61e-36 1.05e+127 7.63e-32 4.36e-33 1.19e-33 ...
 $ Lambda3: num  5.84e+70 3.75e+52 1.60e-02 4.01e+33 2.51e+12 ...
 - attr(*, ".internal.selfref")=<externalptr>

希望有帮助。

Answer 2

另一种可能性是使用矩阵乘法：

BB[, (paste0("lambda",seq(J))) := lapply(
        as.list(matrix(unlist(mget(paste0("a", seq(J)))), nrow=1L) +
            matrix(unlist(mget(paste0("p", seq(J)))), nrow=1L) %*%
                matrix(unlist(mget(paste0("b", seq(J^2)))), ncol=J))
        , exp),
    by=1:BB[,.N]]

缺点是速度可能不是最佳的，因为它遍历数据的每一行。

动态地对函数进行编码，使其在数据表中具有任意数量的参数

2 个答案: