r - 表中每个单元格的线性回归

Question

我有四张 table 。他们每个人都有 4 行和 4 列。以下是四张表格。

对于第一个表，

t1 <- array(1:20, dim=c(4,4))


    [,1] [,2] [,3] [,4] 
[1,]    1    5    9   13 
[2,]    2    6   10   14 
[3,]    3    7   11   15 
[4,]    4    8   12   16

对于第二张表，

t2 <- array(6:25, dim=c(4,4))

     [,1] [,2] [,3] [,4]
[1,]    6   10   14   18
[2,]    7   11   15   19
[3,]    8   12   16   20
[4,]    9   13   17   21

对于第三张表，

t3 <- array(11:30, dim=c(4,4))

     [,1] [,2] [,3] [,4]
[1,]   11   15   19   23
[2,]   12   16   20   24
[3,]   13   17   21   25
[4,]   14   18   22   26

对于第 4 个表，

t4 <- array(21:30, dim=c(4,4))

     [,1] [,2] [,3] [,4]
[1,]   21   25   29   23
[2,]   22   26   30   24
[3,]   23   27   21   25
[4,]   24   28   22   26

对于每个表，我都有一组固定的 y 值。

t1 = 0.1 
t2 = 3
t4 = 0.5
t6 = 7

换句话说:

y <- c( 0.1, 3, 0.75, 7)

然后，我想从四个表中的每个单元格中提取 x 值。即对于 [1,1] 单元格，提取的 x 值应为 (0.1, 3, 0.5, 7)。我们逐一重复此步骤，直到表格的末尾，即 [4,4] 单元格。因此，我得到了总共 16 组 x 值，如下所示:

cell   x-values
[1,1]  (1,6,11,21) 
[1,2]  (5,10,15,25) 
…..
[4,4]  (16, 21,26,26)

然后我尝试为每个 y-x 对计算线性回归的 R2。换句话说，我想得到总共16个R2值如下:

For [1,1] cell, linear regression between (0.1, 3, 0.5, 7) and (1,6,11,21) = 0.6853
For [1,2] cell, linear regression between (0.1, 3, 0.5, 7) and (5,10,15,25) = 0.6853 
…..
For [4,4] cell, linear regression between (0.1, 3, 0.5, 7) and (16, 21,26,26) = 0.2719 

最后，我想得到一个包含以下两列的表格

cell   R2 
[1,1] 0.6853
[1,2] 0.6853
….
[4,4] 0.2719

我了解到要对 x 和 y 系列数据进行线性回归，我可以使用以下命令:

Rcoefficient <- summary(lm(y ~ x, data=faithful))$r.squared

但是，我无法从四个表中读取每组 x 值。我尝试使用 reshape ，但仍然无法正确使用。 Stackoverflow 的专家能否帮助建议一种使用 R 执行此操作的有效方法，因为我的真实表格非常大，有超过 1000 列和行。

非常感谢。

Answer 1

我会[*]通过将数组连接成一个 4 x 4 x 4 数组来就地操作数组:

t1 <- array(1:20, dim=c(4,4))
t2 <- array(6:25, dim=c(4,4))
t3 <- array(11:30, dim=c(4,4))
t4 <- array(21:30, dim=c(4,4))

tt <- array(c(t1,t2,t3,t4), dim = c(4,4,4))
## now you can remove the original arrays

给出:

> tt
, , 1

     [,1] [,2] [,3] [,4]
[1,]    1    5    9   13
[2,]    2    6   10   14
[3,]    3    7   11   15
[4,]    4    8   12   16

, , 2

     [,1] [,2] [,3] [,4]
[1,]    6   10   14   18
[2,]    7   11   15   19
[3,]    8   12   16   20
[4,]    9   13   17   21

, , 3

     [,1] [,2] [,3] [,4]
[1,]   11   15   19   23
[2,]   12   16   20   24
[3,]   13   17   21   25
[4,]   14   18   22   26

, , 4

     [,1] [,2] [,3] [,4]
[1,]   21   25   29   23
[2,]   22   26   30   24
[3,]   23   27   21   25
[4,]   24   28   22   26

然后我们使用 aperm() 重新排列数组的维度，以便您请求的索引以正确的顺序排列。作为最后一步，我们从这个数组创建一个矩阵。

X <- matrix(aperm(tt, c(3,1,2)), ncol = 4, byrow = TRUE)

aperm(tt, c(3,1,2)) 步骤产生

> aperm(tt, c(3,1,2))
, , 1

     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4
[2,]    6    7    8    9
[3,]   11   12   13   14
[4,]   21   22   23   24

, , 2

     [,1] [,2] [,3] [,4]
[1,]    5    6    7    8
[2,]   10   11   12   13
[3,]   15   16   17   18
[4,]   25   26   27   28

, , 3

     [,1] [,2] [,3] [,4]
[1,]    9   10   11   12
[2,]   14   15   16   17
[3,]   19   20   21   22
[4,]   29   30   21   22

, , 4

     [,1] [,2] [,3] [,4]
[1,]   13   14   15   16
[2,]   18   19   20   21
[3,]   23   24   25   26
[4,]   23   24   25   26

你想要的索引在列中，我们在创建矩阵时利用它，因为 R 会将置换数组视为从置换数组的列填充的向量。 X 结果

> X
      [,1] [,2] [,3] [,4]
 [1,]    1    6   11   21
 [2,]    2    7   12   22
 [3,]    3    8   13   23
 [4,]    4    9   14   24
 [5,]    5   10   15   25
 [6,]    6   11   16   26
 [7,]    7   12   17   27
 [8,]    8   13   18   28
 [9,]    9   14   19   29
[10,]   10   15   20   30
[11,]   11   16   21   21
[12,]   12   17   22   22
[13,]   13   18   23   23
[14,]   14   19   24   24
[15,]   15   20   25   25
[16,]   16   21   26   26

然后我们可以按照@January 的回答进行并拟合回归(尽管注意我明确传入了 y 因为 lm() 的作用域规则是非标准的我正在防御。)

y <- c( 0.1, 3, 0.75, 7)
r2 <- apply(X, 1, function(x, y) summary(lm(y ~ x))$r.squared, y = y)

这导致:

> head(r2)
[1] 0.7160542 0.7160542 0.7160542 0.7160542 0.7160542 0.7160542

请注意，您的文本和代码存在不一致。您声明响应是 (0.1, 3, 0.5, 7) 但将 y 定义为 c( 0.1, 3, 0.75, 7)。我显示的结果使用后者，而您的结果使用前者，因此存在差异。

[*] 在不了解更多上下文的情况下，我不确定我是否想要拟合数百万个线性模型...