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

时间:2012-10-16 06:12:16

标签: r linear-regression

我有四张桌子。他们每个人都有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

对于第3张表,

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值。我试图使用重塑,但我仍然无法做到正确。 Stackoverflow中的专家可以帮助建议一种有效的方法来使用R,因为我的真实表非常大,有超过1000列和行。

非常感谢。

2 个答案:

答案 0 :(得分:7)

我会[*]通过将它们连接成一个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()的范围规则是非标准的,而我是&#39我是防守的。)

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)。我展示的结果使用后者但你的结果使用前者,因此差异。

[*]在不了解更多关于背景的情况下我不确定我是否想要适应数百万个线性模型...

答案 1 :(得分:-2)

首先,让我们重新格式化数据。

编辑:此代码不是最优的,请参阅另一个答案中的Gavins解决方案。

t <- NULL
for( row in 1:nrow( t1 ) ) {
  for( col in 1:ncol( t1 ) ) {
    t <- rbind( t, c( t1[ row, col ], t2[ row, col ], t3[ row, col ], t4[ row, col ] ) )
   }
 }

这将生成一个包含四列(每个表一列)和nrow * ncol行的矩阵 - 与一个表中的单元格一样多的行。请使用dim( t )进行检查。现在可以轻松运行回归:

apply( t, 1, function( x ) { summary( lm( y ~ x ) )$r.squared )