• R语言已解决
  • 如何返回某一给定日期的前一个季度的最后一天的日期

比如,今天是2019-12-30,它的前一个季度是三季度,三季度的最后一天是2019-09-30,
同理,如果当天是2019-01-11, 则返回2018-12-31

chuxinyuan 更改标题为「如何返回某一给定日期的前一个季度的最后一天的日期
find_day <- function(x) {
  if(x > "2018-09-30" & x < "2018-12-31") return("2018-09-30")
  if(x > "2018-06-30" & x < "2018-09-30") return("2018-06-30")
  if(x > "2018-03-31" & x < "2018-06-30") return("2018-03-31")
  if(x < "2018-03-31") return("2018-12-31")
}

lapply(c("2018-12-30", "2018-02-30"), find_day)

# 我发现各个季度最后一天是固定的,不随闰年、平年变化,再传递一个年份参数进去就好了
# 跨年输入两个日期怎么办

    Cloud2016 谢谢你给的启发。

    library(stringr)
    find_day <- function(x) {
      report_year = as.numeric(str_sub(x, 1, 4))
      report_season = as.numeric(str_sub(x, 6, 7)) / 3
      if(ceiling(report_season) == 1) 
        return(paste(report_year -1, "12-31", sep = "-"))
      if(ceiling(report_season) == 2) 
        return(paste(report_year, "03-31", sep = "-"))
      if(ceiling(report_season) == 3) 
        return(paste(report_year, "06-30", sep = "-"))
      if(ceiling(report_season) == 4) 
        return(paste(report_year, "09-30", sep = "-"))
     }
    
     # 注:x的格式为`yyyy-mm-dd`
      chuxinyuan 更改标题为「【已解决】如何返回某一给定日期的前一个季度的最后一天的日期

      chuxinyuan 这下满足我了

      x <- as.Date(c("2018-01-12", "2017-12-23"))
      
      find_day <- function(x) {
        switch(quarters(x),
          Q4 = paste(format(x, "%Y"), "09-30", sep = "-"),
          Q3 = paste(format(x, "%Y"), "06-30", sep = "-"),
          Q2 = paste(format(x, "%Y"), "03-31", sep = "-"),
          Q1 = paste(as.numeric(format(x, "%Y")) - 1, "12-31", sep = "-")
        )
      }
      
      sapply(x, find_day)

        这篇帖子是个不错的教学示例,因为代码风格太典型了:多数人都容易把代码写成歌词风格(复沓)。读着这样的代码总让我耳边响起:祝你生日快乐,祝你生日快乐,祝你生日快乐【谁谁谁】,祝你生日快乐。一眼望去,同一句代码一直在重复,但可能每次重复都有点小变动(儿童故事也常常是这个风格)。如果类似的代码多次重复,那么是时候考虑抽象的可能性了。

        不过重复还不是最大的问题。就算重复,只要代码正确,也无大碍(歌词能正确表达出意思的话,也可以不必追求写成宋词)。最大的问题是楼上二位似乎还没有深入骨髓的向量化编程习惯。你们写的函数都是假定输入为单个日期。如果要处理多个日期,就得拿这个函数去对日期循环(*apply() 也是循环)。若我来写,我会这样写:

        last_quarter_day = function(dates) {
          dates = as.Date(dates)
          Y = as.integer(format(dates, '%Y'))
          Q = quarters(dates)
          D = c(Q1 = '12-31', Q2 = '03-31', Q3 = '06-30', Q4 = '09-30')[Q]
        
          i = Q == 'Q1'; Y[i] = Y[i] - 1
        
          as.Date(sprintf('%d-%s', Y, D))
        }

        每一步操作都走是向量化的高速公路,我不必对输入日期的长度作出限制,而且跑起来还快一些。楼上制约住 chuxinyuan 的是 if () 不可向量化(逻辑条件只能接受单值),制约住 Cloud2016 的是 switch() 也只能接受单值。这就像走一段高速,再下来走一段狭窄的土路,再上高速一样。

        其它小问题如毫无必要的 stringr 依赖已经被 Cloud2016 指出来;另外就是二楼的 & 应该用 &&

          yihui 确实确实,我其实过了会也感觉到自己代码冗余度有点惊人,但是自己抽象能力不够,且对向量化编程了解不深,这一点该怎么提升?

          举个栗子

          我早些时候 开贴 解决了 “plot 函数的 xlab 和 ylab 的参数设置是否不一样” 的问题,优化之后代码如下

          data(anscombe)
          form <- paste(paste0("y", seq(4)), paste0("x", seq(4)), sep = "~")
          fit <- lapply(form, lm, data = anscombe)
          op <- par(mfrow = c(2, 2), mar = 0.1 + c(4, 4, 1, 1), oma = c(0, 0, 2, 0))
          for (i in 1:4) {
            plot(as.formula(form[i]),
              data = anscombe, col = "black",
              pch = 19, cex = 1.2,
              xlim = c(3, 19), ylim = c(3, 13),
              xlab = as.expression(substitute(bold(x[i]), list(i = i))),
              ylab = as.expression(substitute(bold(y[i]), list(i = i)))
            )
            abline(fit[[i]], col = "red", lwd = 2)
            text(7, 12, bquote(bold(R)^2 == .(round(summary(fit[[i]])$r.squared, 3))))
          }
          mtext("Anscombe's 4 Regression data sets", outer = TRUE, cex = 1.2)
          par(op)

          最近我把它用 ggplot2 重画

          library(ggplot2)
          library(patchwork)
          data(anscombe)
          
          ## 想去掉的两行冗余代码 
          form <- paste(paste0("y", seq(4)), paste0("x", seq(4)), sep = "~")
          fit <- lapply(form, lm, data = anscombe)
          
          anscombe_lm <- function(i) {
            p <- ggplot(data = anscombe, aes_string(x = paste0("x", i), y = paste0("y", i))) +
              geom_point() +
              geom_smooth(method = "lm", formula = "y~x", se = FALSE, colour = "red") +
              theme_minimal() +
              labs(
                x = substitute(bold(x[i]), list(i = i)), y = substitute(bold(y[i]), list(i = i)),
                title = bquote(bold(R)^2 == .(round(summary(fit[[i]])$r.squared, 3)))
              )
            p
          }
          
          Reduce("+", lapply(1:4, anscombe_lm))

          想半天,硬是没想明白怎么去掉上面标注的两行冗余代码(因为它又做了一次线性回归),现在想来可能还有其它冗余的地方,geom_smooth() 做了线性回归这件事,我却不知道怎么提取回归的结果画在图上

            或许是我提问的方式就不够优雅,我应该给出一个向量,问如何返回另一个向量。

            Cloud2016 这个例子要复杂得多,要避免重复回归会有点难。我上面说的是那种光看代码形式不看计算的内容,肉眼扫一遍,形式上就在一遍遍重复的代码通常有抽象的可能。

            不过这里又出来一个有趣的问题:

            form <- paste(paste0("y", seq(4)), paste0("x", seq(4)), sep = "~")

            你又在使步枪一颗一颗地打子弹:为了拼出四个公式,先拼出因变量,再拼出自变量,再用波浪线连接。其实可以一口气打一梭子子弹嘛:

            form <- sprintf('y%d ~ x%d', 1:4, 1:4)

              yihui 我刚换了个思路,去掉 geom_smooth() 函数,保留那两行代码,似乎逻辑上就合理了,前面做回归,后面画图。

              plot_lm <- function(i) {
                p <- ggplot(data = anscombe, aes_string(x = paste0("x", i), y = paste0("y", i))) +
                  geom_point() +
                  geom_abline(intercept = coef(fit[[i]])[1], slope = coef(fit[[i]])[2], color = "red") +
                  theme_minimal() +
                  labs(
                    x = substitute(bold(x[i]), list(i = i)), y = substitute(bold(y[i]), list(i = i)),
                    title = bquote(bold(R)^2 == .(round(summary(fit[[i]])$r.squared, 3)))
                  )
                p
              }

                看到此贴,不禁让我想起了实验室的同学几年前讲过的编程冷笑话:

                「我小学的时候就写过 10 万行代码了 —— 直到我学会了 for 循环」。

                Cloud2016 我刚才没注意到你用了 se = FALSE,在这个条件下那确实是容易多了,否则按默认的画置信区间那可是有点麻烦。

                7 个月 后

                yihui
                老大,这样写会不会清晰一些?

                last_quarter_day_j = function(dates) {
                  dates = as.Date(dates)
                  year = as.integer(format(dates, '%Y'))
                  quarter = as.numeric(substr(quarters(dates),2,2) ) #return quarter
                  day = c('12-31', '03-31', '06-30', '09-30')[quarter]
                  for(i in quarter){
                  if(i == 1) year[i] <- year[i] -1
                  }
                  return(as.Date(sprintf('%d-%s',year , day)) )
                }

                输入的话也可以是一串日期:

                > last_quarter_day_j(c("2001-02-01", "2001-05-02") ) 
                [1] "2000-12-31" "2001-03-31"

                  frankzhang21 长跪不起……你赢了。

                  Jiena 这个 for 循环好像没必要啊,这车又开出了向量化的高速公路。

                  for (i in quarter) {
                    if(i == 1) year[i] <- year[i] -1
                  }

                  写成这样

                  year[quarter == 1] <- year[quarter == 1] -1

                  或者我上面那样把 quarter ==1 的结果赋值给变量 i 免得写两遍,都可以。

                  10 个月 后
                  chuxinyuan 更改标题为「如何返回某一给定日期的前一个季度的最后一天的日期