Возврат ближайшей даты к заданной дате в R

Мой фрейм данных состоит из отдельных наблюдений за отдельными животными. У каждого животного есть дата рождения, которую я хотел бы связать с ближайшей полевой датой сезона из вектора даты.

Вот очень простой воспроизводимый пример:

ID <- c("a", "b", "c", "d", "a") # individual "a" is measured twice here
birthdate <- as.Date(c("2012-06-12", "2014-06-14", "2015-11-11", "2016-09-30", "2012-06-12"))    
df <- data.frame(ID, birthdate)

# This is the date vector
season_enddates <- as.Date(c("2011-11-10", "2012-11-28", "2013-11-29", "2014-11-26", "2015-11-16", "2016-11-22", "2012-06-21", "2013-06-23", "2014-06-25", "2015-06-08", "2016-06-14"))

С помощью следующего кода я могу получить разницу между датой рождения и ближайшей датой окончания сезона.

for(i in 1:length(df$birthdate)){
  df$birthseason[i] <- which(abs(season_enddates-df$birthdate[i]) == min(abs(season_enddates-df$birthdate[i])))
}

Однако, что я хочу, это фактическая дата, а не разница. Например, первое значение сезона рождения должно быть 2012-06-21.

Источник

5 ответов

Решение

Это немного сбивает с толку, так как вы используете переменные, которые вы не включили в свои примеры.

Но я думаю, что это то, что вы хотите:

for (ii in 1:nrow(df))  df$birthseason[ii] <-as.character(season_enddates[which.min(abs(df$birthdate[ii] - season_enddates))])

Альтернативно используя lapply:

df$birthseason <- unlist(lapply(df$birthdate,function(x) as.character(season_enddates[which.min(abs(x - season_enddates))])))

Результат:

> df
  ID  birthdate birthseason
1  a 2012-06-12  2012-06-21
2  b 2014-06-14  2014-06-25
3  c 2015-11-11  2015-11-16
4  d 2016-09-30  2016-11-22
5  a 2012-06-12  2012-06-21
Источник

Вы ищете что season_enddate самый близкий к birthdate[1], а также birthdate[2], так далее.

Чтобы получить правильные данные, я создам реальный воспроизводимый пример:

birthdate <- as.Date(c("2012-06-12", "2014-06-14", 
                       "2015-11-11", "2016-09-30", 
                       "2012-06-12"))

season_enddates <- as.Date(c("2011-11-10", "2012-11-28", 
                             "2013-11-29", "2014-11-26",
                             "2015-11-16", "2016-11-22", 
                             "2012-06-21", "2013-06-23", 
                             "2014-06-25", "2015-06-08", 
                             "2016-06-14"))

В основном я использую функцию, которую вы также использовали, за исключением того, что я решил немного разбить ее, чтобы легче было следовать тому, что вы пытаетесь сделать:

new.vector <- rep(0, length(birthdate))
for(i in 1:length(birthdate)){
    diffs <- abs(birthdate[i] - season_enddates)
    inds  <- which.min(diffs)
    new.vector[i] <- season_enddates[inds]
}

# new.vector now contains some dates that have been converted to numbers:
as.Date(new.vector, origin = "1970-01-01")
# [1] "2012-06-21" "2014-06-25" "2015-11-16" "2016-11-22"
# [5] "2012-06-21"
Источник

Все решения здесь по сути одинаковы. Если вы хотите, чтобы эта операция выполнялась для вас оптимизированной функцией, я бы сделал это так:

match_season <- function(x,y){
  nx <- length(x)
  ind <- numeric(nx)
  for(i in seq_len(nx)){
    ind[i] <- which.min(abs(x[i] - y))
  }
  y[ind]
}

Тогда вы можете просто сделать:

younger$birthseason <- match_season(younger$HatchDate, season_enddates)

Выглядит чище и дает желаемый результат в правильном Date формат.

Сравнительный анализ:

start <- as.Date("1990-07-01")
end <- as.Date("2017-06-30")

birthdate <- sample(seq(start, end, by = "1 day"), 1000)

season_enddates <- seq(as.Date("1990-12-21"),
                       as.Date("2017-6-21"),
                       by = "3 months")

library(rbenchmark)

benchmark(match_season(birthdate, season_enddates),
          columns = c("test","elapsed"))

дает время 7,62 секунд для 100 повторений.

Источник

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

Чтобы решить это, я предлагаю использовать which.min (делает ваш код немного проще и быстрее), в сочетании с поднабором вашего season_enddates вектор, как показано ниже:

for(i in 1:length(younger$HatchCalendarYear)){
  df$birthseasonDate[i] <- season_enddates[which.min(abs(season_enddates - df$birthdate[i]))]
}
Источник

findInterval полезно в таких случаях. Нахождение ближайшего season_enddates для каждого df$birthdate:

vec = sort(season_enddates)
int = findInterval(df$birthdate, vec, all.inside = TRUE)
int
#[1]  1  5  8 10  1

мы сравниваем расстояние от каждой из окружающих дат интервала и выбираем минимум:

ans = vec[int]
i = abs(df$birthdate - vec[int]) > abs(df$birthdate - vec[int + 1])
ans[i] = vec[int[i] + 1]
ans
#[1] "2012-06-21" "2014-06-25" "2015-11-16" "2016-11-22" "2012-06-21"
Источник
Другие вопросы по тегам