Учитывая временной ряд для многих уникальных идентификаторов, мне нужны 100 верхних дельт для каждого периода.
Вопрос
У меня есть временной ряд данных в TSV следующим образом:
ID \t Date \t Value
-------------------------------
1234567 \t 2009-01-01T00:00:00.000Z \t 121
12131 \t 2009-06-01T00:00:00.000Z \t 151
12131 \t 2009-07-01T00:00:00.000Z \t 15153
...
Он легко помещается в оперативной памяти, но слишком велик для Excel.
Для каждого идентификатора указано одно значение в месяц, но не для всех идентификаторов есть записи за все 12 месяцев.
Данные охватывают 12 месяцев, но не все идентификаторы содержат все 12 месяцев.Я хочу просмотреть данные для каждого идентификатора, и если есть запись за предыдущий месяц, возьмите текущий месяц минус предыдущий месяц и сохраните его в новом столбце, чтобы получить дельту.Если записи за предыдущий месяц нет, верните 0.Затем для каждого месяца мне нужны 100 лучших положительных и отрицательных значений этих дельт вместе с идентификатором.
Я бы хотел сделать это в R, потому что в Excel это сложно и постоянно происходят сбои.У меня есть R, Rattle и т. д.установлен, и я проработал базовые примеры, но...кривая обучения крутая.Буду очень признателен за помощь :)
Решение
Начните с добавления всех недостающих месяцев:
all_combs <- expand.grid(
ID = unique(data$ID),
Date = unique(data$Date))
data <- merge(data, all_combs, by = c("ID", "Date"), all = T)
# Ensure data ordered by date
data <- data[with(data, order(ID, Date)), ]
Затем добавьте столбец дельт (рассчитанных с помощью diff)
library(plyr)
data <- ddply(data, "ID", transform, delta = c(NA, diff(Value)))
Наконец, удалите недостающие дельты, упорядочите их по значению и извлеките 10 верхних и нижних значений в каждой группе.
changed <- subset(data, !is.na(delta))
changed <- changed[with(changed, order(ID, delta)), ]
# Select top 100 for each
top10 <- ddply(changed, "ID", function(df) {
rbind(head(df, 10), tail(df, 10))
})
Другие советы
Хорошо, сначала немного кода для генерации тестовых данных.Получается 100 случайных идентификаторов, для каждого из которых выбираются 20 месяцев из двухлетнего периода вместе со случайными значениями.Затем порядок перемешивается для большего удовольствия.
## Generate some IDs
ids <- sample(1000, 100)
## Generate the data
data <- do.call(rbind,
lapply(ids,
function(id)
data.frame(ID = id,
Date = sample(as.Date(paste(rep(c(2008:2009), each=12),
1:12, 1, sep="-")),
20),
Value = sample(1000, 20))))
## Shuffle
data <- data[sample(nrow(data), nrow(data)),]
Вот как это выглядит для меня:
> head(data)
ID Date Value
1007 205 2008-07-01 235
1391 840 2008-12-01 509
918 278 2009-12-01 951
1213 945 2009-03-01 842
1369 766 2009-07-01 555
798 662 2008-12-01 531
Хорошо, теперь давайте перейдем по идентификаторам и найдем разницу для каждого месяца для каждого идентификатора.Перед этим давайте преобразуем месяц в число, чтобы было легче воспринимать различия (это немного нечисто, кто-нибудь знает лучший способ выполнения арифметических операций с объектами Date?).Это просто делает year * 12 + month
так что нормальная арифметика работает:
data$Month <- as.POSIXlt(data$Date)$mon + as.POSIXlt(data$Date)$year * 12
Теперь посчитаем разницу:
by.id <- by(data, data$ID, function(x) {
## Sort by month.
x <- x[order(x$Month),]
## Compute the month and value differences, taking care to pad the edge case.
data.frame(ID=x$ID,
Date = x$Date,
Month.diff=c(0, diff(x$Month)),
Value.diff=c(0,diff(x$Value)))
})
by.id <- do.call(rbind, by.id)
Вот как выглядит результат:
> head(by.id)
ID Date Month.diff Value.diff
4.1 4 2008-02-01 0 0
4.2 4 2008-03-01 1 123
4.3 4 2008-05-01 2 -94
4.4 4 2008-06-01 1 -243
4.5 4 2008-08-01 2 -327
4.6 4 2008-10-01 2 656
Если разница между последовательными месяцами была больше 1, то месяцы не были соседними, и нам следует установить их значения равными нулю.
by.id$Value.diff <- ifelse(by.id$Month.diff == 1,
by.id$Value.diff,
0)
Наконец, мы выполняем итерацию по месяцам и берем N верхних и нижних различий (здесь я установлю N равным 10, а не 100, поскольку мой набор тестовых данных довольно мал).
by.month <- by(by.id, by.id$Date, function(x) {
## Sort the data in each month
x <- x[order(x$Value.diff),]
## Take the top and bottom and label them accordingly.
cbind(rbind(head(x, 10), tail(x, 10)),
type=rep(c("min", "max"), each=10))
})
И вот оно.Вот пример результата:
> by.month[[24]]
ID Date Month.diff Value.diff type
130.20 130 2009-12-01 1 -951 min
415.20 415 2009-12-01 1 -895 min
662.20 662 2009-12-01 1 -878 min
107.20 107 2009-12-01 1 -744 min
824.20 824 2009-12-01 1 -731 min
170.20 170 2009-12-01 1 -719 min
502.20 502 2009-12-01 1 -714 min
247.20 247 2009-12-01 1 -697 min
789.20 789 2009-12-01 1 -667 min
132.20 132 2009-12-01 1 -653 min
64.20 64 2009-12-01 1 622 max
82.20 82 2009-12-01 1 647 max
381.20 381 2009-12-01 1 698 max
303.20 303 2009-12-01 1 700 max
131.20 131 2009-12-01 1 751 max
221.20 221 2009-12-01 1 765 max
833.20 833 2009-12-01 1 791 max
806.20 806 2009-12-01 1 806 max
780.20 780 2009-12-01 1 843 max
912.20 912 2009-12-01 1 929 max
Псевдокод для начала:
For Each ID
If Previous month data Exists
compute Diff
Else diff = 0
return diff
For Each Month
Max 100 (Positive)
Min 100 (Negative)
#Realish Code
dataset$diff <- lappply(dataset,function(ID,month,value){IF dataset[month-1] = TRUE{value-(value[month-1]})})
#This gets tricky since you need to know the month and what the previous month is in a format you can test