Как преобразовать слова в дату?

Question

У меня есть дата дат в этом формате: 4 дня назад, 6 недель назад, 8 месяцев назад, 1 год назад.

Я хочу написать заявление, которое сначала проверяет, является ли это месяц, неделя, год.Затем он извлекает номер.После этого я делаю соответствующий расчет, вычитая из Sys.Date ().Я пробовал пару разных способов и не могу заставить его работать.

Есть ли какой-нибудь шанс, что вы можете мне помочь с одним, и я могу найти отдых?

Заранее спасибо.

Answer 1

Помогает ли вам эта грубая функция?Это должно работать даже для таких строк, как "3 years, 2 months ago".Возвращает NA, если month, year или day не отображаются в строке с цифрой впереди.

library("stringr")

# Small helper function to convert NAs to zero and convert to numeric
na_to_zero <- function(x) { 
  x[is.na(x)] <- "0"
  return(as.numeric(x))
}

get_date_before_today <- function(d) {
  today <- Sys.Date()

  days   <- na_to_zero(str_extract(d, "(?i)[0-9]*(?= day\\D)"))
  months <- na_to_zero(str_extract(d, "(?i)[0-9]*(?= month\\D)"))
  years  <- na_to_zero(str_extract(d, "(?i)[0-9]*(?= year\\D)"))

  days_ago <- days + 365.25/12*months + 365.25*years
  date_before_today <- today - days_ago

  # If no matches were made, zeros are substituted for all, and hence days_ago is 0
  date_before_today[days_ago == 0] <- NA  

  return(date_before_today)
 }

Проверка:

d <- c("4 months ago asds", "2 years ago", "1 day ago", "5 years, 3 months", "never")

get_date_before_today(d)
#[1] "2018-05-15" "2016-09-13" "2018-09-13" "2013-06-14" NA    

Примечание,это не дает вам точных дат как таковых.Но, думаю, можно утверждать, что, например, 1 месяц назад может быть неоднозначным.Что конкретно означает месяц назад, если сегодня 31 октября?

Случай "недели" можно добавить тривиально.

Answer 2

Мы можем соединить несколько функций Tidyverse, чтобы сделать это быстро.В основном используется lubrdate для сдвига даты, stringr для разбора строки и purrr для сопоставления.Например

mm <- stringr::str_match(x, "(\\d+) (day|week|month|year)s? ago")
shifter <- list(day=days, week=weeks, month=months, year=years)
shifts <- map2(mm[,3], as.numeric(mm[,2]), ~case_when(.x=="day"~days(.y),
                    .x=="week"~weeks(.y),
                    .x=="month"~months(.y),
                    .x=="year"~years(.y)))
map_dbl(shifts, ~today()-.x) %>% as_date
# [1] "2018-09-10" "2018-08-03" "2018-01-14" "2017-09-14"
# where today() returns [1] "2018-09-14"