R：添加「日」，「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」。所以，「第一」，「第二」，「第三」等是否有一個簡單的方法來實現這一點，或者我將不得不列舉規則？

---

我可以實現這個作爲蠻力查找：

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

這裏是一個小的幫助：

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，因此一個「日」是添加（所以我們在else循環）

這僅僅是一個起點，因爲你可以使用這個函數來做到這一點，不僅是單個數字，而是整個向量。 但是，這是你的工作要做:-)

Answer 2

這是一個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