R：将一年的日期分成 2 个月的分箱会产生 7 个分箱而不是 6 个？

Question

我正在尝试使用 R 中的 cut() 函数将一年的日期分成 6 个两个月的 bin。当我这样做时，它会生成 7 个箱子而不是 6 个，最后一个箱子是空的。我正在使用以下代码：

dates <- seq(as.Date("2021-1-1"),as.Date("2021-12-31"),by="day")
months <- cut(dates,"month",labels=1:12)
table(months)
# months
#  1  2  3  4  5  6  7  8  9 10 11 12 
# 31 28 31 30 31 30 31 31 30 31 30 31 
sextiles <- cut(dates,"2 months",labels=1:6)
# Error in cut.default(unclass(x), unclass(breaks), labels = labels, right = right,  : 
#   lengths of 'breaks' and 'labels' differ
sextiles <- cut(dates,"2 months",labels=1:7)
table(sextiles)
# sextiles
#  1  2  3  4  5  6  7 
# 59 61 61 62 61 61  0

当我将一年划分为单个月的 bin 时代码工作正常，但当我划分为 2 个月的 bin 时会产生错误，除非我在 labels 参数中考虑 7 个 bin 而不是 6 个。如果我从年末开始删除日期，代码最终会在删除一年的最后 3 天后使用 6 个 bin：

dates_364 <- dates[-length(dates)]
sextiles <- cut(dates_364,"2 months",labels=1:6)
# Error in cut.default(unclass(x), unclass(breaks), labels = labels, right = right,  : 
#   lengths of 'breaks' and 'labels' differ
dates_363 <- dates_364[-length((dates_364))]
sextiles <- cut(dates_363,"2 months",labels=1:6)
# Error in cut.default(unclass(x), unclass(breaks), labels = labels, right = right,  : 
#   lengths of 'breaks' and 'labels' differ
dates_362 <- dates_363[-length((dates_363))]
sextiles <- cut(dates_362,"2 months",labels=1:6)
table(sextiles)
# sextiles
#  1  2  3  4  5  6 
# 59 61 61 62 61 58

这似乎是函数中的错误。任何人都可以阐明我所缺少的东西吗？谢谢！

Answer 1

有两种方法可以为数字范围定义“bins”，以便所有提供的数字都在其中一个 bins 中：

找到最小值，找到最大值，因为 Date-bins 通常是 right=FALSE 意思是右开，将最大值凸出一点；或
找到最小值，并且不找到最大值，而是使用Inf以便它始终包含最大值。

cut.Date选择了两者中的第一个。此外，它没有选择“从最大值跳出 1 天”，而是选择“跳出 'step'”。这意味着当您说 "2 months" 时，它将确保下一个 bin“边缘”距离倒数第二个边界 2 个月。

即，如果您查看 cut.Date 的来源：

        start <- as.POSIXlt(min(x, na.rm = TRUE))
# ...
            end <- as.POSIXlt(max(x, na.rm = TRUE))
# and then if 'months', then
            end <- as.POSIXlt(end + (31 * step * 86400))
# and eventually
            breaks <- as.Date(seq(start, end, breaks))

所以我会 debug(cut.Date) 看看 cut(dates, "2 months"):

start
# [1] "2021-01-01 UTC"
# debug: end <- as.POSIXlt(max(x, na.rm = TRUE))
# debug: step <- if (length(by2) == 2L) as.integer(by2[1L]) else 1L
end
# [1] "2021-12-31 UTC"
step
# [1] 2

# debug: as.integer(by2[1L])
# debug: end <- as.POSIXlt(end + (31 * step * 86400))
end
# [1] "2022-03-03 UTC"

# debug: end$mday <- 1L
# debug: end$isdst <- -1L
# debug: breaks <- as.Date(seq(start, end, breaks))
breaks
# [1] "2021-01-01" "2021-03-01" "2021-05-01" "2021-07-01" "2021-09-01" "2021-11-01" "2022-01-01"
# [8] "2022-03-01"

然后它最终会 breaks[-length(breaks)]，这就解释了为什么我们看不到 8。我的猜测是，在极端情况下（也许是闰年？），31 * step * 86400（或其他 by-单位）并不总是完美对齐，因此他们对其进行了一些缓冲。

长话短说（太晚了），我建议你改用labels=FALSE。

sextiles <- cut(dates, "2 months", labels = FALSE)
table(sextiles)
# sextiles
#  1  2  3  4  5  6 
# 59 61 61 62 61 61

如果你想让它们看起来像整数 factors（这是字符串级别，下面是真正的整数），那么也许

sextiles <- factor(sextiles)
head(sextiles)
# [1] 1 1 1 1 1 1
# Levels: 1 2 3 4 5 6

Answer 2

感谢@r2evans 提供的见解，我找到了问题的答案。

cut.Date 函数的代码中存在错误。第 31 到 41 行处理中断以月为单位的情况：

if (valid == 3L) {
  start$mday <- 1L
  start$isdst <- -1L
  end <- as.POSIXlt(max(x, na.rm = TRUE))
  step <- if (length(by2) == 2L) 
    as.integer(by2[1L])
  else 1L
  end <- as.POSIXlt(end + (31 * step * 86400))
  end$mday <- 1L
  end$isdst <- -1L
  breaks <- as.Date(seq(start, end, breaks))

第 38 行，end <- as.POSIXlt(end + (31 * step * 86400)) 将提前结束时间调整为 31 天乘以步长或每个 bin 中的月数。因为并非所有月份都有 31 天，所以在某些情况下，末尾会被推得足够远以创建一个多余的垃圾箱。这可以很容易地用几行代码来纠正，正如我们在休息时间为四分之一的情况中看到的那样。参见第 57 行到第 75 行：

else if (valid == 5L) {
  qtr <- rep(c(0L, 3L, 6L, 9L), each = 3L)
  start$mon <- qtr[start$mon + 1L]
  start$mday <- 1L
  start$isdst <- -1L
  maxx <- max(x, na.rm = TRUE)           # Note this line
  end <- as.POSIXlt(maxx)                # Note this line
  step <- if (length(by2) == 2L) 
    as.integer(by2[1L])
  else 1L
  end <- as.POSIXlt(end + (93 * step * 86400))
  end$mon <- qtr[end$mon + 1L]
  end$mday <- 1L
  end$isdst <- -1L
  breaks <- as.Date(seq(start, end, paste(step * 3L, 
                                          "months")))
  lb <- length(breaks)                   # Note this line
  if (maxx < breaks[lb - 1])             # If extra bin
    breaks <- breaks[-lb]                # Then remove extra bin

如果我们采用相同的方法并修改处理 breaks="months" 的代码部分：

if (valid == 3L) {
  start$mday <- 1L
  start$isdst <- -1L
  maxx <- max(x, na.rm = TRUE)     # Line added
  end <- as.POSIXlt(maxx)          # Line modified
  step <- if (length(by2) == 2L) 
    as.integer(by2[1L])
  else 1L
  end <- as.POSIXlt(end + (31 * step * 86400))
  end$mday <- 1L
  end$isdst <- -1L
  breaks <- as.Date(seq(start, end, breaks))
  lb <- length(breaks)             # Line added
  if (maxx < breaks[lb - 1])       # Line added
    breaks <- breaks[-lb]          # Line added

将修改后的函数存入cut_Date，我们得到：

dates <- seq(as.Date("2021-1-1"),as.Date("2021-12-31"),by="day")
sextiles <- cut(dates,"2 months",labels=1:6)
# Error in cut.default(unclass(x), unclass(breaks), labels = labels, right = right,  : 
#   lengths of 'breaks' and 'labels' differ
sextiles <- cut_Date(dates,"2 months",labels=1:6)
table(sextiles)
# sextiles
#  1  2  3  4  5  6 
# 59 61 61 62 61 61

错误已修复！

R：将一年的日期分成 2 个月的分箱会产生 7 个分箱而不是 6 个？

R: Cutting a year of dates into 2 month bins yields 7 bins instead of 6?

r

date

cut

bins