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

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 更改标题为「如何返回某一给定日期的前一个季度的最后一天的日期