Вычисление средней даты по строке

Я хочу получить среднюю дату по строке, где каждая строка содержит две даты. В конце концов я нашел способ, размещенный ниже. Однако подход, который я использовал, кажется довольно громоздким. Есть ли способ лучше?

my.data = read.table(text = "
     OBS  MONTH1  DAY1  YEAR1  MONTH2  DAY2  YEAR2   STATE
       1       3     6   2012       3    10   2012       1
       2       3    10   2012       3    20   2012       1
       3       3    16   2012       3    30   2012       1
       4       3    20   2012       4     8   2012       1
       5       3    20   2012       4     9   2012       1
       6       3    20   2012       4    10   2012       1
       7       3    20   2012       4    11   2012       1
       8       4     4   2012       4     5   2012       1
       9       4     6   2012       4     6   2012       1
      10       4     6   2012       4     7   2012       1
", header = TRUE, stringsAsFactors = FALSE)
my.data

my.data$MY.DATE1 <- do.call(paste, list(my.data$MONTH1, my.data$DAY1, my.data$YEAR1))
my.data$MY.DATE2 <- do.call(paste, list(my.data$MONTH2, my.data$DAY2, my.data$YEAR2))

my.data$MY.DATE1 <- as.Date(my.data$MY.DATE1, format=c("%m %d %Y"))
my.data$MY.DATE2 <- as.Date(my.data$MY.DATE2, format=c("%m %d %Y"))
my.data

desired.result = read.table(text = "
   OBS MONTH1 DAY1 YEAR1 MONTH2 DAY2 YEAR2 STATE   MY.DATE1   MY.DATE2    mean.date
    1      3     6  2012      3   10  2012     1 2012-03-06 2012-03-10   2012-03-08
    2      3    10  2012      3   20  2012     1 2012-03-10 2012-03-20   2012-03-15
    3      3    16  2012      3   30  2012     1 2012-03-16 2012-03-30   2012-03-23
    4      3    20  2012      4    8  2012     1 2012-03-20 2012-04-08   2012-03-29
    5      3    20  2012      4    9  2012     1 2012-03-20 2012-04-09   2012-03-30
    6      3    20  2012      4   10  2012     1 2012-03-20 2012-04-10   2012-03-30
    7      3    20  2012      4   11  2012     1 2012-03-20 2012-04-11   2012-03-31
    8      4     4  2012      4    5  2012     1 2012-04-04 2012-04-05   2012-04-04
    9      4     6  2012      4    6  2012     1 2012-04-06 2012-04-06   2012-04-06
   10      4     6  2012      4    7  2012     1 2012-04-06 2012-04-07   2012-04-06
", header = TRUE, stringsAsFactors = FALSE)

Вот подход, который сработал для меня:

my.data$mean.date <- (my.data$MY.DATE1 + ((my.data$MY.DATE2 - my.data$MY.DATE1) / 2))
my.data

Эти подходы не сработали:

my.data$mean.date <- mean(my.data$MY.DATE1, my.data$MY.DATE2)
my.data$mean.date <- mean(my.data$MY.DATE1, my.data$MY.DATE2, trim = 0)
my.data$mean.date <- mean(my.data$MY.DATE1, my.data$MY.DATE2, trim = 1)
my.data$mean.date <- mean(my.data$MY.DATE1, my.data$MY.DATE2, trim = 0.5)
my.data$mean.data <- apply(my.data, 1, function(x) {(x[9] + x[10]) / 2})

Я думаю, что должен использовать команду Ops.Date, но не нашел примера.

Спасибо за любые предложения.


r date mean
person Mark Miller    schedule 27.10.2014    source источник
comment
Проверить mean.Date в базе R. mean.Date(as.Date(c("01-01-2014", "01-07-2014"), format=c("%m-%d-%Y"))) [1] 04.01.2014   -  person JasonAizkalns    schedule 27.10.2014
comment
@jaysunice3401 Спасибо. Если вы опубликуете это как ответ, я, вероятно, приму его через день или около того.   -  person Mark Miller    schedule 27.10.2014
comment
Я разместил свой комментарий ниже, не стесняйтесь принять его.   -  person JasonAizkalns    schedule 11.11.2014

Ответы (7)


arrow_upward
3
arrow_downward

Будьте проще и используйте mean.Date в базе R.

mean.Date(as.Date(c("01-01-2014", "01-07-2014"), format=c("%m-%d-%Y"))) 
[1] "2014-01-04"
person JasonAizkalns    schedule 11.11.2014
comment
К сожалению, эта функция, похоже, не векторизована. - person Mark Miller; 12.11.2014
comment
Как насчет игры с base::Vectorize? - person JasonAizkalns; 12.11.2014

arrow_upward
2
arrow_downward

Воспользовавшись добрым советом @jaysunice3401, я придумал это. Если вы хотите сохранить исходные данные, вы можете добавить remove = FALSE в две строки с unite

library(dplyr)
library(tidyr)

my.data %>%
    unite(whatever1, matches("1"), sep = "-") %>%
    unite(whatever2, matches("2"), sep = "-") %>%
    mutate_each(funs(as.Date(., "%m-%d-%Y")), contains("whatever")) %>%
    rowwise %>%
    mutate(mean.date = mean.Date(c(whatever1, whatever2)))

#   OBS  whatever1  whatever2 STATE  mean.date
#1    1 2012-03-06 2012-03-10     1 2012-03-08
#2    2 2012-03-10 2012-03-20     1 2012-03-15
#3    3 2012-03-16 2012-03-30     1 2012-03-23
#4    4 2012-03-20 2012-04-08     1 2012-03-29
#5    5 2012-03-20 2012-04-09     1 2012-03-30
#6    6 2012-03-20 2012-04-10     1 2012-03-30
#7    7 2012-03-20 2012-04-11     1 2012-03-31
#8    8 2012-04-04 2012-04-05     1 2012-04-04
#9    9 2012-04-06 2012-04-06     1 2012-04-06
#10  10 2012-04-06 2012-04-07     1 2012-04-06
person jazzurro    schedule 27.10.2014

arrow_upward
1
arrow_downward

Может быть, что-то в этом роде?

library(data.table)
setDT(my.data)[, `:=`(MY.DATE1 = as.Date(paste(DAY1 ,MONTH1, YEAR1), format = "%d %m %Y"),
                      MY.DATE2 = as.Date(paste(DAY2 ,MONTH2, YEAR2), format = "%d %m %Y"))][, 
                      mean.date := MY.DATE2 - ceiling((MY.DATE2 - MY.DATE1)/2)]

my.data
#     OBS MONTH1 DAY1 YEAR1 MONTH2 DAY2 YEAR2 STATE   MY.DATE1   MY.DATE2  mean.date
#  1:   1      3    6  2012      3   10  2012     1 2012-03-06 2012-03-10 2012-03-08
#  2:   2      3   10  2012      3   20  2012     1 2012-03-10 2012-03-20 2012-03-15
#  3:   3      3   16  2012      3   30  2012     1 2012-03-16 2012-03-30 2012-03-23
#  4:   4      3   20  2012      4    8  2012     1 2012-03-20 2012-04-08 2012-03-29
#  5:   5      3   20  2012      4    9  2012     1 2012-03-20 2012-04-09 2012-03-30
#  6:   6      3   20  2012      4   10  2012     1 2012-03-20 2012-04-10 2012-03-30
#  7:   7      3   20  2012      4   11  2012     1 2012-03-20 2012-04-11 2012-03-31
#  8:   8      4    4  2012      4    5  2012     1 2012-04-04 2012-04-05 2012-04-04
#  9:   9      4    6  2012      4    6  2012     1 2012-04-06 2012-04-06 2012-04-06
# 10:  10      4    6  2012      4    7  2012     1 2012-04-06 2012-04-07 2012-04-06

Или, если вы настаиваете на использовании mean.date, вот альтернативное решение:

library(data.table)
setDT(my.data)[, `:=`(MY.DATE1 = as.Date(paste(DAY1 ,MONTH1, YEAR1), format = "%d %m %Y"),
                      MY.DATE2 = as.Date(paste(DAY2 ,MONTH2, YEAR2), format = "%d %m %Y"))][, 
                      mean.date := mean.Date(c(MY.DATE1, MY.DATE2)), by = OBS]
person David Arenburg    schedule 27.10.2014
comment
@Spacedman, да, ты прав, я, должно быть, создал раньше. Я изменил его на решение data.table и с этим справился. Не уверен, что стоит усилий с пипоманией в последнее время - person David Arenburg; 27.10.2014

arrow_upward
1
arrow_downward

Однострочный (разделенный для удобства чтения), использует lubridate и dplyr и (конечно) пайпы:

> require(lubridate)
> require(dplyr)
> my.data =  my.data %>% 
    mutate(
      MY.DATE1=as.Date(mdy(paste(MONTH1,DAY1,YEAR1))),
      MY.DATE2=as.Date(mdy(paste(MONTH2,DAY2,YEAR2)))) %>% 
    rowwise %>%
    mutate(mean.data=mean.Date(c(MY.DATE1,MY.DATE2))) %>% data.frame()
> head(my.data)
  OBS MONTH1 DAY1 YEAR1 MONTH2 DAY2 YEAR2 STATE   MY.DATE1   MY.DATE2
1   1      3    6  2012      3   10  2012     1 2012-03-06 2012-03-10
2   2      3   10  2012      3   20  2012     1 2012-03-10 2012-03-20
3   3      3   16  2012      3   30  2012     1 2012-03-16 2012-03-30
4   4      3   20  2012      4    8  2012     1 2012-03-20 2012-04-08
5   5      3   20  2012      4    9  2012     1 2012-03-20 2012-04-09
6   6      3   20  2012      4   10  2012     1 2012-03-20 2012-04-10
   mean.data
1 2012-03-08
2 2012-03-15
3 2012-03-23
4 2012-03-29
5 2012-03-30
6 2012-03-30

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

my.data %>% mutate(
  MY.DATE1 = paste(MONTH1,DAY1,YEAR1) %>% mdy %>% as.Date,
  MY.DATE2 = paste(MONTH2,DAY2,YEAR2) %>% mdy %>% as.Date)
person Spacedman    schedule 27.10.2014
comment
Последнее решение просто жестоко :) - person David Arenburg; 27.10.2014
comment
Каждый раз, когда я делаю что-то на консоли без сопоставления скобок, и мне приходится считать закрывающие скобки, я просто понимаю, что с трубами на самом деле проще... - person Spacedman; 27.10.2014

arrow_upward
1
arrow_downward

1) Создайте столбцы класса Date, а затем легко. Внешние пакеты не используются:

asDate <- function(x) as.Date(x, "1970-01-01")

my.data2 <- transform(my.data, 
   date1 = as.Date(ISOdate(YEAR1, MONTH1, DAY1)),
   date2 = as.Date(ISOdate(YEAR2, MONTH2, DAY2))
)
transform(my.data2, mean.date = asDate(rowMeans(cbind(date1, date2))))

Если бы мы добавили вызов library(zoo), то мы могли бы опустить определение asDate, используя as.Date в последней строке вместо asDate, поскольку зоопарк добавляет источник по умолчанию к as.Date.

1a) Версия dplyr будет выглядеть так (с использованием asDate сверху):

library(dplyr)

my.data %>%
  mutate(
     date1 = ISOdate(YEAR1, MONTH1, DAY1) %>% as.Date,
     date2 = ISOdate(YEAR2, MONTH2, DAY2) %>% as.Date,
     mean.date = cbind(date1, date2) %>% rowMeans %>% asDate)

2) Другой способ использует julian в пакете chron. julian преобразует месяц/день/год в количество дней, прошедших с начала Эпохи. Мы можем усреднить два юлиана и преобразовать обратно в класс Date:

library(zoo)
library(chron)

transform(my.data, 
  mean.date = as.Date( ( julian(MONTH1,DAY1,YEAR1) + julian(MONTH2,DAY2,YEAR2) )/2 ) 
)

Мы могли бы опустить library(zoo), если бы использовали asDate из (1) вместо as.Date.

Обновление. Обсуждалось использование зоопарка для сокращения решений и дальнейшее сокращение решения (1).

person G. Grothendieck    schedule 27.10.2014
comment
Аккуратное решение, но я должен понизить ваш голос за то, что вы не используете трубы. Дж / К - person Spacedman; 27.10.2014
comment
Извините, я добавил library(zoo), который необходим для их работы. Без этого они все еще могут работать, если вы добавите origin = "1970-10-01" к последнему as.Date вызову в каждом ответе. - person G. Grothendieck; 27.10.2014

arrow_upward
0
arrow_downward

как насчет :

apply(my.data[,c("MY.DATE1","MY.DATE2")],1,function(date){substr(strptime(mean(c(strptime(date[1],"%y%y-%m-%d"),strptime(date[2],"%y%y-%m-%d"))),format="%y%y-%m-%d"),1,10)})

? (Мне просто пришлось использовать substr из-за CET и CEST, которые выводили мой вывод в виде списка...)

person Cath    schedule 27.10.2014
comment
Это похоже на решение, которое я разместил выше. - person Mark Miller; 27.10.2014

arrow_upward
0
arrow_downward

Это векторизованная версия ответа, опубликованного jaysunice3401. Это кажется довольно простым, за исключением того, что мне пришлось использовать метод проб и ошибок, чтобы определить правильный origin. Я не знаю, насколько общим является origin = "1970-01-01" и нужно ли указывать другое происхождение для каждого набора данных.

Согласно этому веб-сайту: http://www.ats.ucla.edu/stat/r/faq/dates.htm

Когда R рассматривает даты как целые числа, его источником является 1 января 1970 года.

Что, кажется, предполагает, что origin = "1970-01-01" является довольно общим. Хотя, если бы в моем наборе данных были даты до "1970-01-01", я бы обязательно протестировал код перед его использованием.

my.data = read.table(text = "
     OBS  MONTH1  DAY1  YEAR1  MONTH2  DAY2  YEAR2   STATE
       1       3     6   2012       3    10   2012       1
       2       3    10   2012       3    20   2012       1
       3       3    16   2012       3    30   2012       1
       4       3    20   2012       4     8   2012       1
       5       3    20   2012       4     9   2012       1
       6       3    20   2012       4    10   2012       1
       7       3    20   2012       4    11   2012       1
       8       4     4   2012       4     5   2012       1
       9       4     6   2012       4     6   2012       1
      10       4     6   2012       4     7   2012       1
", header = TRUE, stringsAsFactors = FALSE)

desired.result = read.table(text = "
   OBS MONTH1 DAY1 YEAR1 MONTH2 DAY2 YEAR2 STATE   MY.DATE1   MY.DATE2    mean.date
    1      3     6  2012      3   10  2012     1 2012-03-06 2012-03-10   2012-03-08
    2      3    10  2012      3   20  2012     1 2012-03-10 2012-03-20   2012-03-15
    3      3    16  2012      3   30  2012     1 2012-03-16 2012-03-30   2012-03-23
    4      3    20  2012      4    8  2012     1 2012-03-20 2012-04-08   2012-03-29
    5      3    20  2012      4    9  2012     1 2012-03-20 2012-04-09   2012-03-30
    6      3    20  2012      4   10  2012     1 2012-03-20 2012-04-10   2012-03-30
    7      3    20  2012      4   11  2012     1 2012-03-20 2012-04-11   2012-03-31
    8      4     4  2012      4    5  2012     1 2012-04-04 2012-04-05   2012-04-04
    9      4     6  2012      4    6  2012     1 2012-04-06 2012-04-06   2012-04-06
   10      4     6  2012      4    7  2012     1 2012-04-06 2012-04-07   2012-04-06
", header = TRUE, stringsAsFactors = FALSE)

my.data$MY.DATE1 <- do.call(paste, list(my.data$MONTH1,my.data$DAY1,my.data$YEAR1))
my.data$MY.DATE2 <- do.call(paste, list(my.data$MONTH2,my.data$DAY2,my.data$YEAR2))

my.data$MY.DATE1 <- as.Date(my.data$MY.DATE1, format=c("%m %d %Y"))
my.data$MY.DATE2 <- as.Date(my.data$MY.DATE2, format=c("%m %d %Y"))

my.data$mean.date2 <- as.Date( apply(my.data, 1, function(x) {

                      mean.Date(c(as.Date(x['MY.DATE1']), as.Date(x['MY.DATE2'])))

                      }) , origin = "1970-01-01")
my.data

desired.result
person Mark Miller    schedule 12.11.2014