Как я могу реализовать код R для AU C в алгоритме geneti c - PullRequest
Новая
       90

Как я могу реализовать код R для AU C в алгоритме geneti c

0 голосов
/ 08 апреля 2020

Я занимаюсь исследованием применения алгоритма geneti c к бинарной логистике c регрессии. У меня есть несколько вопросов для уточнения. Не могли бы вы мне помочь?

  1. Могу ли я использовать AI C или BI C в качестве функции пригодности в GA? (Я использовал их, и результаты показали, что GA является более точным, чем традиционная бинарная модель logisti c. Однако я обнаружил, что в большинстве работ они использовали AU C в качестве функции пригодности)

  2. Я попробовал GA, используя AU C в качестве функции пригодности согласно этой статье (http://atm.amegroups.com/article/view/18292/html), и это дает следующую ошибку. Можете ли вы создать небольшой воспроизводимый пример, чтобы преодолеть эту проблему?

Ошибка в model.frame.default (формула = as.numeri c (тей) ~pregnt.glm (trm,: переменные длины различаются (найдено для'pregnet.glm (trm, newdata = ted, type = "response") ')

Ответы [ 4 ]

0 голосов
/ 19 апреля 2020

Проблема в том, что вы используете admin для прогнозирования admin, который, конечно, получит AU C из 1. Вот пересмотренный код, который может работать на моем компьютере.

библиотека (pRO C) библиотека (gal go)
библиотека (rtkore) библиотека (R cpp) библиотека (aod) mydata <- read.csv ("<a href="https://stats.idre.ucla.edu/stat/data/binary.csv" rel="nofollow noreferrer">https://stats.idre.ucla.edu/stat/data/binary.csv" )

reg.fitness = function (chr, parent, tr, te, res) {
try = as.factor (parent $ data $ classes [tr]) trd = data.frame (parent $ data $ data [tr, as.numeri c (chr)]) trm = nnet :: nnet (try ~., data = cbind (trd, try = try), trace = F, size = 2 ) tey = as.factor (родительские $ data $ classes [te]) ted = data.frame (родительские $ data $ data [te, as.numeri c (chr)]) pred = предикат (trm, newdata = cbind) (ted, tey = tey), type = "raw") if (res) {ro c (tey, pred, уровни = уровни (tey), direction = "<") $ au c} else {прогноз (trm, newdata = cbind (ted, tey = tey), type = "class")}} </p>

reg.bb = configBB.VarSel (data = t (mydata [, - 1]), классы = mydata $ admit ,ification.method = "пользователь" ,ification.userFitnessFunc = reg.fitness, chromosomeSize = 2, ниши = 1, maxSolutions = 10, goalFitness = 0,9, saveVariable = "reg.bb", saveFrequency = 50, saveFile = "reg.bb.Rdata", main = "Logisti c" )

взрыв (рег. Бб)

участок (взрыв (рег. Бб))

0 голосов
/ 10 апреля 2020

@ Z. Чжан 

reg.fitness = function(chr, parent,tr,te,res) {
  try=as.factor(parent$data$classes[tr])
  trd =
    data.frame(parent$data$data[tr,as.numeric(chr)])
  trm = nnet::nnet(try ~ ., data = cbind(trd,try=try),trace=F,
                    size = 3)
  tey = as.factor(parent$data$classes[te])
  ted =
    data.frame(parent$data$data[te,as.numeric(chr)])
 pred=predict(trm,newdata = cbind(ted,tey=tey),type = "raw")
  if(res){
    roc(tey,pred,levels=levels(tey),
        direction = "<")$auc
  }
  else{
    predict(trm,newdata=cbind(ted,tey=tey),type="class")
  }

}




reg.bb = configBB.VarSel(data=t(data_set[,-ncol(data_set)]), 
                          classes=data_set$y, 
                          classification.method="user", 
                          classification.userFitnessFunc=reg.fitness, 
                          chromosomeSize=3, niches=1, maxSolutions=10,
                          goalFitness = 0.9, saveVariable="reg.bb",
                          saveFrequency=50, saveFile="reg.bb.Rdata", 
                          main="Logistic")
blast(reg.bb)

Это вывод, который я получил за первые 4 итерации 

[Bb] Starting, Solutions=10
[Bb]    #bb Sol Last    Fitness %Fit    Gen Time    Elapsed Total   Remaining

[e] Starting: Fitness Goal=0.9, Generations=(10 : 200)
[e] Elapsed Time    Generation  Fitness %Fit    [Next Generations]
[e] 0h 0m 0s    (m) 0   1   111.11% +GGGGGGGGGG
[e] 0h 0m 9s    *** 11  1   111.11% FINISH: 1 2 1 

[Bb]    1   1   Sol Ok  1   111.11% 11  9.33s   9s  10s 42s (0h 0m 42s )

[e] Starting: Fitness Goal=0.9, Generations=(10 : 200)
[e] Elapsed Time    Generation  Fitness %Fit    [Next Generations]
[e] 0h 0m 0s    (m) 0   1   111.11% +GGGGGGGGGG
[e] 0h 0m 10s   *** 11  1   111.11% FINISH: 1 1 3 

[Bb]    2   2   Sol Ok  1   111.11% 11  10.35s  20s 22s 50s (0h 0m 50s )

[e] Starting: Fitness Goal=0.9, Generations=(10 : 200)
[e] Elapsed Time    Generation  Fitness %Fit    [Next Generations]
[e] 0h 0m 0s    (m) 0   1   111.11% +GGGGGGGGGG
[e] 0h 0m 10s   *** 11  1   111.11% FINISH: 3 1 1 

[Bb]    3   3   Sol Ok  1   111.11% 11  9.93s   30s 34s 50s (0h 0m 50s )

[e] Starting: Fitness Goal=0.9, Generations=(10 : 200)
[e] Elapsed Time    Generation  Fitness %Fit    [Next Generations]
[e] 0h 0m 0s    (m) 0   1   111.11% +GGGGGGGGGG
[e] 0h 0m 10s   *** 11  1   111.11% FINISH: 1 2 2 

[Bb]    4   4   Sol Ok  1   111.11% 11  10s 40s 45s 45s (0h 0m 45)

График для всех 1000 итераций, где он дал то же значение фитнес-функции, что и 1

0 голосов
/ 13 апреля 2020

@ З. Чжан, вот воспроизводимый пример моего кода. 

library(pROC)
library(galgo) 
library(rtkore)
library(Rcpp)
library(aod)
mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
attach(mydata)


reg.fitness = function(chr, parent,tr,te,res) {
  try=as.factor(parent$data$classes[tr])
  trd =
    data.frame(parent$data$data[tr,as.numeric(chr)])
  trm = nnet::nnet(try ~ ., data = cbind(trd,try=try),trace=F,size = 2)
  tey = as.factor(parent$data$classes[te])
  ted =
    data.frame(parent$data$data[te,as.numeric(chr)])
 pred=predict(trm,newdata = cbind(ted,tey=tey),type = "raw")
  if(res){
    roc(tey,pred,levels=levels(tey),
        direction = "<")$auc
  }
  else{
    predict(trm,newdata=cbind(ted,tey=tey),type="class")
  }

}




reg.bb = configBB.VarSel(data=t(mydata[,-ncol(mydata)]), 
                          classes=admit ,
                          classification.method="user", 
                          classification.userFitnessFunc=reg.fitness, 
                          chromosomeSize=2 ,niches=1, maxSolutions=10,
                          goalFitness = 0.9, saveVariable="reg.bb",
                          saveFrequency=50, saveFile="reg.bb.Rdata", 
                          main="Logistic")
blast(reg.bb)

Plot(blast(reg.bb))
0 голосов
/ 08 апреля 2020

В пакете gal go функция стоимости может быть задана пользователем. Можете ли вы запустить программу, как описано в документе? Например, вы можете определить AU C как вашу цель; и вы используете нейронную сеть для предсказания, следующий код может помочь: 

reg.fitness <- function(chr, parent,tr,te,res) {
  try <- as.factor(parent$data$classes[tr])
  trd <-
    data.frame(parent$data$data[tr,as.numeric(chr)])
  trm <- nnet::nnet(try ~ ., data = cbind(trd,try=try),trace=F,
                    size = 5)
  tey <- as.factor(parent$data$classes[te])
  ted <-
    data.frame(parent$data$data[te,as.numeric(chr)])
  pred

 <- predict(trm,newdata = cbind(ted,tey=tey),type = "raw")
  if(res){
    roc(tey,pred,
        levels=levels(tey),
        direction = "<")$auc
  }
  else{
    predict(trm,newdata=cbind(ted,tey=tey),type="class")
  }

}

вы можете адаптировать модель, изменив этот чанк: trm <- nnet :: nnet (try ~., data = cbind (trd, try = try), trace = F, размер = 5) </p>

...