Faz uso das funções kernel.

tutorials/05-support-vector-machine.Rmd

 ---
 title: "Máquinas de vetores de suporte"
 author: Prof. Walmes M. Zeviani & Prof. Eduardo V. Ferreira
-date: 2017-10-10
+date: 2018-10-17
 #bibliography: ../config/Refs.bib
 #csl: ../config/ABNT-UFPR-2011-Mendeley.csl
 ---
@@ -105,6 +105,9 @@ ls("package:quadprog")
 # Acesso à documentação.
 # help(package = "quadprog", help_type = "html")
 
+# Matriz de diagramas de dispersão.
+splom(iris[, 1:4], groups = iris$Species)
+
 # Aplicando para os dados de duas especies de `iris` com as variáveis de
 # comprimento apenas.
 da <- droplevels(subset(iris,
@@ -327,7 +330,8 @@ baseada no pacote `quadprog` é revisitado usando implementações de SVM.
 O pacote [`e1071`](https://cran.r-project.org/web/packages/e1071/)
 possui a função `svm()` que dá acesso a implementação disponível na
 [`libsvm`](https://www.csie.ntu.edu.tw/~cjlin/libsvm/) desenvolvida em
-C++.
+C++.  A `e1071::svm()` tem 4 opções para funções kernel que serão
+comentadas posteriormente. Consulte a documentação para mais detalhes.
 
 ```{r}
 library(e1071)
@@ -336,6 +340,7 @@ ls("package:e1071")
 # Acessa a documentação da função.
 # help(svm, package = "e1071", help_type = "html")
 
+# Aplica SVM para classificação.
 m0 <- svm(x = X,
           y = y,
           scale = FALSE,
@@ -398,13 +403,17 @@ O pacote [`kernlab`](https://cran.r-project.org/web/packages/kernlab)
 possui a função `ksvm()` que também se comunica com a `libsvm`.  No
 entanto, a arquitetura do pacote `kernlab` é S4.
 
-A diferença é que o `kernlab` permite empregar o truque do kernel porque
-possui várias funções kernel implementadas. Funções kernel serão
+A diferença é que o `kernlab` permite explorar mais o truque do kernel
+porque possui várias funções kernel implementadas além de permitir que o
+usuário defina suas próprias funções kernel. Funções kernel serão
 consideradas adiante.
 
 ```{r}
 library(kernlab)
 
+# Acesso à documentação.
+# help(ksvm, package = "kernlab", help_type = "html")
+
 # Funções kernel.
 grep(ls("package:kernlab"), pattern = "dot$", value = TRUE)
 
@@ -413,12 +422,12 @@ m1 <- ksvm(x = X,
            y = y,
            scale = FALSE,
            type = "C-svc",
-           kernel = "vanilladot", # Sem função kernel.
+           kernel = "vanilladot", # Kernel linear.
            C = 1)
 m1
 
 # Estrutura do objeto.
-str(m1)
+# str(m1)
 
 # Classe, arquitetura e métodos.
 class(m1)
@@ -470,31 +479,47 @@ if (length(i)) {
 
 # Funções kernel
 
+## Explorando as funções kernel
+
 Essa seção explora um pouco das funções kernel.
 
 ```{r}
-# help(dots, package = "kernlab", h = "html")
+# Dois vetores para empregar nas funções kernel.
+x1 <- c(-1, 0, 1)
+x2 <- c(0, 1, 2)
 
-# Revelando o código de uma função kernel.
-rbfkernel <- rbfdot(sigma = 0.1)
-rbfkernel
+# Funções kernel.
+grep(ls("package:kernlab"), pattern = "dot$", value = TRUE)
+
+# Kernel linear (default)
+knl <- vanilladot()
+kpar(knl)   # Parâmetros da função kernel.
+knl(x1, x2) # Aplicação.
+
+# Kernel polinomial.
+knl <- polydot(degree = 3, scale = 1, offset = 1)
+kpar(knl)   # Parâmetros da função kernel.
+knl(x1, x2) # Aplicação.
 
-# Parâmetros da função.
-kpar(rbfkernel)
+# Kernel de base radial.
+knl <- rbfdot(sigma = 1)
+kpar(knl)   # Parâmetros da função kernel.
+knl(x1, x2) # Aplicação.
 
-# Mostra o corpo da função.
-body(rbfkernel)
+# Para exibir o código da função kernel.
+str(knl)
+# knl@.Data
+body(knl)
+class(knl)
 
 # Função kernel definida pelo usuário (tirado da documentação).
-k <- function(x, y) {
+knl <- function(x, y) {
     (sum(x * y) + 1) * exp(-0.001 * sum((x - y)^2))
 }
-class(k) <- "kernel"
+class(knl) <- "kernel"
 
 # Avaliando a função kernel.
-x <- runif(10)
-y <- runif(10)
-k(x, y)
+knl(x1, x2)
 
 #-----------------------------------------------------------------------
 # Expansão de características por meio de funções kernel.
@@ -502,18 +527,13 @@ k(x, y)
 # help(kernelMatrix, h = "html")
 
 # Duas características.
-x1 <- cbind(seq(0, 10, by = 1))
-x2 <- cbind(seq(-1, 1, length.out = 11))
+x1 <- cbind(head(iris$Sepal.Length)) # Vetor coluna.
+x2 <- cbind(head(iris$Petal.Length)) # Vetor coluna.
 cbind(x1, x2)
 
 # Kernel linear.
-body(vanilladot())
-
-kernelMatrix(vanilladot(), x1)
-x1 %*% t(x1)
-tcrossprod(x1)
-
-kernelMatrix(vanilladot(), x1, x2)
+# body(vanilladot())
+kernelMatrix(kernel = vanilladot(), x1, x2)
 x1 %*% t(x2)
 tcrossprod(x1, x2)
 
@@ -537,3 +557,81 @@ showMethods(ksvm)
 getMethod(f = ksvm, signature = "formula")
 getMethod(f = ksvm, signature = "matrix")
 ```
+
+## Ajustes com diferentes funções kernel
+
+### Linear
+
+```{r}
+# k <- grep(ls("package:kernlab"), pattern = "dot$", value = TRUE)
+# dput(k)
+k <- c("besseldot",
+       "laplacedot",
+       "polydot",
+       "rbfdot",
+       "splinedot",
+       "tanhdot",
+       "vanilladot")
+
+# Todos os ajustes com o valor default dos parâmetros da função kernel.
+fits <- sapply(k,
+               simplify = FALSE,
+               FUN = ksvm,
+               x = X,
+               y = y,
+               scale = FALSE,
+               type = "C-svc",
+               C = 1)
+
+# Valor da função objetivo (ordenado) e núm de pontos de suporte.
+perf <- data.frame(obj = sapply(fits, FUN = getElement, "obj"),
+                   nSV = sapply(fits, FUN = getElement, "nSV"))
+perf[order(-perf$obj), ]
+
+# Acurácia.
+perf$acc <- sapply(fits,
+                   FUN = function(m0) {
+                       # Tabela de confusão.
+                       tb <- table(m0@ymatrix, m0@fitted)
+                       sum(diag(tb))/sum(tb)
+                   })
+perf[order(-perf$obj), ]
+
+# Extração dos valores preditos.
+fitteds <- lapply(fits, FUN = predict, newdata = grid[, 1:2])
+str(fitteds)
+
+# Cria tabela com eles.
+fitteds <- data.frame(kernel = rep(k, each = nrow(grid)),
+                      pred = unlist(fitteds))
+fitteds <- cbind(fitteds, grid[, 1:2])
+
+# Ordena as funções kernel pela acurácia.
+fitteds$kernel <- factor(fitteds$kernel,
+                         levels = rownames(perf)[order(-perf$acc)])
+levels(fitteds$kernel)
+str(fitteds)
+
+# Gráfico.
+xyplot(Petal.Length ~ Sepal.Length | kernel,
+       groups = pred,
+       data = fitteds,
+       as.table = TRUE,
+       aspect = 1,
+       pch = 1,
+       alpha = 0.5,
+       cex = 0.5) +
+    as.layer({
+        xyplot(X[, 2] ~ X[, 1],
+               groups = y,
+               pch = 19)
+    })
+```
+
+Na prática, os hiperparâmetros das funções são determinados por valiação
+cruzada, bem como o parâmetro de penalidade `C`.
+
+Neste tutorial foi considerado o SVM apenas para classificação, mas
+versões para regressão e descoberta de novidade também estão
+disponíveis. Consulte a documentação e veja o argumento `type` da
+`ksmv()`.