R: добавить th, rd и nd к датам

Вот решение 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

Вот небольшая помощь:

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 по модулю y, поэтому вы проверяете остаток после деления одного числа на другое. Так, например, 21 %% 100 равно 21. Таким образом, 21 НЕ является %in% c(11,12,13), но ! делает утверждение TRUE, а аргумент switch добавляет "st"

Если у нас есть num <- 11, первая проверка 11 %% 100 равна 11, поэтому добавляется «th» (так что мы находимся в цикле else)

Это всего лишь отправная точка для вас, потому что вы можете использовать эту функцию, чтобы делать это не только для отдельных чисел, но и для целых векторов. Но это ваша работа :-)