Разбивка данных по годам
у меня есть такие данные:
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
I второй шаг подсчета случаев, вероятно, прост.
но как бы я разделил свои данные на годы?
спасибо заранее!
5 ответов
вот подход, использующий несколько пакетов Хэдли.
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')
EDIT: если оригинал data.frame большой, то adply может занять много времени. Полезной альтернативой в таких случаях является использование data.table пакета. Вот как мы можем заменить adply звонок с помощью data.table.
require(data.table)
dfr2 = data.table(dfr2)[,list(YEAR = START:END),'ID, ATTRIBUTE']
вот решение, которое использует только ядро 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"). The 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
EDIT:
плакат позже указал, что память может быть проблемой, поэтому вот решение 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)
немного запутанно, но попробуйте это:
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.
Я не собирался давать ответ здесь, поскольку проблема казалась немного сложной, поэтому я мог бы придумать только уродливое решение, но после прочтения комментария @ Roman Luštrik я не мог избежать этой проблемы:)
в любом случае, я не уверен, что вам понравится это решение, поэтому будьте готовы!
загрузка демо-данных:
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
Спасибо за все ваши ответы!
все они очень аккуратные, но некоторые приводят мой компьютер к его пределам, потому что мне приходится обрабатывать очень большие объемы данных.
Я, наконец, посмотрел на все ваши решения и построил немного другой:
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)
недостатком является то, что я должен определить каждую возможную форму атрибута. Возможно, есть способ сделать это автоматически,но я еще не нашел его.
скорость этого решение, по крайней мере, вполне приемлемо.