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

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

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

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

r
2
astronomerforfun 14 Сен 2018 в 22:07

2 ответа

Лучший ответ

Помогает ли вам эта грубая функция? Он должен работать даже для таких строк, как "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 месяц назад может быть неоднозначным. Что именно означает 1 месяц назад, если сегодня 31 октября?

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

2
Anders Ellern Bilgrau 15 Сен 2018 в 07:41

Мы можем объединить несколько функций 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"
1
MrFlick 14 Сен 2018 в 19:36