0

いくつかの変数に関心のある 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) 
}

PSモデルはで試すことができます 

##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)
4

2 に答える 2

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
于 2012-08-07T15:41:55.783 に答える
0 
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)
于 2012-08-07T13:24:32.237 に答える