Вычтите значение предыдущего года из значения каждой сгруппированной строки во фрейме данных

Question

Я пытаюсь рассчитать лаговую разницу (или фактическое увеличение) для данных, которые были случайно агрегированы.Каждый последующий год в данных включает значения предыдущего года.Пример набора данных может быть создан с помощью этого кода:

set.seed(1234)
x <- data.frame(id=1:5, value=sample(20:30, 5, replace=T), year=3)
y <- data.frame(id=1:5, value=sample(10:19, 5, replace=T), year=2)
z <- data.frame(id=1:5, value=sample(0:9, 5, replace=T), year=1)
(df <- rbind(x, y, z))

Я могу использовать комбинацию lapply() и split() для вычисления разницы между каждым годом для каждого уникального идентификатора, например:

(diffs <- lapply(split(df, df$id), function(x){-diff(x$value)}))

Однако из-за характера функции diff() нет результатов для значений в год 1, что означает, что после того, как я сгладил список diffs списков с Reduce(), яневозможно добавить фактическое годовое увеличение обратно во фрейм данных, например:

df$actual <- Reduce(c, diffs)  # flatten the list of lists

В этом примере имеется только 10 рассчитанных различий или лагов, в то время как в фрейме данных 15 строк, поэтому R выбрасываетошибка при попытке добавить новый столбец.

Как создать новый столбец фактического увеличения с (1) значениями для года 1 и (2) рассчитанными разностями / лагами для всех последующих лет?

Это вывод, который я в итоге ищу.Мой список списков diffs вычисляет фактические значения для 2-х и 3-х лет.

id value year actual
 1    21    3      5
 2    26    3     16
 3    26    3     14
 4    26    3     10
 5    29    3     14
 1    16    2     10
 2    10    2      5
 3    12    2     10
 4    16    2      7
 5    15    2     13
 1     6    1      6
 2     5    1      5
 3     2    1      2
 4     9    1      9
 5     2    1      2

Answer 1

Я думаю, что это будет работать для вас. Когда вы столкнетесь с проблемой diff, просто удлините вектор, указав в качестве первого числа 0.

df <- df[order(df$id, df$year), ]
sdf <-split(df, df$id)
df$actual <- as.vector(sapply(seq_along(sdf), function(x) diff(c(0, sdf[[x]][,2]))))
df[order(as.numeric(rownames(df))),]

Есть много способов сделать это, но этот довольно быстрый и использует базу.

Вот второй и третий способ решения этой проблемы с использованием агрегата и:

агрегат:

df <- df[order(df$id, df$year), ]
diff2 <- function(x) diff(c(0, x))
df$actual <- c(unlist(t(aggregate(value~id, df, diff2)[, -1])))
df[order(as.numeric(rownames(df))),]

по:

df <- df[order(df$id, df$year), ]
diff2 <- function(x) diff(c(0, x))
df$actual <- unlist(by(df$value, df$id, diff2))
df[order(as.numeric(rownames(df))),]

plyr

df <- df[order(df$id, df$year), ]
df <- data.frame(temp=1:nrow(df), df)
library(plyr)
df <- ddply(df, .(id), transform, actual=diff2(value))
df[order(-df$year, df$temp),][, -1]

Это дает вам конечный продукт:

> df[order(as.numeric(rownames(df))),]
   id value year actual
1   1    21    3      5
2   2    26    3     16
3   3    26    3     14
4   4    26    3     10
5   5    29    3     14
6   1    16    2     10
7   2    10    2      5
8   3    12    2     10
9   4    16    2      7
10  5    15    2     13
11  1     6    1      6
12  2     5    1      5
13  3     2    1      2
14  4     9    1      9
15  5     2    1      2

РЕДАКТИРОВАТЬ: избегая петли

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

set.seed(1234)  #make new data with another numeric column
x <- data.frame(id=1:5, value=sample(20:30, 5, replace=T), year=3)
y <- data.frame(id=1:5, value=sample(10:19, 5, replace=T), year=2)
z <- data.frame(id=1:5, value=sample(0:9, 5, replace=T), year=1)
df <- rbind(x, y, z)
df <- df.rep <- data.frame(df[, 1:2], new.var=df[, 2]+sample(1:5, nrow(df), 
          replace=T), year=df[, 3])


df <- df[order(df$id, df$year), ]
diff2 <- function(x) diff(c(0, x))                   #function one
group.diff<- function(x) unlist(by(x, df$id, diff2)) #answer turned function
df <- data.frame(df, sapply(df[, 2:3], group.diff))  #apply group.diff to col 2:3
df[order(as.numeric(rownames(df))),]                 #reorder it

Конечно, вам придется переименовать их, если вы не используете transform как в:

df <- df[order(df$id, df$year), ]
diff2 <- function(x) diff(c(0, x))                   #function one
group.diff<- function(x) unlist(by(x, df$id, diff2)) #answer turned function
df <- transform(df, actual=group.diff(value), actual.new=group.diff(new.var))   
df[order(as.numeric(rownames(df))),]

Это будет зависеть от того, с какими переменными вы это делали.

Answer 2

1) diff.zoo .С пакетом zoo достаточно просто преобразовать его в zoo, используя split=, а затем выполнить diff:

library(zoo)

zz <- zz0 <- read.zoo(df, split = "id", index = "year", FUN = identity)
zz[2:3, ] <- diff(zz)

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

> zz
   1  2  3  4  5
1  6  5  2  9  2
2 10  5 10  7 13
3  5 16 14 10 14

Показанная широкая форма может быть предпочтительнее, но вы можете преобразовать ее в длинную форму, если хотите, например, так:

dt <- function(x) as.data.frame.table(t(x))
setNames(cbind(dt(zz), dt(zz0)[3]), c("id", "year", "value", "actual"))

Это устанавливает годы в порядке возрастания, который обычно используется в R.

2) rollapply .Также используя зоопарк, эта альтернатива использует скользящий расчет, чтобы добавить фактический столбец к вашим данным.Предполагается, что данные структурированы так, как вы показываете одинаковое количество лет в каждой группе, упорядоченные в следующем порядке:

df$actual <- rollapply(df$value, 6, partial = TRUE, align = "left",
   FUN = function(x) if (length(x) < 6) x[1] else x[1]-x[6])

3) вычитание .Делая те же предположения, что и в предыдущем решении, мы можем еще больше упростить его до того, что вычитает из каждого значения значение 5 позиций, следовательно:

transform(df, actual = value - c(tail(value, -5), rep(0, 5)))

или это изменение:

transform(df, actual = replace(value, year > 1, -diff(ts(value), 5)))

РЕДАКТИРОВАТЬ: добавлены rollapply и решения для вычитания.

Answer 3

Хакерский вид, но сохраняя свои замечательные Reduce, вы можете добавить фиктивные строки к вашему df на год 0:

mockRows <- data.frame(id = 1:5, value = 0, year = 0)
(df <- rbind(df, mockRows))
(df <- df[order(df$id, df$year), ])

(diffs <- lapply(split(df, df$id), function(x){diff(x$value)}))
(df <- df[df$year != 0,])

(df$actual <- Reduce(c, diffs)) # flatten the list of lists
df[order(as.numeric(rownames(df))),]

Это вывод:

   id value year actual
1   1    21    3      5
2   2    26    3     16
3   3    26    3     14
4   4    26    3     10
5   5    29    3     14
6   1    16    2     10
7   2    10    2      5
8   3    12    2     10
9   4    16    2      7
10  5    15    2     13
11  1     6    1      6
12  2     5    1      5
13  3     2    1      2
14  4     9    1      9
15  5     2    1      2