lm模型在两个矩阵的列的所有可能的成对组合上

时间:2014-04-22 07:35:35

标签: r loops matrix apply lm

我正在解决R中的一个问题,并且已经陷入困境。我已经搜索了各种帮助列表以寻求帮助,但找不到任何东西 - 但如果我错过了某些内容,我会道歉。我的问题的一个虚拟例子如下。我将继续努力,但任何帮助将不胜感激。

提前感谢您的时间。

我有一个响应变量矩阵:

p<-matrix(c(rnorm(120,1),
    rnorm(120,1),
    rnorm(120,1)),
    120,3)

和两个协变量矩阵:

g<-matrix(c(rep(1:3, each=40),
    rep(3:1, each=40),
    rep(1:3, 40)),
    120,3)

m<-matrix(c(rep(1:2, 60),
    rep(2:1, 60),
    rep(1:2, each=60)),
    120,3)

对于协变量矩阵g和m的列的所有组合,我想运行这两个模型:

test <- function(uniq_m, uniq_g, p = p) {   
    full <- lm(p ~ factor(uniq_m) * factor(uniq_g))
        null <- lm(p ~ factor(uniq_m) + factor(uniq_g))
        return(list('f'=full, 'n'=null))
}

所以我想测试m的第1列和g的第1列之间的相互作用,然后测试m的第2列和第1列的第2列,然后是第2列的m和第2列的g ...等等所有可能的成对相互作用。响应变量每次都相同,并且是包含多个列的矩阵。

到目前为止,我可以针对单个列组合执行此操作:

test_1 <- test(m[ ,1], g[ ,1], p)

我还可以在m的所有列和g:

的一个列上运行模型
test_2 <- apply(m, 2, function(uniq_m) {
    test(uniq_m, g[ ,1], p = p)
})

然后,我可以获取每个模型的每个响应变量的F统计信息:

sapply(summary(test_2[[1]]$f), function(x) x$fstatistic)
sapply(summary(test_2[[1]]$n), function(x) x$fstatistic)

我可以使用F检验比较每个响应变量的模型:

d1<-colSums(matrix(residuals(test_2[[1]]$n),nrow(g),ncol(p))^2)
d2<-colSums(matrix(residuals(test_2[[2]]$f),nrow(g),ncol(p))^2)
F<-((d1-d2) / (d2/114))

我的问题是如何在m和g矩阵的所有列组合上运行lm模型,并获得F统计量?

虽然这是一个虚拟的例子,真正的分析将有一个700 x 8000的响应矩阵,协变量矩阵将是700 x 4000和700 x 100,所以我需要尽可能快的东西。

1 个答案:

答案 0 :(得分:0)

希望这会有所帮助,这是我朋友与我分享的一些代码。它可能不是你需要的,但可能会让你朝着正确的方向前进(虽然这比你提出的要晚了9个月,但对你来说可能毫无用处!):

#### this first function models the correlation and fixes the text size based on the strength of the correlation
panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- abs(cor(x, y))
  txt <- format(c(r, 0.123456789), digits = digits)[1]
  txt <- paste0(prefix, txt)
  if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex.cor * r)
}

##### this function places a histogram of your data on the diagonal
panel.hist <- function(x, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  h <- hist(x, plot = FALSE)
  breaks <- h$breaks; nB <- length(breaks)
  y <- h$counts; y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col="cyan", ...)
}

### read in Fishers famous iris dataset for our example
data(iris)
head(iris)

library(corrgram)
##corrgram also gives you some nice panel options to use in pairs, but you dont necesarily need them
##e.g. panel.ellipse, panel.pie, panel.conf
library(asbio)
##asbio offers more panel options, such as a linear regression (panel.lm) etc

### run pairs() on your data
### set upper panel to panel.cor (the function we just wrote), and diagonal to panel.hist
### do what you like for the lower, add a smoother line isnt very informative
pairs(~ Sepal.Length + Sepal.Width + Petal.Length,  data=iris, lower.panel=panel.lm, upper.panel=panel.cor, diag.panel = panel.hist, main="pair plots of variables")

归功于詹姆斯基廷。