- 已编辑
比如,今天是2019-12-30
,它的前一个季度是三季度,三季度的最后一天是2019-09-30
,
同理,如果当天是2019-01-11
, 则返回2018-12-31
。
比如,今天是2019-12-30
,它的前一个季度是三季度,三季度的最后一天是2019-09-30
,
同理,如果当天是2019-01-11
, 则返回2018-12-31
。
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 有个简单的函数 substr()
可以去掉那坨 stringr 的依赖,效果一样
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()
做了线性回归这件事,我却不知道怎么提取回归的结果画在图上
或许是我提问的方式就不够优雅,我应该给出一个向量,问如何返回另一个向量。
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 循环」。
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"
<sup>Created on 2020-07-24 by the reprex package (v0.3.0)</sup>
frankzhang21 在下拜服 orz
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
免得写两遍,都可以。