具有data.table的矢量化功能

debugcn 发表于 Dev

布赖恩·斯克鲁格斯

我正在尝试编写向量化函数。这是使用data.frame“ final”的伪代码。BID_AMOUNT /持续时间*概率* bill_factor

从data.frame“时间表”中检索bill_factor的位置。每行的bill_factor由Duration和Number_Sequence标识。对于第1行，这将是schedule [3,1]。对于第2行，这将是schedule [3,2]，依此类推。

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

预期结果：我想要一个函数，该函数将从Schedule中获取Duration / Number_Sequence的任意组合的数据。

任何帮助将不胜感激。

学士学位

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]

Lumartor

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

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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。