R：将“th”、“rd”和“nd”添加到日期

Question

我有一些日期，我可以从中提取月份中的日期：

trimws(format(seq.Date(
  from = as.Date("2016-01-01"),
  to = as.Date("2016-10-01"), by = "day"), "%e"))

我想适当地使用后缀“th”、“rd”或“nd”来格式化日期。那么，“1st”、“2nd”、“3rd”等。有没有一种简单的方法可以实现这一点，还是我必须列举规则？

---

我可以将其实现为蛮力查找：

df_dates = data_frame(
  day = seq.int(31),
  suffix = c(
    "st",
    "nd",
    "rd",
    rep("th", 17),
    "st",
    "nd",
    "rd",
    rep("th", 7),
    "st"
  )
)

但更优雅的解决方案将受到欢迎。

Answer 1

这是一个 tidyverse 解决方案，使用矢量化 SQL 风格的 if-else 函数case_when。

library(dplyr)
library(lubridate)

append_date_suffix <- function(dates){
  dayy <- day(dates)
  suff <- case_when(dayy %in% c(11,12,13) ~ "th",
                    dayy %% 10 == 1 ~ 'st',
                    dayy %% 10 == 2 ~ 'nd',
                    dayy %% 10 == 3 ~'rd',
                    TRUE ~ "th")
  paste0(dayy, suff)
}

使用今天的日期对其进行测试

append_date_suffix(as.Date(-10:10, now()))

 [1] "4th"  "5th"  "6th"  "7th"  "8th"  "9th"  "10th" 
 [8] "11th" "12th" "13th" "14th" "15th" "16th" "17th"
[15] "18th" "19th" "20th" "21st" "22nd" "23rd" "24th"

根据要求，时间安排：

library(microbenchmark)
microbenchmark(scales::ordinal(as.Date(-1000:1000, now())),
               append_date_suffix(as.Date(-1000:1000, now())))

Unit: milliseconds
                                           expr      min        lq      mean    median        uq      max neval
    scales::ordinal(as.Date(-1000:1000, now())) 45.89437 46.408347 47.316820 46.734974 48.228251 53.14592   100
 append_date_suffix(as.Date(-1000:1000, now()))  1.39770  1.451481  1.549895  1.490646  1.530105  3.52757   100

要求的实际时间如下。我们没有测量as.Date() 的速度，我们需要确保两种方法输出相同的内容：

ads_cw <- function(dates){
  dayy <- day(dates)
  suff <- case_when(dayy %in% c(11,12,13) ~ "th",
                    dayy %% 10 == 1 ~ 'st',
                    dayy %% 10 == 2 ~ 'nd',
                    dayy %% 10 == 3 ~'rd',
                    TRUE ~ "th")
  paste0(dayy, suff)
}

ads_so <- function(dates) {
  dayy <- day(dates)
  scales::ordinal(dayy)
}

dates <- as.Date(-1000:1000, now())
microbenchmark(ads_cw(dates), ads_so(dates))
## Unit: milliseconds
##           expr      min       lq     mean   median       uq       max neval cld
##  ads_cw(dates) 1.226038 1.267377 1.526139 1.329442 1.505056  3.180228   100  a 
##  ads_so(dates) 7.270987 7.632697 8.275644 8.077106 8.816440 10.571275   100   b

答案代码仍然比scales::ordinal 快，但基准测试现在是诚实的。

值得注意的是，如果您只想使用数字向量进行比较，它仍然快 7 倍左右。

just_nums <- function(n){

  suff <- case_when(n %in% c(11,12,13) ~ "th",
                    n %% 10 == 1 ~ 'st',
                    n %% 10 == 2 ~ 'nd',
                    n %% 10 == 3 ~'rd',
                    TRUE ~ "th")
  paste0(n, suff)
}

microbenchmark(scales::ordinal(1:1000),
               just_nums(1:1000))

Unit: microseconds
                    expr      min       lq      mean   median       uq       max neval
 scales::ordinal(1:1000) 4411.144 4483.191 5055.2170 4560.647 4738.355 45206.038   100
       just_nums(1:1000)  666.407  687.305  788.3066  713.319  746.347  1808.943   100

Answer 2

这里有一点帮助：

getOrdinalNumber <- function(num) {
   result <- ""
  if (!(num %% 100 %in% c(11, 12, 13))) {
    result <- switch(as.character(num %% 10), 
                     "1" = {paste0(num, "st")}, 
                     "2" = {paste0(num, "nd")},
                     "3" = {paste0(num, "rd")},
                     paste0(num,"th"))
      } else {
        result <- paste0(num, "th")
      }
    result
}

该函数的工作方式如下：

num %% 100 表示 x mod y，因此您检查一个数字除以另一个数字后的余数。例如，21 %% 100 是 21。所以 21 不是 %in% c(11,12,13)，但 ! 声明 TRUE 并且 switch 参数添加了一个“st”

如果我们有num <- 11，第一个检查11 %% 100 是11，所以添加了一个“th”（所以我们在else 循环中）

这只是您的一个起点，因为您不仅可以使用此函数对单个数字执行此操作，还可以对整个向量执行此操作。 但这是你要做的工作:-)