使用ggplot2的stat_contour()绘制拟合的支持向量机模型的决策边界问题

Question

我正在尝试弄清楚如何在ggplot2中为拟合的svm模型绘制决策边界。现在，我正在尝试使用stat_contour来完成此操作。下面是我的代码，最后是对我的函数的示例调用。你可以在我的github页面上找到我正在使用的数据文件：

train.txt

test.txt

train <- read.table('train.txt', col.names = c('digit', 'intensity', 'symmetry'))
test <- read.table('test.txt', col.names = c('digit', 'intensity', 'symmetry'))    

        digits.SVM <- function(train, test, digits = c(1, 5), C = 0.01, kernel = 'radial', degree = 3, gamma = 1, coef0 = 0, scale = FALSE, type = 'C-classification', plotApproximation = FALSE) {
              library(e1071)
              library(ggplot2)
              library(reshape2)
              if(length(digits) != 1 && length(digits) != 2)
                stop('Invalid length of digits vector.  Must specify one or two digits to classify')
              if(length(digits) == 2) {
                train <- train[(train$digit == digits[1]) | (train$digit == digits[2]), ]
                test <- test[(test$digit == digits[1]) | (test$digit == digits[2]), ]
              }

              train$class <- -1
              test$class <- -1
              train[train$digit == digits[1], ]$class <- 1
              test[test$digit == digits[1], ]$class <- 1
              fit <- svm(class~intensity + symmetry, data = train, cost = C, kernel = kernel, degree = degree, gamma = gamma, coef0 = coef0, scale = scale, type = type)
              class_fitted <- predict(fit, train[c('intensity', 'symmetry')])

              gridRange <- apply(train[c('intensity', 'symmetry')], 2, range)
              x1 <- seq(from = gridRange[1, 1] - 0.025, to = gridRange[2, 1] + 0.025, length = 75)
              x2 <- seq(from = gridRange[1, 2] - 0.05, to = gridRange[2, 2] + 0.05, length = 75)
              grid <- expand.grid(intensity = x1, symmetry = x2)
              grid$class <- predict(fit, grid)
              decisionValues <- predict(fit, grid, decision.values = TRUE)
              grid$z <- as.vector(attributes(decisionValues)$decision)
              print(colnames(grid))
              print(head(grid))
              p <- ggplot(data = grid, aes(intensity, symmetry, colour = as.factor(class))) + 
                geom_point(size = 1.5) +
                scale_fill_manual(values = c('red', 'black')) + 
                stat_contour(data = grid, aes(x = intensity, y = symmetry, z = z), breaks = c(0)) + 
                geom_point(data = train, aes(intensity, symmetry, colour = as.factor(class)), alpha = 0.7) +
                scale_colour_manual(values = c('red', 'black')) + labs(colour = 'Class') +
                scale_x_continuous(expand = c(0,0)) +
                scale_y_continuous(expand = c(0,0))
              print(p)
              mean(train$class != class_fitted)
            }

    digits.SVM(train, test, digits = c(0), kernel = 'polynomial', degree = 2, coef0 = 1)

我的问题是在stat_contour()中设置"breaks“选项时出现的。我设置break的大多数值都不会导致任何问题；下面是break= -1时的结果图。

​

​

然而，正确的边界对应于设置中断= 0所产生的轮廓，并且当我设置更接近0的中断时，ggplot开始出现绘制轮廓的问题。它开始截断，值恰好为0，它根本不会绘制等高线。

以下是包含breaks =-0.05的绘图的示例：

​

如你所见，边界开始被切断。下面是使用breaks =0绘制的图：

​

整个轮廓都被切掉了。

我还收到了这个错误消息：

警告消息: 1:无法生成等高线数据

我对ggplot2比较陌生，不确定stat_contour()在后台做什么。我试图寻找它的实现，但没有运气。任何帮助和澄清都将不胜感激！

我也欢迎任何关于实现这一目标的更好方法的建议。

Answer 1

我仍然有兴趣学习如何使用ggplot2创建类似的图。

以下是我的更新代码和一些示例图：

train <- read.table('train.txt', col.names = c('digit', 'intensity', 'symmetry'))
test <- read.table('test.txt', col.names = c('digit', 'intensity', 'symmetry'))

    digits.SVM <- function(train, test, digits = c(1, 5), C = 0.01, kernel = 'radial', degree = 3, gamma = 1, coef0 = 0, scale = FALSE, type = 'C-classification', classification.plot = FALSE) {
      library(e1071)
      if(length(digits) != 1 && length(digits) != 2)
        stop('Invalid length of digits vector.  Must specify one or two digits to classify')
      if(length(digits) == 2) {
        train <- train[(train$digit == digits[1]) | (train$digit == digits[2]), ]
        test <- test[(test$digit == digits[1]) | (test$digit == digits[2]), ]
      }

      train$class <- -1
  test$class <- -1
      train[train$digit == digits[1], ]$class <- 1
      test[test$digit == digits[1], ]$class <- 1
      fit <- svm(class~intensity + symmetry, data = train, cost = C, kernel = kernel, degree = degree, gamma = gamma, coef0 = coef0, scale = scale, type = type)
      train$fitted <- predict(fit, train[c('intensity', 'symmetry')])
      test$fitted <- predict(fit, test[c('intensity', 'symmetry')])

      if(classification.plot) {
        gridRange <- apply(train[c('intensity', 'symmetry')], 2, range)
        x1 <- seq(from = gridRange[1, 1] - 0.025, to = gridRange[2, 1] + 0.025, length = 75)
        x2 <- seq(from = gridRange[1, 2] - 0.05, to = gridRange[2, 2] + 0.05, length = 75)
        grid <- expand.grid(intensity = x1, symmetry = x2)
        grid$class <- predict(fit, grid)
        decisionValues <- predict(fit, grid, decision.values = TRUE)
        grid$z <- as.vector(attributes(decisionValues)$decision)

        ##  TESTING PURPOSES  
        #   print(range(grid$z))
    #   print(sum(train$fitted == -1))
        #   print(length(train$fitted))

        ##  GGPLOT VERSION OF PLOT; CONTOUR NEEDS DEBUGGING  
        #   library(ggplot2)
        #   p <- ggplot(data = grid, aes(intensity, symmetry, colour = as.factor(class))) + 
        #     geom_point(size = 1.5) +
        #     scale_fill_manual(values = c('red', 'black')) + 
        #     stat_contour(data = grid, aes(x = intensity, y = symmetry, z = z), breaks = c(0)) + 
        #     geom_point(data = train, aes(intensity, symmetry, colour = as.factor(class)), alpha = 0.7) +
        #     scale_colour_manual(values = c('red', 'black')) + labs(colour = 'Class') +
        #     scale_x_continuous(expand = c(0,0)) +
        #     scale_y_continuous(expand = c(0,0))
        #   print(p)

        par(mfrow = c(1,2))
        ## Note: RGB Specification seems to increase running and plotting time complexity
        plot(grid[c('intensity', 'symmetry')], col = ifelse(grid$class == 1, '#0571B070', '#CA002070'), main = 'Training', pch='20', cex=.2)
        points(train[c('intensity', 'symmetry')], col = ifelse(train$class == 1, '#0571B070', '#CA002070'))
        contour(x1, x2, matrix(grid$z, length(x1), length(x2)), level=0, lwd = 1.5, drawlabels = FALSE, add=TRUE)
        plot(grid[c('intensity', 'symmetry')], col = ifelse(grid$class == 1, '#0571B070', '#CA002070'), main = 'Test', pch='20', cex=.2)
        points(test[c('intensity', 'symmetry')], col = ifelse(test$class == 1, '#0571B070', '#CA002070'))
        contour(x1, x2, matrix(grid$z, length(x1), length(x2)), level=0, lwd = 1.5, drawlabels = FALSE, add=TRUE)
        mtext(paste('Digit Classification Plots:', digits[1], 'vs', ifelse(length(digits) == 2, digits[2], 'All'), '\nKernel:', kernel, '\nC:', C), line = -3, outer = TRUE)
      }

      list(E_in = mean(train$fitted != train$class), E_out = mean(test$fitted != test$class), num_support_vectors = nrow(fit$SV))
    }

digits.SVM(train, test, digits = c(0), kernel = 'polynomial', degree = 2, coef0 = 1, classification.plot = TRUE)

digits.SVM(train, test, digits = c(1, 5), kernel = 'radial', gamma = 1, C = 10^6, classification.plot = TRUE)

​

​

​

​