改进 R 函数中的 for 循环

Question

我已经构建了一个基本函数来从我对几个变量感兴趣的 3 个模型中提取 AIC 和 BIC 值。但是，当它运行时，我的计算机经常停止并说它无法为向量分配 200MB（我正在使用一个大型数据集 - 超过 500K 案例，是的，我已将内存限制增加到最大 4000）。

如果我一次选择几个变量，我实际上已经设法运行它。我有兴趣一口气实际运行该函数，但也改进了我的函数代码，这样我就不必在运行它之前删除其他所有内容，也可能不必等待 30 分钟。我可能会使用修改后的 AIC 和 BIC 公式并添加其他内容，因此我宁愿保持 AIC 和 BIC 向量化不变，而不是切换到其他逻辑回归函数。我已经玩过它并添加了诸如 rm(model1) 之类的东西，但它可能几乎没有什么区别。您能否建议解决内存分配问题并可能加快功能的代码？

非常感谢

功能：

myF<-function(mydata,TotScore,group){
  BIC2<-BIC1<-BIC0<-AIC2<-AIC1<-AIC0<-rep(NA,length(ncol(mydata)))
  for (i in (1:ncol(mydata))){
    M0<-glm(mydata[,i] ~ TotScore,family=binomial,data=mydata,x=F,y=F,model=F)
    AIC0[i]<-extractAIC(M0)[2]
    BIC0[i]<-extractAIC(M0,k=log(length(M0$fitted.values)))[2]
    rm(M0)
    M1<-glm(mydata[,i] ~ TotScore+group,family=binomial,data=mydata,x=F,y=F,model=F)
    AIC1[i]<-extractAIC(M1)[2]
    BIC1[i]<-extractAIC(M1,k=log(length(M1$fitted.values)))[2]
    rm(M1)
    M2<-glm(mydata[,i] ~ TotScore+group+TotScore*group,family=binomial,data=mydata,x=F,y=F,model=F)
    AIC2[i]<-extractAIC(M2)[2]
    BIC2[i]<-extractAIC(M2,k=log(length(M2$fitted.values)))[2]
    rm(M2)
  }
  Results<-cbind(AIC0,AIC1,AIC2,BIC0,BIC1,BIC2)
  rownames(Results)<-names(mydata)
  return(Results) 
}

附：该模型可以尝试使用

##Random dataset example
v1<-sample(0:1, 500000, replace=TRUE, prob=c(.80,.20))
v2<-sample(0:1, 500000, replace=TRUE, prob=c(.85,.15))
v3<-sample(0:1, 500000, replace=TRUE, prob=c(.95,.05))
mydata<-as.data.frame(cbind(v1,v2,v3))
TotScore=rowSums(mydata)
group<-(rep (1:5,100000))
myF(mydata,TotScore,group)

Answer 1

具有离散预测变量的二项式数据的好处是您可以在不丢失信息的情况下聚合数据

set.seed(12345)
v1<-sample(0:1, 500000, replace=TRUE, prob=c(.80,.20))
v2<-sample(0:1, 500000, replace=TRUE, prob=c(.85,.15))
v3<-sample(0:1, 500000, replace=TRUE, prob=c(.95,.05))
mydata<-as.data.frame(cbind(v1,v2,v3))
mydata$TotScore <- rowSums(mydata)
mydata$group <- rep (1:5,100000)

library(reshape)
myFun2 <- function(Y, dataset){
  tmp <- as.data.frame(table(TotScore = dataset$TotScore, group = dataset$group, Response = dataset[, Y]))
  levels(tmp$Response) <- c("Failure", "Succes")
  tmp <- cast(TotScore + group ~ Response, data  = tmp, value = "Freq")
  tmp$TotScore <- as.numeric(levels(tmp$TotScore))[tmp$TotScore]
  output <- rep(NA, 6)
  names(output) <- paste(rep(c("AIC", "BIC"), 3), rep(0:2, each = 2), sep = "")
  m <- glm(cbind(Succes, Failure) ~ TotScore, data = tmp, family = binomial,
           model = FALSE, x = FALSE, y = FALSE)
  output[1:2] <- c(AIC(m), BIC(m))
  m <- glm(cbind(Succes, Failure) ~ TotScore + group, data = tmp, family = binomial,
           model = FALSE, x = FALSE, y = FALSE)
  output[3:4] <- c(AIC(m), BIC(m))
  m <- glm(cbind(Succes, Failure) ~ TotScore * group, data = tmp, family = binomial,
           model = FALSE, x = FALSE, y = FALSE)
  output[5:6] <- c(AIC(m), BIC(m))
  output
}


system.time({
  sapply(colnames(mydata)[1:3], myFun, dataset = mydata)
})
   user  system elapsed 
  3.10    0.06    3.15 

Answer 2

library(difR)
data(verbal)
verbal$TotScore <- rowSums(verbal[, c(1:24)])
verbal$group <- with(verbal, factor(Gender):factor(Anger > 20))

myFun <- function(Y, dataset){
  output <- rep(NA, 6)
  names(output) <- paste(rep(c("AIC", "BIC"), 3), rep(0:2, each = 2), sep = "")
  m <- glm(as.formula(paste(Y, "~ TotScore")), data = dataset, family = binomial,
      model = FALSE, x = FALSE, y = FALSE)
  output[1:2] <- c(AIC(m), BIC(m))
  m <- glm(as.formula(paste(Y, "~ TotScore + group")), data = dataset, 
     family = binomial, model = FALSE, x = FALSE, y = FALSE)
  output[3:4] <- c(AIC(m), BIC(m))
  m <- glm(as.formula(paste(Y, "~ TotScore * group")), data = dataset, 
      family = binomial, model = FALSE, x = FALSE, y = FALSE)
  output[5:6] <- c(AIC(m), BIC(m))
  output
}

sapply(colnames(verbal)[1:2], myFun, dataset = verbal)