我正在尝试计算无意中聚合的数据的滞后差异(或实际增长)。数据中的每个连续年份包括上一年的值。可以使用以下代码创建示例数据集:
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
答案 0 :(得分: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))),]
有很多方法可以做到这一点但是这个方法相当快并使用了基础。
这是第二个&amp;利用聚合和以下方式解决这个问题的第三种方法:
<强>骨料:强>
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))),]
这取决于您执行此操作的变量数量。
答案 1 :(得分:3)
1)diff.zoo 。使用动物园包只需要使用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 。同样使用zoo,此替代方法使用滚动计算将实际列添加到数据中。它假设数据的结构与您按顺序排列的每组中显示的年数相同:
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
和减法解决方案。
答案 2 :(得分:1)
有点hackish但保持你的精彩Reduce
你可以在第0年为你的df
添加模拟行:
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