为每个日期创建时间块并填充存在数据答案

【问题标题】：Creating time blocks for each date and populating presence data为每个日期创建时间块并填充存在数据
【发布时间】：2020-11-20 09:45:27
【问题描述】：

我正在尝试为我的数据集中从晚上 19:45:00 到早上 06:30:00 的数据集中的每个日期创建一个包含 15 分钟时间块的数据集。然后我试图计算一个物种在每个时间段中存在/不存在的次数，必须按地点、日期、15 分钟时间段对其进行分组。我在多个晚上拥有多个站点。

我已经能够按小时等对数据进行分组，但这并不能解决它仅在物种存在时才计数并且在物种不存在时不会创建 0（因为没有时间戳）。

示例数据如下。如果需要，我可以提供更多数据。

Site <- ("1831", "1803", "1803", "1807", "1807", "1807", "1807")
Date <- as.Date("05/05/2013", "06/05/2013", "06/05/2013", "06/05/2013", "06/05/2013", "08/05/2013", "08/05/2013")
Time <- c("23:31:29", "22:22:57", "22:04:47", "22:58:45", "01:24:15", "22:04:47")
Present <- as.numeric("1", "1", "0", "1","0", "1", "1")
data <- data.frame(Site, Date, Time, Present)

当前列中有一些 0 的原因是探测器触发了，但不是我们要寻找的物种。

理论上，对于示例中的第一个日期和站点，它应该看起来像这样（但对于每个站点和其中的多个日期）：

【问题讨论】：

我有几个问题。您提供的示例数据不构成数据框，元素具有不同的长度。您能否提供另一个示例，可能使用 structure() 或 dput() 命令？您提供的时间间隔不是 15 分钟。如果您的原始数据看起来像您提供的图片，您可以使用聚合函数，如下所示：aggregate(cbind(Present = Present) ~ Date + Site + Time, data = data, function(x) }{NROW(x )})

标签： r database date time datatable

【解决方案1】：

如果您使用lubridate 包及其floor_date 函数，您可以向下舍入到最接近的15 分钟。这允许您将left_join 的数据添加到由grid.expand 获得的所有站点的所有时间的完整列表中。

您的数据不可重现，因为生成它的代码包含一些错误 - 我不得不稍微更改代码以将数据放入连贯的数据框中。以下应使数据可重现：

library(lubridate)
library(dplyr)

Site    <- c("1831", "1803", "1803", "1807", "1807", "1807", "1807")
Date    <- dmy(c("05/05/2013", "06/05/2013", "06/05/2013", "06/05/2013", 
              "06/05/2013", "08/05/2013", "08/05/2013"))
Time    <- c("23:31:29", "22:22:57", "22:04:47", "22:58:45", "01:24:15", 
          "22:04:47", "03:45:02")
Present <- as.numeric(c("1", "1", "0", "1","0", "1", "1"))
data    <- data.frame(Site, Date, Time, Present)

我做的第一件事是将日期和时间合并成统一的日期时间，以使左连接更容易，并将它们四舍五入到最接近的 15 分钟：

data$date_time <- floor_date(as.POSIXct(paste(data$Date, data$Time)),
                             "15 minutes")

接下来，我们通过从您的数据中获取每个日期并为每个日期添加从 19:45 到第二天早上 06:30 的 15 分钟序列来获取所有可能的时间：

all_times <- do.call(c, sapply(unique(data$Date), 
                               function(x) x +  minutes(15) * seq(75, 118, 1)))

现在为了方便左连接，我们可以从data 中删除我们不再需要的列：

data <- data[, c("Site", "date_time", "Present")]

接下来我们创建一个数据框，其中包含所有站点所有时间的列：

df <- expand.grid(date_time = all_times, Site = unique(data$Site))[2:1]
df$date_time <- as.POSIXct(df$date_time)

最后，我们将数据加入到这个新的数据框中，用 1 填充生成的 NA 值：

df <- left_join(df, data, by = c("Site", "date_time")) 
df$Present[is.na(df$Present)] <- 0

我们生成的数据框有 396 行长，所以我在这里只显示前 20 行：

head(df, 20)
#>    Site           date_time Present
#> 1  1831 2013-05-05 19:45:00       0
#> 2  1831 2013-05-05 20:00:00       0
#> 3  1831 2013-05-05 20:15:00       0
#> 4  1831 2013-05-05 20:30:00       0
#> 5  1831 2013-05-05 20:45:00       0
#> 6  1831 2013-05-05 21:00:00       0
#> 7  1831 2013-05-05 21:15:00       0
#> 8  1831 2013-05-05 21:30:00       0
#> 9  1831 2013-05-05 21:45:00       0
#> 10 1831 2013-05-05 22:00:00       0
#> 11 1831 2013-05-05 22:15:00       0
#> 12 1831 2013-05-05 22:30:00       0
#> 13 1831 2013-05-05 22:45:00       0
#> 14 1831 2013-05-05 23:00:00       0
#> 15 1831 2013-05-05 23:15:00       0
#> 16 1831 2013-05-05 23:30:00       1
#> 17 1831 2013-05-05 23:45:00       0
#> 18 1831 2013-05-06 00:00:00       0
#> 19 1831 2013-05-06 00:15:00       0
#> 20 1831 2013-05-06 00:30:00       0

^{由reprex package (v0.3.0) 于 2020 年 7 月 30 日创建}

【讨论】：

【解决方案2】：

这是一个使用来自data.table 的非等连接的选项：

library(data.table)
#generate intervals
ans <- setDT(data)[, {
    s <- c(seq(as.POSIXct(paste(d, "00:00:00")), as.POSIXct(paste(d, "06:15:00")), "15 mins"),
        seq(as.POSIXct(paste(d, "19:45:00")), as.POSIXct(paste(d, "23:45:00")), "15 mins"))
    .(s=s, e=s+15*60)
}, .(Site, d=as.Date(Date))]

#non-equi join and update by reference
ans[, p := 
    data[Present==1L][.SD, on=.(Site, Date>=s, Date<=e), by=.EACHI, sum(Present, na.rm=TRUE)]$V1
]

ans[p==1L] 的输出

   Site          d                   s                   e p
1: 1831 2013-05-05 2013-05-05 23:30:00 2013-05-05 23:45:00 1
2: 1803 2013-06-05 2013-06-05 22:15:00 2013-06-05 22:30:00 1
3: 1807 2013-06-05 2013-06-05 22:45:00 2013-06-05 23:00:00 1
4: 1807 2013-08-05 2013-08-05 21:00:00 2013-08-05 21:15:00 1
5: 1807 2013-08-05 2013-08-05 22:00:00 2013-08-05 22:15:00 1

数据：

   Site                Date Present
1: 1831 2013-05-05 23:31:29       1
2: 1803 2013-06-05 22:22:57       1
3: 1803 2013-06-05 22:04:47       0
4: 1807 2013-06-05 22:58:45       1
5: 1807 2013-06-05 01:24:15       0
6: 1807 2013-08-05 22:04:47       1
7: 1807 2013-08-05 21:04:47       1

数据代码：

Site <- c("1831", "1803", "1803", "1807", "1807", "1807", "1807")
Date <- as.POSIXct(paste(c("05/05/2013", "06/05/2013", "06/05/2013", "06/05/2013", "06/05/2013", "08/05/2013", "08/05/2013"),
        c("23:31:29", "22:22:57", "22:04:47", "22:58:45", "01:24:15", "22:04:47", "21:04:47")),
    format="%m/%d/%Y %T")
Present <- as.integer(c(1, 1, 0, 1,0, 1, 1))
data <- data.frame(Site, Date, Present)

【讨论】：

我设法创建了“ans”数据，但连接对我不起作用。不过，我设法以另一种方式加入数据。感谢您的帮助。
你能举一些它不工作的例子吗？