Разделить данные по годам

Question

У меня есть такие данные:

ID    ATTRIBUTE        START          END
 1            A   01-01-2000   15-03-2010
 1            B   05-11-2001   06-02-2002
 2            B   01-02-2002   08-05-2008
 2            B   01-06-2008   01-07-2008

Теперь я хочу посчитать количество разных идентификаторов, имеющих определенный атрибут в год.

Результат может выглядеть так:

YEAR    count(A)    count(B)
2000          1           0
2001          1           1
2002          1           2
2003          1           1
2004          1           1
2005          1           1
2006          1           1
2007          1           1
2008          1           1
2009          1           0
2010          1           0

Второй этап подсчета событий, вероятно, прост.

Но как бы я разбил свои данные на годы?

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

Answer 1

Вот подход, использующий несколько пакетов Хэдли.

library(lubridate); library(reshape2); library(plyr)

# extract years from start and end dates after converting them to date
dfr2 = transform(dfr, START = year(dmy(START)), END = year(dmy(END)))

# for every row, construct a sequence of years from start to end
dfr2 = adply(dfr2, 1, transform, YEAR = START:END)

# create pivot table of year vs. attribute with number of unique values of ID
dcast(dfr2, YEAR ~ ATTRIBUTE, function(x) length(unique(x)), value_var = 'ID')

РЕДАКТИРОВАТЬ: Если исходный data.frame большой, то adply может занять много времени.Полезной альтернативой в таких случаях является использование пакета data.table.Вот как мы можем заменить вызов adply, используя data.table.

require(data.table)
dfr2 = data.table(dfr2)[,list(YEAR = START:END),'ID, ATTRIBUTE']

Answer 2

Вот решение, которое использует только ядро ​​R. Сначала мы покажем входные данные, чтобы сохранить все это самодостаточным:

DF <- data.frame(ID = c(1, 1, 2, 2), 
    ATTRIBUTE = c("A", "B", "B", "B"), 
    START = c("01-01-2000", "05-11-2001", "01-02-2002", "01-06-2008"), 
    END = c("15-03-2010", "06-02-2002", "08-05-2008", "01-07-2008"))

Теперь, когда у нас есть входные данные, решение следует: yrопределяется как функция, которая извлекает год.Суть расчетов - это утверждение, следующее за определением yr.Для каждой строки DF анонимная функция создает фрейм данных с интервалами лет в столбце 1 и ATTRIBUTE и ID в столбцах 2 и 3. Например, фрейм данных, соответствующий первой строке DF это 11 строка data.frame(YEAR = 2000:2010, ATTRIBUTE = 1, ID = "A"), а фрейм данных, соответствующий второй строке DF, это две строки data.frame(YEAR = 2001:2002, ATTRIBUTE = 1, ID = "B").lapply создает список таких фреймов данных, по одному для каждой строки DF, поэтому в приведенном выше примере ввода он создает список из 4 компонентов.Используя do.call мы rbind компоненты этого списка, то есть отдельные кадры данных, создавая один большой кадр данных.Мы удаляем дубликаты строк (используя unique) из этого большого фрейма данных, удаляем столбец ID (третий столбец) и запускаем table для результата:

yr <- function(d) as.numeric(sub(".*-", "", d))
out <- table(unique(do.call(rbind, lapply(1:nrow(DF), function(r) with(DF[r, ],
    data.frame(YEAR = seq(yr(START), yr(END)), ATTRIBUTE, ID)))))[, -3])

В результате получается следующая таблица:

> out
      ATTRIBUTE
YEAR   A B
  2000 1 0
  2001 1 1
  2002 1 2
  2003 1 1
  2004 1 1
  2005 1 1
  2006 1 1
  2007 1 1
  2008 1 1
  2009 1 0
  2010 1 0

РЕДАКТИРОВАТЬ:

Позже постер указал, что память может быть проблемой, поэтому вот решение sqldf, которое обрабатывает ключевые большие промежуточные результаты в sqlite вне R (dbname = tempfile()говорит ему об этом), поэтому любое ограничение памяти R не повлияет на это.Он использует тот же вход и ту же функцию yr, показанную выше, и возвращает тот же результат, tab такой же, как out выше.Также попробуйте это без dbname = tempfile() на случай, если оно действительно уместится в памяти.

library(sqldf)

DF2 <- transform(DF, START = yr(START), END = yr(END))
years <- data.frame(year = min(DF2$START):max(DF2$END))

tab.df <- sqldf("select year, ATTRIBUTE, count(*) as count from
    (select distinct year, ATTRIBUTE, ID
    from years, DF2
    where year between START and END)
    group by year, ATTRIBUTE", dbname = tempfile())

tab <- xtabs(count ~., tab.df)

Answer 3

Я не собирался здесь давать ответ, так как проблема казалась немного хитрой, поэтому я мог бы придумать только некрасивое решение, но после прочтения комментария Романа Луштрика я не смог избежать этого вызова:)

В любом случае, я не уверен, понравится ли вам это решение, так что будьте готовы!

Загрузка демо-данных:

dfr <- structure(list(ID = c(1, 1, 2, 2), ATTRIBUTE = structure(c(1L, 2L, 2L, 2L), .Label = c("A", "B"), class = "factor"), START = c("01-01-2000", "05-11-2001", "01-02-2002", "01-06-2008"), END = c("15-03-2010", "06-02-2002", "08-05-2008", "01-07-2008")), .Names = c("ID", "ATTRIBUTE", "START", "END"), row.names = c(NA, -4L), class = "data.frame")

Мы не имеем дело с месяцами и поэтому просто сохраняем год в таблице:

> dfr$START <- as.numeric(substr(dfr$START, 7, 10))
> dfr$END <- as.numeric(substr(dfr$END, 7, 10))
> dfr
  ID ATTRIBUTE START  END
1  1         A  2000 2010
2  1         B  2001 2002
3  2         B  2002 2008
4  2         B  2008 2008

Очистить дублированные строки (путем слияния лет на основе ID и ATTRIBUTE):

> dfr <- merge(aggregate(START ~ ID + ATTRIBUTE, dfr, min), aggregate(END ~ ID + ATTRIBUTE, dfr, max), by=c('ID', 'ATTRIBUTE'))
> dfr
  ID ATTRIBUTE START  END
1  1         A  2000 2010
2  1         B  2001 2002
3  2         B  2002 2008

И управляйте однострочником с некоторыми apply, lapply, do.call и друзьями, чтобы показать красоту R! :)

> t(table(do.call(rbind, lapply(apply(dfr, 1, function(x) cbind(x[2], x[3]:x[4])), function(x) as.data.frame(x)))))
      V1
V2     A B
  2000 1 0
  2001 1 1
  2002 1 2
  2003 1 1
  2004 1 1
  2005 1 1
  2006 1 1
  2007 1 1
  2008 1 1
  2009 1 0
  2010 1 0

Answer 4

Слегка запутанный, но попробуйте это:

dfr <- data.frame(ID=c(1,1,2,2),ATTRIBUTE=c("A","B","B","B"),START=c("01-01-2000","05-11-2001","01-02-2002","01-06-2008"),END=c("15-03-2010","06-02-2002","08-05-2008","01-07-2008"),stringsAsFactors=F)
dfr$ATTRIBUTE <- factor(dfr$ATTRIBUTE)

actYears <- mapply(":",as.numeric(substr(dfr$START,7,10)),as.numeric(substr(dfr$END,7,10)))

yrRng <- ":"(range(actYears)[1],range(actYears)[2])

yrTable <- sapply(actYears,function(x) yrRng %in% x)
rownames(yrTable) <- yrRange
colnames(yrTable) <- dfr$ATTRIBUTE

Что дает:

yrTable
        A     B     B     B
2000 TRUE FALSE FALSE FALSE
2001 TRUE  TRUE FALSE FALSE
2002 TRUE  TRUE  TRUE FALSE
2003 TRUE FALSE  TRUE FALSE
2004 TRUE FALSE  TRUE FALSE
2005 TRUE FALSE  TRUE FALSE
2006 TRUE FALSE  TRUE FALSE
2007 TRUE FALSE  TRUE FALSE
2008 TRUE FALSE  TRUE  TRUE
2009 TRUE FALSE FALSE FALSE
2010 TRUE FALSE FALSE FALSE

Теперь мы можем построить таблицу:

t(apply(yrTable,1,function(x) table(dfr$ATTRIBUTE[x])))
     A B
2000 1 0
2001 1 1
2002 1 2
2003 1 1
2004 1 1
2005 1 1
2006 1 1
2007 1 1
2008 1 2
2009 1 0
2010 1 0

Это все равно двойной подсчет идентификаторов, но, вероятно, было бы проще объединить перекрывающиеся диапазоны в исходном data.frame.

Answer 5

Спасибо за все ваши ответы!

Все они действительно аккуратны, но некоторые доводят мой компьютер до предела, потому что мне приходится обрабатывать действительно большие объемы данных.

Я наконец-топосмотрел на все ваши решения и построил немного другое:

data <- structure(list(ID = c(1, 1, 2, 2), ATTRIBUTE = structure(c(1L, 2L, 2L, 2L), .Label = c("A", "B"), class = "factor"), START = c("2000-01-01", "2001-11-05", "2002-02-01", "2008-06-01"), END = c("2010-03-15", "2002-02-06", "2008-05-08", "2008-07-01")), .Names = c("ID", "ATTRIBUTE", "START", "END"), row.names = c(NA, -4L), class = "data.frame")

data$START <- as.Date(data$START)
data$END <- as.Date(data$END)
data$y0 <- (format(data$START,"%Y"))
data$y1 <- (format(data$END,"%Y"))

attributeTable <- function(dfr) {
  years <- data.frame(row.names(seq(min(dfr$y0), max(dfr$y1))))

  for (i in min(dfr$y0):max(dfr$y1)) {
    years[paste(i), "A"] <- length(unique(dfr$ID[dfr$y0 <= i & dfr$y1 >= i & dfr$ATTRIBUTE == "A"]))
    years[paste(i), "B"] <- length(unique(dfr$ID[dfr$y0 <= i & dfr$y1 >= i & dfr$ATTRIBUTE == "B"]))
  }

  years
}

attributeTable(data)

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

Скорость этого решения по крайней мере вполне приемлема.