logo标签列表

如何在R中使用SVM进行递归特征消除

rmachine-learningsvmfeature-selection
4

我有一个数据集，看起来像这样

    ID  885038  885039  885040  885041  885042  885043  885044  Class
1267359 2       0       0       0       0       1       0      0
1295720 0       0       0       0       0       1       0      0
1295721 0       0       0       0       0       1       0      0
1295723 0       0       0       0       0       1       0      0
1295724 0       0       0       1       0       1       0      0
1295725 0       0       0       1       0       1       0      0
1295726 2       0       0       0       0       1       0      1
1295727 2       0       0       0       0       1       0      1
1295740 0       0       0       0       0       1       0      1
1295742 0       0       0       0       0       1       0      1
1295744 0       0       0       0       0       1       0      1
1295745 0       0       0       0       0       1       0      1
1295746 0       0       0       0       0       1       0      1

为了进行递归特征消除，我按照以下步骤进行：

  1. 训练SVM分类器
  2. 计算所有特征的排名标准
  3. 删除排名值最小的特征
  4. 回到第1步

以下是我编写的R代码，用于执行上述操作，但它没有显示任何错误并且循环持续着训练集���长度。

data <- read.csv("dummy - Copy.csv", header = TRUE)
rownames(data) <- data[,1]
data<-data[,-1]

for (k in 1:length(data)){

  inTraining <- createDataPartition(data$Class, p = .70, list = FALSE)
  training <- data[ inTraining,]
  testing  <- data[-inTraining,]

  ## Building the model ####
  svm.model <- svm(Class ~ ., data = training, cross=10,metric="ROC",type="eps-regression",kernel="linear",na.action=na.omit,probability = TRUE)

  ###### auc  measure #######

  #prediction and ROC
  svm.model$index
  svm.pred <- predict(svm.model, testing, probability = TRUE)

  #calculating auc
  c <- as.numeric(svm.pred)
  c = c - 1
  pred <- prediction(c, testing$Class)
  perf <- performance(pred,"tpr","fpr")
  plot(perf,fpr.stop=0.1)
  auc <- performance(pred, measure = "auc")
  auc <- auc@y.values[[1]]

  #compute the weight vector
  w = t(svm.model$coefs)%*%svm.model$SV

  #compute ranking criteria
  weight_matrix = w * w

  #rank the features
  w_transpose <- t(weight_matrix)
  w2 <- as.matrix(w_transpose[order(w_transpose[,1], decreasing = FALSE),])
  a <- as.matrix(w2[which(w2 == min(w2)),]) #to get the rows with minimum values
  row.names(a) -> remove
  data<- data[,setdiff(colnames(data),remove)]
  print(length(data))
  length <- (length(data))
  cols_names <- colnames(data)
  print(auc)
  output <- paste(length,auc,sep=";")
  write(output, file = "output.txt",append = TRUE)
  write(cols_names, file = paste(length,"cols_selected", ".txt", sep=""))
}

打印输出的结果如下：
[1] 3
[1] 0.5
[1] 2
[1] 0.5
[1] 2
[1] 0.5
[1] 2
[1] 0.75
[1] 2
[1] 1
[1] 2
[1] 0.75
[1] 2
[1] 0.5
[1] 2
[1] 0.75

但是当我选择任何一个特征子集，例如特征3，并使用上述代码（不使用循环）构建SVM模型时，我得到的AUC值并不是0.75。

data <- read.csv("3.csv", header = TRUE)
rownames(data) <- data[,1]
data<-data[,-1]

  inTraining <- createDataPartition(data$Class, p = .70, list = FALSE)
  training <- data[ inTraining,]
  testing  <- data[-inTraining,]

  ## Building the model ####
  svm.model <- svm(Class ~ ., data = training, cross=10,metric="ROC",type="eps-regression",kernel="linear",na.action=na.omit,probability = TRUE)

  ###### auc  measure #######

  #prediction and ROC
  svm.model$index
  svm.pred <- predict(svm.model, testing, probability = TRUE)

  #calculating auc
  c <- as.numeric(svm.pred)
  c = c - 1
  pred <- prediction(c, testing$Class)
  perf <- performance(pred,"tpr","fpr")
  plot(perf,fpr.stop=0.1)
  auc <- performance(pred, measure = "auc")
  auc <- auc@y.values[[1]]

  print(auc)

prints output 
    [1] 3
    [1] 0.75 (instead of 0.5)

这两个代码都是一样的（一个带有递归循环，另一个没有任何递归循环），但对于相同的特征子集，AUC值却不同。

这两个代码所使用的三个特征（885041，885043和Class）是一样的，但它们给出了不同的AUC值。

1
我不明白为什么这个问题被投票降低了。我已经更新了我自己尝试的内容。我也进行了快速搜索，以确保它不是重复的... 这个问题与编程有关...这就是为什么在Stackoverflow上提问的原因。 - sp2
5
如果你能提供一个可重现的数据集示例，我相信这将是一篇不错的文章。 - www
2
我喜欢你做了研究，因为很多问题事先并不困扰。@www是指您的图片 - 要重现您的错误，我们需要相同的数据（这样我们就不必重新输入）来运行您的代码。此外，如果什么都没发生，一般来说最好提供比“它不起作用”更好的东西 - 许多人实际上会收到错误，但只是说“它不起作用”。您对www的回答比再次告诉我它不起作用要好。 - Hatt
3
如果SO提供了自动图片阅读器，可以将表格位图图像转换为文本，那么就没有问题了，但现在你所暗示的是我们需要重新输入数据以便测试你的编码的任何修改或改进，大多数人没有足够的动力来重新输入数据。这与Rhelp邮件列表读者面临的问题相同，几天前有人（你？）发布了类似标题的问题。引用CSV文件不可重复，发布图像文件略有改进，但还不够好。 - IRTFM
3
谢谢您提供建议，我已将其纳入帖子中。我希望现在代码是可重现的。 - sp2
显示剩余7条评论
1个回答
5
我认为只使用交叉验证就可以了。在你的代码中，你已经使用了10折交叉验证来测试误差。分割数据集似乎是不必要的。
由于你没有提到调整参数，所以`cost`或`gamma`将设置为默认值。
library(tidyverse)
library(e1071)
library(caret)
library(ROCR)
library(foreach)

这个特征名是数字的，看起来svm()在拟合过程中会更改它的名称。为了匹配之后的结果，我会先更改列名。

其次，可以使用caret::creadeFolds()来分配折叠，而不是使用createDataPartition()。

set.seed(1)
k <- 5 # 5-fold CV
mydf3 <-
  mydf %>% 
  rename_at(.vars = vars(-ID, -Class), .funs = function(x) str_c("X.", x, ".")) %>% 
  mutate(fold = createFolds(1:n(), k = k, list = FALSE)) # fold id column

# the number of features-------------------------------
x_num <-
  mydf3 %>% 
  select(-ID, -Class, -fold) %>% 
  ncol()

为了迭代，foreach() 可以是另一个选项。
cl <- parallel::makeCluster(2)
doParallel::registerDoParallel(cl, cores = 2)
parallel::clusterExport(cl, c("mydf3", "x_num"))
parallel::clusterEvalQ(cl, c(library(tidyverse), library(ROCR)))
#---------------------------------------------------------------
svm_rank <-
  foreach(j = seq_len(x_num), .combine = rbind) %do% {
    mod <-
      foreach(cv = 1:k, .combine = bind_rows, .inorder = FALSE) %dopar% { # parallization
        tr <-
          mydf3 %>% 
          filter(fold != cv) %>% # train
          select(-fold, -ID) %>% 
          e1071::svm( # fitting svm
           Class ~ .,
           data = .,
           kernel = "linear",
           type = "eps-regression",
           probability = TRUE,
           na.action = na.omit
          )
        # auc
        te <-
          mydf3 %>% 
          filter(fold == cv) %>% 
          predict(tr, newdata = ., probability = TRUE)
        predob <- prediction(te, mydf3 %>% filter(fold == cv) %>% select(Class))
        auc <- performance(predob, measure = "auc")@y.values[[1]]
        # ranking - your formula
        w <- t(tr$coefs) %*% tr$SV
        if (is.null(names(w))) colnames(w) <- attr(tr$terms, "term.labels") # when only one feature left
        (w * w) %>%
          tbl_df() %>%
          mutate(auc = auc)
      }
    auc <- mean(mod %>% select(auc) %>% pull()) # aggregate cv auc
    w_mat <- colMeans(mod %>% select(-auc)) # aggregate cv ranking
    remove <- names(which.min(w_mat)) # minimum rank
    used <-
      mydf3 %>% 
      select(-ID, -Class, -fold) %>% 
      names() %>% 
      str_c(collapse = " & ")
    mydf3 <-
      mydf3 %>%
      select(-remove) # remove feature for next step
    tibble(used = used, delete = remove, auc = auc)
  }
#---------------------------------------------------
parallel::stopCluster(cl)

对于每个步骤，您可以获得：
svm_rank
#> # A tibble: 7 x 3
#>   used                                                      delete     auc
#>   <chr>                                                     <chr>    <dbl>
#> 1 X.885038. & X.885039. & X.885040. & X.885041. & X.885042… X.88503…   0.7
#> 2 X.885038. & X.885040. & X.885041. & X.885042. & X.885043… X.88504…   0.7
#> 3 X.885038. & X.885041. & X.885042. & X.885043. & X.885044. X.88504…   0.7
#> 4 X.885038. & X.885041. & X.885043. & X.885044.             X.88504…   0.7
#> 5 X.885038. & X.885041. & X.885043.                         X.88504…   0.7
#> 6 X.885038. & X.885041.                                     X.88503…   0.7
#> 7 X.885041.                                                 X.88504…   0.7
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接