在数据框中添加一列相应的季节答案

【问题标题】：Adding a column of corresponding seasons to dataframe在数据框中添加一列相应的季节
【发布时间】：2017-04-14 17:11:31
【问题描述】：

这是我的数据框的示例。我在 R 工作。

date          name       count
2016-11-12    Joe         5
2016-11-15    Bob         5
2016-06-15    Nick        12
2016-10-16    Cate        6

我想在我的数据框中添加一列，告诉我与日期对应的季节。我希望它看起来像这样：

date          name       count      Season
2016-11-12    Joe         5          Winter
2016-11-15    Bob         5          Winter
2017-06-15    Nick        12         Summer
2017-10-16    Cate        6          Fall

我已经开始了一些代码：

startWinter <- c(month.name[1], month.name[12], month.name[11])
startSummer <- c(month.name[5], month.name[6], month.name[7])
startSpring <- c(month.name[2], month.name[3], month.name[4])

# create a function to find the correct season based on the month
MonthSeason <- function(Month) {
  # !is.na()
 # ignores values with NA
  # match()
  # returns a vector of the positions of matches 
  # If the starting month matches a spring season, print "Spring". If the starting month matches a summer season, print "Summer" etc.  
  ifelse(!is.na(match(Month, startSpring)),
         return("spring"),
         return(ifelse(!is.na(match(Month, startWinter)),
                       "winter",
                       ifelse(!is.na(match(Month, startSummer)),
                              "summer","fall"))))
}

这段代码给了我一个月的季节。我不确定我是否以正确的方式解决这个问题。谁能帮我吗？谢谢！

【问题讨论】：

标签： r date time

【解决方案1】：

有一些技巧，它们的可用性取决于您是否要使用meteorological or astronomical seasons。我会提供两者，我认为它们提供了足够的灵活性。

我将使用您提供的第二个数据，因为它提供的不仅仅是“冬季”。

txt <- "date          name       count
2016-11-12    Joe         5
2016-11-15    Bob         5
2017-06-15    Nick        12
2017-10-16    Cate        6"
dat <- read.table(text = txt, header = TRUE, stringsAsFactors = FALSE)
dat$date <- as.Date(dat$date)

当季节严格按月定义时，最快的方法效果很好。

metseasons <- c(
  "01" = "Winter", "02" = "Winter",
  "03" = "Spring", "04" = "Spring", "05" = "Spring",
  "06" = "Summer", "07" = "Summer", "08" = "Summer",
  "09" = "Fall", "10" = "Fall", "11" = "Fall",
  "12" = "Winter"
)
metseasons[format(dat$date, "%m")]
#       11       11       06       10 
#   "Fall"   "Fall" "Summer"   "Fall"

如果您选择使用未按月份开始/停止定义的季节的日期范围，例如天文季节，这里还有另一个“技巧”：

astroseasons <- as.integer(c("0000", "0320", "0620", "0922", "1221", "1232"))
astroseasons_labels <- c("Winter", "Spring", "Summer", "Fall", "Winter")

如果您使用正确的 Date 或 POSIX 类型，那么您将包括年份，这会使事情变得不那么通用。人们可能会考虑使用儒略日期，但在闰年这会产生异常。因此，假设 2 月 28 日绝不是季节性边界，我将“数字化”月日。尽管 R 确实可以很好地进行字符比较，但 cut 需要数字，因此我们将它们转换为整数。

两个安全卫士：因为cut 要么是右开（和左闭），要么是右闭（和左开），那么我们的两个书挡需要扩展超越法定日期，即"0000" 和"1232"。还有其他技术可以在这里同样有效（例如，使用-Inf 和Inf，后集成）。

astroseasons_labels[ cut(as.integer(format(dat$date, "%m%d")), astroseasons, labels = FALSE) ]
# [1] "Fall"   "Fall"   "Spring" "Fall"

请注意，使用天文季节时第三个日期是在春季，否则是夏季。

此解决方案可以轻松调整以适应南半球或其他季节性偏好/信念。

编辑：受@Kristofersen's answer（谢谢）的启发，我研究了基准测试。 lubridate::month 使用 POSIXct-to-POSIXlt 转换来提取月份，这比我的 format(x, "%m") 方法快 10 倍以上。因此：

metseasons2 <- c(
  "Winter", "Winter",
  "Spring", "Spring", "Spring",
  "Summer", "Summer", "Summer",
  "Fall", "Fall", "Fall",
  "Winter"
)

注意到as.POSIXlt 返回基于 0 的月份，我们添加 1：

metseasons2[ 1 + as.POSIXlt(dat$date)$mon ]
# [1] "Fall"   "Fall"   "Summer" "Fall"

比较：

library(lubridate)
library(microbenchmark)
set.seed(42)
x <- Sys.Date() + sample(1e3)
xlt <- as.POSIXlt(x)

microbenchmark(
  metfmt = metseasons[ format(x, "%m") ],
  metlt  = metseasons2[ 1 + xlt$mon ],
  astrofmt = astroseasons_labels[ cut(as.integer(format(x, "%m%d")), astroseasons, labels = FALSE) ],
  astrolt  = astroseasons_labels[ cut(100*(1+xlt$mon) + xlt$mday, astroseasons, labels = FALSE) ],
  lubridate = sapply(month(x), seasons)
)
# Unit: microseconds
#       expr      min       lq       mean    median        uq       max neval
#     metfmt 1952.091 2135.157 2289.63943 2212.1025 2308.1945  3748.832   100
#      metlt   14.223   16.411   22.51550   20.0575   24.7980    68.924   100
#   astrofmt 2240.547 2454.245 2622.73109 2507.8520 2674.5080  3923.874   100
#    astrolt   42.303   54.702   72.98619   66.1885   89.7095   163.373   100
#  lubridate 5906.963 6473.298 7018.11535 6783.2700 7508.0565 11474.050   100

因此使用as.POSIXlt(...)$mon 的方法明显更快。（@Kristofersen 的答案可以通过矢量化来改进，也许使用ifelse，但这仍然无法与有或没有cut 的矢量查找的速度相比。）

【讨论】：

【解决方案2】：

如果你的数据是 df:

# create dataframe for month and corresponding season
dfSeason <- data.frame(season = c(rep("Winter", 3), rep("Summer", 3), 
rep("Spring", 3), rep("Fall", 3)),
                   month = month.name[c(11,12,1, 5:7, 2:4, 8:10)],
                   stringsAsFactors = F)

# make date as date
df$data <- as.Date(df$date)

# match the month of the date in df (format %B) with month in season
# then use it to index the season of dfSeason
df$season <- dfSeason$season[match(format(df$data, "%B"), dfSeason$month)]

【讨论】：

谢谢。当我尝试实现这一点时，季节列中有所有 NA。你知道为什么会这样吗？
我的错，match 中的dfSeason 应该是dfSeason$month

【解决方案3】：

您可以使用 lubridate 和将月份数字更改为季节的功能非常快速地完成此操作。

library(lubridate)

seasons = function(x){
  if(x %in% 2:4) return("Spring")
  if(x %in% 5:7) return("Summer")
  if(x %in% 8:10) return("Fall")
  if(x %in% c(11,12,1)) return("Winter")

}

dat$Season = sapply(month(dat$date), seasons)

> dat
        date name count Season
1 2016-11-12  Joe     5 Winter
2 2016-11-15  Bob     5 Winter
3 2016-06-15 Nick    12 Summer
4 2016-10-16 Cate     6   Fall

【讨论】：