应用具有时间元素的函数

时间:2018-05-14 09:10:19

标签: r apply lapply posixct

我有一个数据框显示很长时间框架的合同。我想做两个计算。

1)计算合约每个月的小时数,并将其乘以成本和数量 2)并获得每组数据帧中返回的数据。

数据:

df <- structure(list(Fromdate = structure(c(1388530800, 1388530800, 
1388530800, 1388530800, 1388530800, 1388530800, 1388530800, 1388530800, 
1388530800, 1420066800, 1388530800, 1388530800, 1388530800, 1388530800, 
1420066800), class = c("POSIXct", "POSIXt"), tzone = "CET"), 
    Todate = structure(c(1419980400, 1419980400, 1419980400, 
    1419980400, 1419980400, 1419980400, 1419980400, 1419980400, 
    1419980400, 1451516400, 1419980400, 1419980400, 1419980400, 
    1419980400, 1451516400), class = c("POSIXct", "POSIXt"), tzone = "CET"), 
    Cost = c(1.58, 1.58, 1.58, 1.58, 1.58, 1.58, 1.58, 1.58, 
    1.58, 1.58, 1.58, 1.58, 1.58, 1.58, 1.58), Quantity = c(0.112311303786473, 
    0.0205773161568493, 0.0493657482020549, 0.0437536029132876, 
    0.0278005475976713, 0.0295483138287671, 0.066499635323105, 
    0.066499635323105, 0.733925139981052, 0.733925139981051, 
    0.1067060088379, 0.436262087700001, 0.0667432627739724, 0.0925740588127852, 
    0.0925740588127855), Group = structure(c(1L, 1L, 1L, 1L, 
    1L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L), .Label = c("A", 
    "B", "C"), class = "factor")), class = "data.frame", row.names = c(NA, 
-15L))

1)我想做的计算只是对此的应用:

table(
  format(seq.POSIXt(df$Fromdate[1], to = df$Todate[1], by = "hour"), "%Y-%m")
) *  df$Cost[1] * df$Quantity[1]


2014-01  2014-02  2014-03  2014-04  2014-05  2014-06  2014-07  2014-08  2014-09  2014-10  2014-11  2014-12 
132.0242 119.2476 131.8467 127.7653 132.0242 127.7653 132.0242 132.0242 127.7653 132.2016 127.7653 127.9428 

但是,对于我的生活,我无法将其融入并应用,lapply或任何purrr功能。

2)最后,我还希望按组对其进行分组,因此最终结果应该是列表或数据框,其中包含各个月和每组的汇总成本。

这样的事情:

df %>% group_by(Group, month_year) %>% 
  summarise_each(table(
    format(
      seq.POSIXt("FromDate", "Todate", by = "hour")
      , "%Y-%m")  # this is month_year
    ) * Cost * Quantity )

或者更容易理解 - 最终结果应该是:(数字不正确)

  2014-01 2014-02 .... 2015-12
A   600     900     ...  1100
B   650     600     ...  1870
C   400     700     ...  990

1 个答案:

答案 0 :(得分:1)

对不起@NoThanks,但是这个东西变成了一个我没有时间去充分探索的兔子洞,所以这只会部分回答你的问题。

首先,我们将数据分为两个步骤(不同年份的第一步,由df$Fromdate表示,第二步为df$Group):

part1 <- split(df, df$Fromdate)
part2 <- lapply(part1, function(x) split(x, x$Group))

现在我们遍历最里面的列表元素,为每一行创建表格,按年份和组划分:

part3 <- lapply(part2, function(a) lapply(a, function(b) Map(function(w,x,y,z) table(format(seq.POSIXt(w, to = x, by = "hour"), "%Y-%m")
) *  y * z, b$Fromdate, b$Todate, b$Cost, b$Quantity)))

现在我们rbind几年内的小组。

part4 <- lapply(part3, function(x) lapply(x, function(y) do.call(rbind, y)))

现在我们需要从嵌套列表中删除可能的NULL个对象。我们使用了曾经在互联网上找到的一个方便的小功能:

rmNullObs <- function(x) {
  is.NullOb <- function(x) is.null(x) | all(sapply(x, is.null))
   x <- Filter(Negate(is.NullOb), x)
   lapply(x, function(x) if (is.list(x)) rmNullObs(x) else x)
}

part4 <- rmNullObs(part4)

现在我们rbind年:

part5 <- lapply(part4, function(x) do.call(rbind, lapply(x, function(y) colSums(y))))

离开我们:

> part5
$`2014-01-01`
    2014-01  2014-02   2014-03   2014-04   2014-05   2014-06   2014-07   2014-08   2014-09   2014-10   2014-11   2014-12
A  298.3570 269.4837  297.9560  288.7326  298.3570  288.7326  298.3570  298.3570  288.7326  298.7580  288.7326  289.1336
B 1053.8216 951.8389 1052.4052 1019.8274 1053.8216 1019.8274 1053.8216 1053.8216 1019.8274 1055.2380 1019.8274 1021.2438
C  825.5506 745.6586  824.4409  798.9199  825.5506  798.9199  825.5506  825.5506  798.9199  826.6602  798.9199  800.0295

$`2015-01-01`
   2015-01   2015-02  2015-03  2015-04  2015-05  2015-06  2015-07  2015-08  2015-09  2015-10  2015-11  2015-12
B 862.7437 779.25236 861.5841 834.9132 862.7437 834.9132 862.7437 862.7437 834.9132 863.9033 834.9132 836.0728
C 108.8227  98.29143 108.6764 105.3122 108.8227 105.3122 108.8227 108.8227 105.3122 108.9689 105.3122 105.4585

由于缺少公共列和缺少的组,将这些组合起来很棘手。我尝试过的一种可能的解决方案是通过NA循环手动为缺少的组添加for个已填充的行,但由于这在很大程度上取决于您的实际数据,因此您必须自己解决这个问题。或者只是与这些逐年比较一起工作。

希望它有所帮助。