改进R函数内的循环

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

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) 

Answer 2

好的事审判有关离散预测二项式数据是可以聚合数据没有信息

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