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