为R中表格的每一行计算线性趋势线

Question

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

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

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 行。

最好的，克里斯托夫

Answer 1

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 语法进行循环。

Answer 2

使用您的数据，

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

如果您可以控制数据最初的排列方式，那么以另一种方式存储数据可能会更容易，将列作为时间序列而不是行，因为这样可以避免在以下情况下转置大矩阵适合通过lm.fit()。理想情况下，您最初希望数据排列如下：

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

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

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

Answer 3

我遇到了和 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)

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

Answer 4

还是这样？

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)