改進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