3

是否有可能在不使用循环的情况下对数据帧的每一行进行线性回归?趋势线的输出(截距 + 斜率)应作为新列添加到原始数据框中。

为了让我的意图更清楚,我准备了一个非常小的数据示例:

day1 <- c(1,3,1)
day2 <- c(2,2,1)
day3 <- c(3,1,5)
output.intercept <- c(0,4,-1.66667)
output.slope <- c(1,-1,2)
data <- data.frame(day1,day2,day3,output.intercept,output.slope)

输入变量为day1-3;假设这些是连续 3 天不同商店的销售额。我想要做的是计算 3 行的线性趋势线并将输出参数添加到原始表(参见 output.intercept + output.slope)作为新列。

该解决方案在计算时间方面应该非常有效,因为实际数据帧有许多 100k 行。

最好的,克里斯托夫

4

4 回答 4

5
design.mat <- cbind(1,1:3)
response.mat <- t(data[,1:3])

reg <- lm.fit(design.mat, response.mat)$coefficients
data <- cbind(data, t(reg))
#  day1 day2 day3 output.intercept output.slope        x1 x2
#1    1    2    3          0.00000            1  0.000000  1
#2    3    2    1          4.00000           -1  4.000000 -1
#3    1    1    5         -1.66667            2 -1.666667  2

但是,如果您有大量数据,由于内存限制,可能需要循环。如果是这种情况,我将使用长格式 data.table 并使用包的by语法进行循环。

于 2014-02-14T16:15:54.780 回答
1

使用您的数据,

day1 <- c(1,3,1)
day2 <- c(2,2,1)
day3 <- c(3,1,5)
output.intercept <- c(0,4,-1.66667)
output.slope <- c(1,-1,2)
dat <- data.frame(day1,day2,day3)

我想你想要这样的东西:

fits <- lm.fit(cbind(1, seq_len(nrow(dat))), t(dat))
t(coef(fits))

这使

R> t(coef(fits))
         x1 x2
[1,]  0.000  1
[2,]  4.000 -1
[3,] -1.667  2

这些可以dat像这样添加

dat <- cbind(dat, t(coef(fits)))
names(dat)[-(1:3)] <- c("Intercept","Slope")

R> dat
  day1 day2 day3 Intercept Slope
1    1    2    3     0.000     1
2    3    2    1     4.000    -1
3    1    1    5    -1.667     2

如果您对数据最初的排列方式有任何控制权,那么以另一种方式存储数据可能会更容易,将列作为时间序列而不是行,因为它可以避免在拟合时必须转置大矩阵 via lm.fit()。理想情况下,您希望数据最初排列如下:

     [,1] [,2] [,3]
day1    1    3    1
day2    2    2    1
day3    3    1    5

即作为时间点的行而不是你现在拥有的单个系列。这是因为 R 期望数据的排列方式。请注意,我们必须datlm.fit()调用中转置您的内容,这将需要一个大对象的副本。因此,如果您可以控制这些数据在进入 R 之前如何排列/提供,那将有助于解决大问题。

lm.fit()使用它,因为它是底层的精益代码,lm()但我们避免了解析公式和创建模型矩阵的复杂性。如果您想要更高效,您可能需要自己进行 QR 分解(代码lm.fit()用于执行此操作),因为有一些事情lm.fit()可以作为健全性检查,如果您确定您可以取消这些检查数据不会导致奇异矩阵等。

于 2014-02-14T16:29:26.027 回答
1

我和OP有同样的问题。此解决方案适用于具有 NA 的数据。在这种情况下,所有先前的答案都会对我产生错误:

slp = function(x) {
  y = t(x)
  y = y[!is.na(y)]
  len = length(y):1
  b = cov(y,len)/var(len)
  return(b)}

reg_slp <- apply(data,1,slp)

仅获得斜率,但可以轻松添加截距。我怀疑这是否特别有效,但在我的情况下它是有效的。

于 2016-01-18T08:28:02.970 回答
0

还是像这样?

day1 <- c(1,3,1)
day2 <- c(2,2,1)
day3 <- c(3,1,5)
data <- data.frame(day1,day2,day3)
y<-1:3

reg<-apply(data,1,function(x) lm(as.numeric(x)~y))
data[,c("intercept","slope")]<-rbind(reg[[1]]$coef,reg[[2]]$coef,reg[[3]]$coef)
于 2014-02-14T16:29:47.760 回答