Учитывая временной ряд для многих уникальных идентификаторов, мне нужны лучшие 100 дельт для каждого периода - PullRequest
1 голос
/ 23 декабря 2009

У меня есть временной ряд данных в 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 и т. Д., И я работал с основными примерами, но ... кривая обучения крутая. Буду очень признателен за помощь:)

Ответы [ 3 ]

7 голосов
/ 23 декабря 2009

Начните с добавления всех пропущенных месяцев:

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)), ]

Затем добавьте столбец дельт (рассчитывается с помощью различий)

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))
})
4 голосов
/ 23 декабря 2009

Хорошо, сначала немного кода для генерации тестовых данных. Это дает 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
1 голос
/ 23 декабря 2009

Псевдокод для начала:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...