如何返回某一给定日期的前一个季度的最后一天的日期

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

不过重复还不是最大的问题。就算重复，只要代码正确，也无大碍（歌词能正确表达出意思的话，也可以不必追求写成宋词）。最大的问题是楼上二位似乎还没有深入骨髓的向量化编程习惯。你们写的函数都是假定输入为单个日期。如果要处理多个日期，就得拿这个函数去对日期循环（*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，在这个条件下那确实是容易多了，否则按默认的画置信区间那可是有点麻烦。

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"

我也挖个坟

as.Date(cut(as.Date(c("2001-02-01", "2001-05-02")), "quarter"))-1
#> [1] "2000-12-31" "2001-03-31"

^{Created on 2020-07-24 by the reprex package (v0.3.0)}

frankzhang21 在下拜服 orz