L oop в R, пробуя разные функции в логистике c регрессия подходит, чтобы найти лучший результат au c? - PullRequest
Новая
       111

L oop в R, пробуя разные функции в логистике c регрессия подходит, чтобы найти лучший результат au c?

0 голосов
/ 12 июля 2020

Я использую набор данных Iris, чтобы соответствовать логистической c регрессии. Я хочу подобрать каждую комбинацию функций, чтобы увидеть, что я могу получить за лучшую оценку AU C.

Например, я бы подобрал 4 * 3 * 2 * 1 = 24 модели. По сути, это перестановка каждой комбинации функций. Я хотел бы, чтобы он был выведен в таблицу, чтобы увидеть, какая комбинация дает мне лучший результат.

Верхние 3 строки набора данных 

  Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1          5.1         3.5          1.4         0.2  setosa
2          4.9         3.0          1.4         0.2  setosa
3          4.7         3.2          1.3         0.2  setosa

Подгонка одна модель

Вот просто примерка одной из моделей и получение AU C

## make it binary classification

library(ROCR)
library(tidyverse)
iris.small <- iris %>%
  filter(Species %in% c("virginica", "versicolor"))

is.na(iris.small$Species) <- iris.small$Species == "setosa"
iris.small$Species <- factor(iris.small$Species)

## 75% of the sample size
smp_size <- floor(0.75 * nrow(iris.small))

## set the seed to make your partition reproducible
set.seed(123)
train_ind <- sample(seq_len(nrow(iris.small)), size = smp_size)

train <- iris.small[train_ind, ]
test <- iris.small[-train_ind, ]

mod1 <- glm(Species ~ .,
  data = train,
  family = binomial(link = "logit")
)

pred_probs <- predict(mod1, newdata = test, type = "response")


pred_obj <- ROCR::prediction(pred_probs, test$Species)
perf_obj <- ROCR::performance(pred_obj, measure = "tpr", x.measure = "fpr")

auc <- performance(pred_obj, measure = "auc")
auc <- auc@y.values[[1]]

print(auc)

Предполагаемый результат Таблица с AU C баллы за каждую посадку. Было бы два столбца: подходящие характеристики и оценка AU C.

Кроме того, в целом, это хорошая идея? Установка 24 моделей может показаться не очень идеальной, но я не уверен, как определить, какие комбинации функций наиболее оптимальны.

Спасибо за вашу помощь.

1 Ответ

0 голосов
/ 12 июля 2020

Вы можете попробовать это. Я перечисляю полученные комбинации. 

library(plyr)
#Index
a1 <- as.data.frame(t(combn(1:4,1)))
a2 <- as.data.frame(t(combn(1:4,2)))
a3 <- as.data.frame(t(combn(1:4,3)))
a4 <- as.data.frame(t(combn(1:4,4)))
#Cols contains the combinations
Cols <- do.call(rbind.fill,list(a1,a2,a3,a4))

Затем у нас есть способ распределить переменные по индексу: 

   V1 V2 V3 V4
1   1 NA NA NA
2   2 NA NA NA
3   3 NA NA NA
4   4 NA NA NA
5   1  2 NA NA
6   1  3 NA NA
7   1  4 NA NA
8   2  3 NA NA
9   2  4 NA NA
10  3  4 NA NA
11  1  2  3 NA
12  1  2  4 NA
13  1  3  4 NA
14  2  3  4 NA
15  1  2  3  4

Следующий код вычисляет то, что вам нужно: 

## make it binary classification
library(ROCR)
library(tidyverse)
iris.small <- iris %>%
  filter(Species %in% c("virginica", "versicolor"))
is.na(iris.small$Species) <- iris.small$Species == "setosa"
iris.small$Species <- factor(iris.small$Species)
## 75% of the sample size
smp_size <- floor(0.75 * nrow(iris.small))
## set the seed to make your partition reproducible
set.seed(123)
train_ind <- sample(seq_len(nrow(iris.small)), size = smp_size)
train <- iris.small[train_ind, ]
test <- iris.small[-train_ind, ]
#Now create a list
List <- list()
#Iterate over all posible values of Cols
for(i in 1:dim(Cols)[1])
{
  #Variables
  #Define target and covariates
  vals <- as.vector(na.omit(t(Cols[i,])))
  target <- "Species"
  vars <- names(iris.small)[vals]
  #Create formulas
  string <- paste(target,'~', paste(vars, collapse= "+"))
  fmla <- as.formula(paste(target,'~', paste(vars, collapse= "+")))
  #Model 
  mod1 <- glm(formula = fmla,
              data = train,
              family = binomial(link = "logit"))
  pred_probs <- predict(mod1, newdata = test, type = "response")
  
  
  pred_obj <- ROCR::prediction(pred_probs, test$Species)
  perf_obj <- ROCR::performance(pred_obj, measure = "tpr", x.measure = "fpr")
  
  auc <- performance(pred_obj, measure = "auc")
  auc <- auc@y.values[[1]]
  #Save results
  output <- data.frame(Model=string,auc=auc)
  #Feed into list
  List[[i]] <- output
}
#Format as dataframe
DFResult <- do.call(rbind,List)

Вы получите: 

                                                         Model       auc
1                                       Species ~ Sepal.Length 0.7852564
2                                        Species ~ Sepal.Width 0.5128205
3                                       Species ~ Petal.Length 0.9903846
4                                        Species ~ Petal.Width 1.0000000
5                           Species ~ Sepal.Length+Sepal.Width 0.7403846
6                          Species ~ Sepal.Length+Petal.Length 1.0000000
7                           Species ~ Sepal.Length+Petal.Width 1.0000000
8                           Species ~ Sepal.Width+Petal.Length 0.9935897
9                            Species ~ Sepal.Width+Petal.Width 1.0000000
10                          Species ~ Petal.Length+Petal.Width 1.0000000
11             Species ~ Sepal.Length+Sepal.Width+Petal.Length 1.0000000
12              Species ~ Sepal.Length+Sepal.Width+Petal.Width 1.0000000
13             Species ~ Sepal.Length+Petal.Length+Petal.Width 1.0000000
14              Species ~ Sepal.Width+Petal.Length+Petal.Width 1.0000000
15 Species ~ Sepal.Length+Sepal.Width+Petal.Length+Petal.Width 1.0000000
...