2012-03-04 109 views
5

我試圖計算已被無意中聚合的數據的滯後差異(或實際增加)。數據中的每一年都包含前一年的數值。從數據框中每個分組行的值中減去前一年的值

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()組合來計算,每年的區別,每唯一的ID,像這樣:

(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 

回答

4

我認爲這會爲你工作。當遇到差異問題時,通過將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))),] 

這將取決於你有多少變量,這樣做是爲了。

+0

奇怪。我的'set.seed()'顯然不起作用。我用實際數字更新了它。 – Andrew 2012-03-04 06:52:15

+0

這太棒了!是否有一種簡單的方法可以使任何這些函數適用於任意數量的列,例如,如果存在2+錯誤彙總變量:'x < - data.frame(id = 1:5,value = sample(20:30, 5,replace = T),value1 = sample(20:30,5,replace = T),year = 3)'等等? – Andrew 2012-03-04 17:19:51

+0

我的意思是,我試圖做的是運行相同的'as.vector(sapply(seq_along(...'一次爲多個列的函數(不只是2)。我基本上試圖運行該功能在列的範圍內使用'lapply'(2:x) – Andrew 2012-03-04 17:30:20

1

類的hackish但保持到位您的精彩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 
3

1)差異。動物園。隨着動物園配套使用split=將其轉換爲動物園,然後執行它只是一個問題的diff

library(zoo) 

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

它提供了以下(寬形式,而不是長期形成你所提到的),其中每列是一個id每一行是一年減去上一年

> 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和減法解決方案。

相關問題