带有 data.table 的矢量化函数

Question

我正在尝试编写矢量化函数。这是使用 data.frame “final”的伪代码。 BID_AMOUNT/Duration * Probability * bill_factor

其中 bill_factor 是从 data.frame “schedule”中检索的。每行的 bill_factor 由 Duration 和 Number_Sequence 标识。对于第 1 行，这将是 schedule[3,1]。对于第 2 行，这将是 schedule[3,2] 等。

这似乎是一个迭代问题，可以使用其中一个 apply 函数来解决。我还考虑过使用 purrr 包中的函数 map2。我什么都做不了。

预期结果：我想要一个函数，它可以从时间表中检索 Duration/Number_Sequence 的任意组合的数据。

任何帮助将不胜感激。

• BS

library(data.table)
#create data
data <- structure(list(OPPORTUNITY_ID = c(28249800L, 28249800L, 28249800L,28249845L, 28249845L, 28249845L, 28249845L, 28312677L, 28312677L,28312677L, 28312677L, 28312677L)
               , Number_Sequence = c(1L, 2L, 3L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 5L)
               , BID_AMOUNT = c(1700000, 1700000, 1700000, 2250000, 2250000, 2250000, 2250000, 1100000, 1100000, 1100000, 1100000, 1100000)
               , Probability = c(30L, 30L, 30L, 20L, 20L, 20L, 20L, 50L, 50L, 50L, 50L, 50L), Duration = c(3L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L))
          , row.names = c(NA, -12L), class = c("data.table", "data.frame")
          , sorted = "OPPORTUNITY_ID")

#reorder and clean up column names. 
setcolorder(data, c('OPPORTUNITY_ID', 'BID_AMOUNT', 'Probability', 'Duration'))
data$Probability <- data$Probability/100

#create column bill_factor
data$bill_factor <-  c(rep(.33,3), rep(.25, 4), rep(.2, 5))

#create schedule of payments
schedule <- structure(list(`0` = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L,11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, NA, NA, NA, NA),
               `1` = c(1, 0.5, 0.33, 0.25, 0.2, 0.17, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.02, NA, NA, NA, NA)
               , `2` = c(NA, 0.5, 0.33, 0.25, 0.2, 0.17, 0.15, 0.1, 0.1, 0.1, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.03, 0.03, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `3` = c(NA, NA, 0.33, 0.25, 0.2, 0.17, 0.25, 0.2, 0.15, 0.1, 0.1, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `4` = c(NA, NA, NA, 0.25, 0.2, 0.17, 0.25, 0.25, 0.25, 0.15, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.08, 0.05, 0.05, 0.05, 0.05, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `5` = c(NA, NA, NA, NA, 0.2, 0.17, 0.15, 0.15, 0.15, 0.2, 0.2, 0.15, 0.1, 0.1, 0.1, 0.1, 0.1, 0.08, 0.08, 0.08, 0.05, 0.05, 0.05, 0.03, NA, NA, NA, NA)
               , `6` = c(NA, NA, NA, NA, NA, 0.17, 0.1, 0.1, 0.1, 0.1, 0.1, 0.2, 0.2, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.08, 0.05, 0.05, 0.05, 0.05, NA, NA, NA, NA)
               , `7` = c(NA, NA, NA, NA, NA, NA, 0.05, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.15, 0.15, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.05, 0.05, NA, NA, NA, NA)
               , `8` = c(NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.15, 0.15, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.05, NA, NA, NA, NA)
               , `9` = c(NA, NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.1, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.1, 0.08, 0.08, 0.1, 0.1, 0.1, 0.08, NA, NA, NA, NA)
               , `10` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.08, 0.08, 0.08, 0.08, 0.1, NA, NA, NA, NA)
               , `11` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.08, 0.1, NA, NA, NA, NA)
               , `12` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.08, NA, NA, NA, NA)
               , `13` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, NA, NA, NA, NA)
               , `14` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.05, 0.05, 0.03, 0.03, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, NA, NA, NA, NA)
               , `15` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.05, 0.05, 0.05, NA, NA, NA, NA)
               , `16` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.05, NA, NA, NA, NA)
               , `17` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `18` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `19` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `20` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `21` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `22` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, 0.03, NA, NA, NA, NA)
               , `23` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.03, 0.03, NA, NA, NA, NA)
               , `24` = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.01, NA, NA, NA, NA)
               , Total = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, NA, NA, NA, NA))
          , row.names = c(NA, -28L), class = c("data.table", "data.frame"))
schedule <- schedule[,!26]
schedule <- schedule[,!1]

#set colnames to 1 indexing
colnames(schedule) = as.character(c(1:24))

#create results column
results <- data[,.(result = BID_AMOUNT/Duration*Probability*bill_factor), by=OPPORTUNITY_ID]



final <- cbind(data,results)
final <- final[,!7]

Answer 1

您可以使用 apply 函数在数据框中创建 bill_factor 列。只需将 schedule 作为额外参数传递给 apply 函数即可：

data$bill_factor <- apply(data, 
                          1, 
                          function(x, s) s[[x["Duration"], x["Number_Sequence"]]], 
                          s=schedule)