R - 矢量化功能

Question

----大家好，我的问题是我有下一个中奖组合和3张“彩票”。

winner <- c("L","L",rep("X",12))

[1] "L" "L" "X" "X" "X" "X" "X" "X" "X" "X" "X" "X" "X" "X"

combinations

   Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11 Var12 Var13 Var14
1    L    L    L    L    L    L    L    L    L     L     L     L     L     L
2    X    L    L    L    L    L    L    L    L     L     L     L     L     L
3    V    L    L    L    L    L    L    L    L     L     L     L     L     L

dput(combinations)

structure(list(Var1 = structure(1:3, .Label = c("L", "X", "V"
), class = "factor"), Var2 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var3 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var4 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var5 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var6 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var7 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var8 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var9 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var10 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var11 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var12 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var13 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor"), Var14 = structure(c(1L, 1L, 1L), .Label = c("L", 
"X", "V"), class = "factor")), .Names = c("Var1", "Var2", "Var3", 
"Var4", "Var5", "Var6", "Var7", "Var8", "Var9", "Var10", "Var11", 
"Var12", "Var13", "Var14"), out.attrs = structure(list(dim = c(3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), dimnames = structure(list(
    Var1 = c("Var1=L", "Var1=X", "Var1=V"), Var2 = c("Var2=L", 
    "Var2=X", "Var2=V"), Var3 = c("Var3=L", "Var3=X", "Var3=V"
    ), Var4 = c("Var4=L", "Var4=X", "Var4=V"), Var5 = c("Var5=L", 
    "Var5=X", "Var5=V"), Var6 = c("Var6=L", "Var6=X", "Var6=V"
    ), Var7 = c("Var7=L", "Var7=X", "Var7=V"), Var8 = c("Var8=L", 
    "Var8=X", "Var8=V"), Var9 = c("Var9=L", "Var9=X", "Var9=V"
    ), Var10 = c("Var10=L", "Var10=X", "Var10=V"), Var11 = c("Var11=L", 
    "Var11=X", "Var11=V"), Var12 = c("Var12=L", "Var12=X", "Var12=V"
    ), Var13 = c("Var13=L", "Var13=X", "Var13=V"), Var14 = c("Var14=L", 
    "Var14=X", "Var14=V")), .Names = c("Var1", "Var2", "Var3", 
"Var4", "Var5", "Var6", "Var7", "Var8", "Var9", "Var10", "Var11", 
"Var12", "Var13", "Var14"))), .Names = c("dim", "dimnames")), row.names = c(NA, 
3L), class = "data.frame")

下面显示票价

price

  Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11 Var12 Var13 Var14
1 2.48 1.79 2.99 2.31 4.03  2.1 2.71 2.22  2.7  2.94  2.01  2.16  3.41  2.16
2 3.28 1.79 2.99 2.31 4.03  2.1 2.71 2.22  2.7  2.94  2.01  2.16  3.41  2.16
3 3.16 1.79 2.99 2.31 4.03  2.1 2.71 2.22  2.7  2.94  2.01  2.16  3.41  2.16

dput(price)

structure(list(Var1 = c(2.48, 3.28, 3.16), Var2 = c(1.79, 1.79, 
1.79), Var3 = c(2.99, 2.99, 2.99), Var4 = c(2.31, 2.31, 2.31), 
    Var5 = c(4.03, 4.03, 4.03), Var6 = c(2.1, 2.1, 2.1), Var7 = c(2.71, 
    2.71, 2.71), Var8 = c(2.22, 2.22, 2.22), Var9 = c(2.7, 2.7, 
    2.7), Var10 = c(2.94, 2.94, 2.94), Var11 = c(2.01, 2.01, 
    2.01), Var12 = c(2.16, 2.16, 2.16), Var13 = c(3.41, 3.41, 
    3.41), Var14 = c(2.16, 2.16, 2.16)), .Names = c("Var1", "Var2", 
"Var3", "Var4", "Var5", "Var6", "Var7", "Var8", "Var9", "Var10", 
"Var11", "Var12", "Var13", "Var14"), out.attrs = structure(list(
    dim = c(3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
    3L), dimnames = structure(list(Var1 = c("Var1=2.48", "Var1=3.28", 
    "Var1=3.16"), Var2 = c("Var2=1.79", "Var2=4.04", "Var2=4.55"
    ), Var3 = c("Var3=2.99", "Var3=3.38", "Var3=2.54"), Var4 = c("Var4=2.31", 
    "Var4=3.39", "Var4=3.36"), Var5 = c("Var5=4.03", "Var5=3.22", 
    "Var5=2.14"), Var6 = c("Var6=2.10", "Var6=3.77", "Var6=3.60"
    ), Var7 = c("Var7=2.71", "Var7=3.22", "Var7=2.93"), Var8 = c("Var8=2.22", 
    "Var8=3.56", "Var8=3.47"), Var9 = c("Var9=2.70", "Var9=3.66", 
    "Var9=2.65"), Var10 = c("Var10=2.94", "Var10=3.30", "Var10=2.65"
    ), Var11 = c("Var11=2.01", "Var11=3.61", "Var11=4.09"), Var12 = c("Var12=2.16", 
    "Var12=3.15", "Var12=4.19"), Var13 = c("Var13=3.41", "Var13=3.43", 
    "Var13=2.27"), Var14 = c("Var14=2.16", "Var14=3.78", "Var14=3.43"
    )), .Names = c("Var1", "Var2", "Var3", "Var4", "Var5", "Var6", 
    "Var7", "Var8", "Var9", "Var10", "Var11", "Var12", "Var13", 
    "Var14"))), .Names = c("dim", "dimnames")), row.names = c(NA, 
3L), class = "data.frame")

我做了下一个公式来计算某张门票的价格（这是一个不切实际的价格，但我的书上这么说）

myfunction2 <- function(x,y){
 ifelse(sum((x==winner))>=2,prod(((x==winner)*y)+((x==winner)<=0)*1),return(1))
                             }

  myfunction2(combinations[1,],price[1,])
  [1] 4.4392

  myfunction2(combinations[2,],price[2,])
  [1] 1.0000

  myfunction2(combinations[3,],price[3,])
  [1] 1.0000

公式是正确的，在第一种情况下，价格是 (2.48*1.79)=4.4392，在第二种和第三种情况下，答案是 1，因为我需要至少两个正确答案才能支付超过 1 的费用。

当我尝试“矢量化”公式时，答案不正确

R3 <- apply(combinations,1,myfunction2,y=price)

R3
    1        2        3 
  595.0378   1.00000  1.00000 

我可以用 for 循环解决问题，但我有 3^14 组合而且速度很慢，我尝试使用 mapply，但我遇到了同样的问题（答案不正确）

欢迎大家帮忙，非常感谢

Answer 1

要弄清楚为什么apply 方法不起作用，您可以做的一件事是在您的函数中手动插入browser() 并查看它实际看到的参数。使用上面的数据，这是带有添加行的函数：

myfunction2 <- function(x,y){
  browser()
  if (sum((x==winner))>=2) {
    return( prod( ((x == winner) * price) + (( x == winner) == 0) * 1) )
  } else {
    return(1)
  }
}

apply(combinations,1,myfunction2,price)
# Called from: FUN(newX[, i], ...)
# debug at #3: if (sum((x == winner)) >= 2) {
#     return(prod(((x == winner) * price) + ((x == winner) == 0) * 
#         1))
# } else {
#     return(1)
# }
# Browse[2]>
x
#  Var1  Var2  Var3  Var4  Var5  Var6  Var7  Var8  Var9 Var10 Var11 Var12 Var13 Var14 
#   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L"   "L" 

到目前为止一切顺利。

# Browse[2]>
y
#   Var1 Var2 Var3 Var4 Var5 Var6 Var7 Var8 Var9 Var10 Var11 Var12 Var13 Var14
# 1 2.48 1.79 2.99 2.31 4.03  2.1 2.71 2.22  2.7  2.94  2.01  2.16  3.41  2.16
# 2 3.28 1.79 2.99 2.31 4.03  2.1 2.71 2.22  2.7  2.94  2.01  2.16  3.41  2.16
# 3 3.16 1.79 2.99 2.31 4.03  2.1 2.71 2.22  2.7  2.94  2.01  2.16  3.41  2.16

您的问题的一部分：它在每次调用时看到 所有 price，而您的函数不知道要检查这个。

顺便说一句：您误读了我关于使用 ifelse 的建议。虽然你使用它的方式是有效的，但它是不正确的，以后会咬你。我建议你用谷歌搜索ifelse 和传统的if ... else 之间的区别。长话短说：ifelse 需要假设它的三个参数的长度是相同的（或容易回收），所以当你测试一个东西（sum(...)>=2，它的第一个参数）时，你应该使用if ... else.

此外，由于combinations[1,] 在技术上返回一个data.frame，您应该将其取消列出以始终如一地处理其他事情。 （price 也一样。）将其视为您的函数的替代方案：

myfunction3 <- function(x,y){
  i <- (unlist(x) == winner)
  if (sum(i) >= 2) prod(ifelse(i, unlist(y), 1)) else 1
}
myfunction3(combinations[1,], price[1,])
# [1] 4.4392
myfunction3(combinations[2,], price[2,])
# [1] 1
myfunction3(combinations[3,], price[3,])
# [1] 1

最后，我非常喜欢避免使用side-effects (wiki)。与此类似的事情是超出函数的范围 (wiki) 以获取父环境或命名空间中的变量。虽然它有效，但它可能是有问题的。我将通过在函数参数中传递 winner 的值来解决这个问题。

myfunction4 <- function(x,y,w){
  i <- (unlist(x) == w)
  if (sum(i) >= 2) prod(ifelse(i, unlist(y), 1)) else 1
}

回到最初的问题，一次获取所有price。尽管使用mapply 当然可以扭曲它，但我认为它是*apply 函数中唯一可以轻松应用于此问题的函数，即使这样也需要对数据进行一些按摩和转换。帧。相反，我建议使用这样的东西：

myfunction5 <- function(comb, pr, win) {
  i <- (unlist(comb) == win)
  if (sum(i) >= 2) prod(ifelse(i, unlist(pr), 1)) else 1
}

最后，我们可以这样做：

sapply(1:nrow(combinations),
       function(i, comb, pr, win) myfunction5(comb[i,], pr[i,], win),
       combinations, price, winner)
# [1] 4.4392 1.0000 1.0000

在这种情况下，i 只是combinations 和price 中的行的索引。虽然看起来很迂腐，但编写完全自给自足的函数（不要为未提供给它的变量到达其空间“外部”）通常会生成更强大、更“防御性”的程序。

注意：所有这一切仍然在躲避一个很大的潜在问题：当x 是一个data.frame 时，使用apply(x, 1, ...) 确实是一种冒险的做法。虽然它在这里工作（只是因为你的每个 data.frames 都是完全同质的），但它会在你最不期望的时候咬你。问题是 data.frames 允许您添加一个与其他类不同的列，因此如果您出于任何原因将一列字符串添加到您的 price 变量中，这些都将不再起作用。

此外，如果您没有进行一些健全性检查，这往往会有点崩溃。例如，强制要求 combinations 和 price 必须具有相同的维度，并且 winner 的长度必须与其他两个中的列数相同。