Odejmij poprzedni rok od wartości z każdego zgrupowanego wiersza w ramce danych

Question

Próbuję obliczyć opóźnioną różnicę (lub rzeczywisty wzrost) dla danych, które zostały nieumyślnie zsumowane. Każdy kolejny rok w danych zawiera wartości z poprzedniego roku. Zestaw przykładowe dane mogą być tworzone z tym kodem:

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

mogę użyć kombinacji lapply() i split() obliczyć różnicę między każdego roku dla każdego unikalnego ID, tak jak poniżej:

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

jednak , ze względu na naturę funkcji diff(), nie ma wyników dla wartości w roku 1, co oznacza, że ​​po spłaszczeniu listy diffs z Reduce(), nie mogę dodać rzeczywistych rocznych wzrostów z powrotem do ramki danych, tak jak to :

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

W tym przykładzie występuje tylko 10 obliczonych różnic lub opóźnień, podczas gdy w ramce danych znajduje się 15 wierszy, więc R generuje błąd podczas próby dodania nowej kolumny.

Jak utworzyć nową kolumnę rzeczywistych wzrostów z (1) wartościami dla roku 1 i (2) obliczonych różnic/opóźnień dla wszystkich kolejnych lat?

To jest wynik, którego ostatecznie szukam. Moja lista list diffs oblicza rzeczywiste wartości dla lat 2 i 3 po prostu dobrze.

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

Myślę, że to zadziała dla Ciebie. Gdy napotkasz problem z różnicami, po prostu wydłuż wektor, wpisując 0 jako pierwszą liczbę.

Istnieje wiele sposobów na zrobienie tego, ale ten jest dość szybki i wykorzystuje bazę.

Oto drugi & Trzecim sposobem zbliżania się tego problemu z wykorzystaniem kruszywa i przez:

łączna:

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

przez:

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] 

To daje produkt końcowy:

> 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 

EDIT: Unikanie pętli

Mogę zaproponować unikanie pętli i obracając co dałem wam do funkcji (rozwiązanie jest najłatwiejsze do obsłużenia) i sapply to do dwóch kolumn, które chcesz.

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 

Oczywiście trzeba by zmienić nazwę tych chyba że użyłeś transform jak w:

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

będzie to zależeć od tego, ile zmienne robisz to.

Answer 2

Rodzaju hackish ale utrzymywanie zamieść wspaniały Reduce można dodać makiety wierszy do swojej df do roku 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))),] 

To wyjście:

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 

Answer 3

1) diff. zoo. Z zoo spakowania jej tylko kwestia przekształcenie go do zoo użyciu split= a następnie wykonujący diff:

library(zoo) 

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

Daje następujące (w szerokiej formie, zamiast długiej postaci pan wspomniał), gdzie każda kolumna jest identyfikatorem a każdy wiersz jest rokiem minus przed roku:

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

szeroka forma pokazano może faktycznie być korzystne, ale można przekonwertować go do długiej formie, jeśli chcesz to tak:

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

Stawia lata w porządku rosnącym, który jest zwykle używany w konwencji R.

2) rollapply. Również przy użyciu zoo ta alternatywa wykorzystuje obliczenia kroczące, aby dodać rzeczywistą kolumnę do danych. To zakłada, że ​​dane jest skonstruowany jak pokazać się z tej samej liczby lat w każdej grupie ułożone w kolejności:

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) odejmowanie. Wykonywanie tych samych założeń, jak w rozwiązaniu ze stanu można dodatkowo uprościć tylko ta, która odejmowanie od każdej wartości wartość 5 pozycji: ten

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

lub tym wariancie:

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

EDIT: dodano rollapply i odejmowanie rozwiązań.