R 如何对依赖于其他观察的 function 进行矢量化

Question

嗨，我有一个数据集如下：

set.seed(100)
library(microbenchmark)
City=c("City1","City2","City2","City1","City2","City1","City2","City1")
Business=c("B","A","B","A","C","A","E","F")
SomeNumber=c(35,20,15,19,12,40,36,28)
zz=data.frame(City,Business,SomeNumber)
zz_new=do.call("rbind", replicate(1000,zz, simplify = FALSE))
zz_new$BusinessMax=0 #Initializing final variable of interest at 0

我只是将 dataframe zz 的行复制 1000 次，以便稍后测量性能。

我还有一个自定义的 function 如下：

City1=function(full_data,observation){
  NewSet=full_data[which(full_data$City==observation$City & !full_data$Business==observation$Business),]
  NewSet2=max(NewSet$SomeNumber)
  return(NewSet2)
}

我想做的是将自定义 function 仅应用于 City==City1 的 zz_new 行。 我可以创建一个逻辑 object i1 存储特定行是否满足条件，如下所示：

i1 <- zz_new[["City"]] == "City1"

接下来，这是我需要帮助的地方，我编写了一个 for 循环（占用了这么长时间），如下所示：

for (i in 1:nrow(zz_new[i1,])){
  zz_new[i1,][i,"BusinessMax"]=City1(full_data=zz_new, observation = zz_new[i1,][i,])
}
zz_new[i1,]

上面的代码提供了正确的答案。 但是，它非常缓慢且效率低下。 我运行微基准并获得：

microbenchmark(
for (i in 1:nrow(zz_new[i1,])){
  zz_new[i1,][i,"BusinessMax"]=City1(full_data=zz_new, observation = zz_new[i1,][i,])
},times = 5)

      min       lq     mean   median       uq     max neval
 4.369269 4.400759 4.433388 4.401734 4.450246 4.54493     5

我应该如何 go 关于矢量化 function City1？ 在我的实际代码中，我需要在 function City1 中进行多个条件检查（这里我刚刚使用了两个列 City 和 Business 来对数据进行子集化，但我需要包含其他几个变量）。 SO 上的许多矢量化代码仅使用来自给定行的信息。 不幸的是，就我而言，我需要结合给定行和数据集的信息。 任何帮助将不胜感激。 提前致谢。

编辑1：

City1 功能说明：

首先，它创建一个子集，以保留那些观测值，其中提供的观测值的“城市”与数据集的城市相同。 从这个子集中，它会删除那些观察的“业务”与数据的“业务”相同的观察。 例如。 如果提供的观察的“城市”和“商业”分别是 City1 和 A，那么子集将只考虑那些具有 City == City1 和 Business 不等于 A 的观察。

我还需要为其他城市创建其他类似的功能。 但是如果有人可以帮助我对 City1 进行矢量化，我可以尝试对其他功能做同样的事情。

编辑2：

例如，我为 City == City2 编写了一个备用 function，如下所示：

City2=function(full_data,observation){
      NewSet=full_data[which(full_data$City==observation$City & full_data$Business==observation$Business),]
      NewSet2=max(NewSet$SomeNumber)-(10*rnorm(1))
      return(NewSet2)
    }

在上面的 function 中，请注意，与 City1 相比，我删除了“。” 来自 NewSet 的符号并从值 NewSet2 中减去 (-10*rnorm)。

接下来，我仅针对 City == City2 的观察结果运行它。

i2 <- zz_new[["City"]] == "City2"

for (i in 1:nrow(zz_new[i2,])){
  zz_new[i2,][i,"BusinessMax"]=City2(full_data=zz_new, observation = zz_new[i2,][i,])
}

Answer 1

这是一个快速版本，可以完成您的City1() for循环所做的事情。 看起来你想在每个城市都这样做，所以我这样做了。

library(data.table)
# convert to data table and set key for speed
zzdt = as.data.table(zz_new)
setkey(zzdt, City, Business)

# calculate the max for each business, by city, in City1 only
biz_max = zzdt[, .(BusinessMax = max(SomeNumber)), by = .(City, Business)]
# self-join the max values and filter out where the business match
# to get the max of other businesses within the same city
other_biz_max = 
  biz_max[biz_max, on = .(City), allow.cartesian = TRUE][
    Business != i.Business,
    .(BusinessMax = max(i.BusinessMax)),
    by = .(City, Business)
  ]
# join back to the original data
result = zzdt[other_biz_max]

如果我们只想将此应用于City == "City1" ，我们可以在第一步中进行过滤并使最终连接成为完全连接 - rest 保持不变。

library(data.table)
# convert to data table and set key for speed
zzdt = as.data.table(zz_new)
setkey(zzdt, City, Business)

# calculate the max for each business in City1
biz_max = zzdt[City == "City1", .(BusinessMax = max(SomeNumber)), by = .(City, Business)]
# self-join the max values and filter out where the business match
# to get the max of other businesses within the same city
other_biz_max = 
  biz_max[biz_max, on = .(City), allow.cartesian = TRUE][
    Business != i.Business,
    .(BusinessMax = max(i.BusinessMax)),
    by = .(City, Business)
  ]
# join back to the original data
result = merge(zzdt, other_biz_max, by = c("City", "Business"), all = TRUE)

在我的电脑上， data.table方法需要 0.03 秒，而你问题中的方法需要 10.28 秒，加速大约 300 倍。 我当时包括了 data.table 转换和密钥设置，但是如果您使用 data.table 并使用该密钥，您的代码的 rest 也可以加快速度。