WedX - журнал о программировании и компьютерных науках

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

У меня есть несколько дат, из которых я могу извлечь день месяца:

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

Я хотел бы отформатировать даты с суффиксами "th", "rd" или "nd" в зависимости от обстоятельств. Итак, «1-й», «2-й», «3-й» и т. д. Есть ли простой способ сделать это или мне придется перечислять правила?


Я могу реализовать это как поиск грубой силы:

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

но более элегантное решение приветствуется.

r
14.10.2016

  • @hrbrmstr Сделайте свой ответ, и я отмечу его как правильный. 24.10.2016

Ответы:


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
14.10.2016
  • вы можете сравнить производительность с scales::ordinal 14.10.2016
  • @hrbrmstr - кажется довольно быстрым 14.10.2016
  • в то время как ваш все равно будет быстрее, это не правильное сравнение 14.10.2016

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

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

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

    14.10.2016
  • Возможно, правки по какой-то причине не отображаются на моем компьютере, но я получаю 11-е, 12-е и 13-е. Возможно, потому что c(11,12,13) %% 10 %in% c(1,2,3) == TRUE для всех 3. 14.10.2016
  • Новые материалы

    Как создать диаграмму градиентной кисти с помощью D3.js
    Резюме: Из этого туториала Вы узнаете, как добавить градиентную кисть к диаграмме с областями в D3.js. Мы добавим градиент к значениям SVG и применим градиент в качестве заливки к диаграмме с..

    Я хотел выучить язык программирования MVC4, но не мог выучить его раньше, потому что это выглядит сложно…
    Просто начните и учитесь самостоятельно Я хотел выучить язык программирования MVC4, но не мог выучить его раньше, потому что он кажется мне сложным, и я бросил его. Это в основном инструмент..

    Лицензии с открытым исходным кодом: руководство для разработчиков и создателей
    В динамичном мире разработки программного обеспечения открытый исходный код стал мощной парадигмой, способствующей сотрудничеству, инновациям и прогрессу, движимому сообществом. В основе..

    Объяснение документов 02: BERT
    BERT представил двухступенчатую структуру обучения: предварительное обучение и тонкая настройка. Во время предварительного обучения модель обучается на неразмеченных данных с помощью..

    Как проанализировать работу вашего классификатора?
    Не всегда просто знать, какие показатели использовать С развитием глубокого обучения все больше и больше людей учатся обучать свой первый классификатор. Но как только вы закончите..

    Работа с цепями Маркова, часть 4 (Машинное обучение)
    Нелинейные цепи Маркова с агрегатором и их приложения (arXiv) Автор : Бар Лайт Аннотация: Изучаются свойства подкласса случайных процессов, называемых дискретными нелинейными цепями Маркова..

    Crazy Laravel Livewire упростил мне создание электронной коммерции (панель администратора и API) [Часть 3]
    Как вы сегодня, ребята? В этой части мы создадим CRUD для данных о продукте. Думаю, в этой части я не буду слишком много делиться теорией, но чаще буду делиться своим кодом. Потому что..


    Для любых предложений по сайту: [email protected]