Introducción

El aprendizaje automatizado —machine learning (ML)— es una rama de la inteligencia artificial cuyo objetivo es que una máquina aprenda a partir de la experiencia. Básicamente los algoritmos toman un conjunto de datos, los analizan para buscar en ellos ciertas pautas y una vez identificadas, las emplean para realizar predicciones. En otras palabras se trata de predecir el comportamiento futuro a partir de comportamientos pasados observados.

Dependiendo de cómo se aborde el problema del ML, los diferentes algoritmos se pueden agrupar en:

Algoritmo K Nearest Neighbors (KNN)

Algoritmo de clasificación supervisada donde dado un objeto a clasificar y sus \(K\) vecinos más cercanos, será clasificado al grupo con mayor probabilidad de pertenencia.

Ejemplo en R

data( iris )

Preprocesar datos:

Incluye normalizar si es necesario, reducir el número de variables si fuese necesario….

P.e. \(\frac{x-\overline{x}}{\sigma^2}\), es lo que hace la función scale()

normalize<-function( x ){
  num <- x - min( x )
  denom <- max( x ) - min( x )
  return ( num / denom )
}
NormIris <- as.data.frame( lapply( iris[ , 1:4 ], normalize ) )
summary( NormIris )
##   Sepal.Length     Sepal.Width      Petal.Length     Petal.Width     
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.00000  
##  1st Qu.:0.2222   1st Qu.:0.3333   1st Qu.:0.1017   1st Qu.:0.08333  
##  Median :0.4167   Median :0.4167   Median :0.5678   Median :0.50000  
##  Mean   :0.4287   Mean   :0.4406   Mean   :0.4675   Mean   :0.45806  
##  3rd Qu.:0.5833   3rd Qu.:0.5417   3rd Qu.:0.6949   3rd Qu.:0.70833  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.00000
NormIris <- scale( iris[ , 1:4 ], scale = TRUE, center = TRUE )
summary( NormIris )
##   Sepal.Length       Sepal.Width       Petal.Length      Petal.Width     
##  Min.   :-1.86378   Min.   :-2.4258   Min.   :-1.5623   Min.   :-1.4422  
##  1st Qu.:-0.89767   1st Qu.:-0.5904   1st Qu.:-1.2225   1st Qu.:-1.1799  
##  Median :-0.05233   Median :-0.1315   Median : 0.3354   Median : 0.1321  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.67225   3rd Qu.: 0.5567   3rd Qu.: 0.7602   3rd Qu.: 0.7880  
##  Max.   : 2.48370   Max.   : 3.0805   Max.   : 1.7799   Max.   : 1.7064

Previsualizar datos

plot( iris[ , 1:4 ], col = iris$Species )

Generar las muestras

#generar muestras
iris.train <- iris[ sample( c( 1:150 ), 100 ), 1:5 ]

iris.test <- iris[ sample( c( 1:150 ), 50 ), 1:5 ]

Entrenar/testar clasificador

# Genera modelo y hace predicción a la vez
iris.pred <- knn( train = iris.train[ , 1:4 ], test = iris.test[ , 1:4 ], 
                cl = iris.train[ , 5 ], k = 3 )

# predicción
iris.pred
##  [1] virginica  virginica  virginica  versicolor virginica  virginica 
##  [7] versicolor setosa     setosa     virginica  virginica  virginica 
## [13] virginica  versicolor virginica  versicolor versicolor virginica 
## [19] setosa     virginica  versicolor setosa     setosa     virginica 
## [25] setosa     setosa     setosa     virginica  versicolor virginica 
## [31] versicolor versicolor versicolor setosa     virginica  setosa    
## [37] virginica  virginica  versicolor virginica  setosa     virginica 
## [43] virginica  virginica  virginica  setosa     versicolor versicolor
## [49] setosa     virginica 
## Levels: setosa versicolor virginica
# realidad 
iris.test[ , 5 ]
##  [1] virginica  virginica  virginica  versicolor virginica  virginica 
##  [7] versicolor setosa     setosa     virginica  virginica  virginica 
## [13] virginica  versicolor virginica  versicolor versicolor virginica 
## [19] setosa     virginica  versicolor setosa     setosa     virginica 
## [25] setosa     setosa     setosa     virginica  virginica  virginica 
## [31] versicolor versicolor versicolor setosa     virginica  setosa    
## [37] virginica  virginica  versicolor virginica  setosa     virginica 
## [43] virginica  virginica  virginica  setosa     versicolor versicolor
## [49] setosa     virginica 
## Levels: setosa versicolor virginica

Validar resultados

table( Predic = iris.pred, Test = iris.test[ , 5 ])
##             Test
## Predic       setosa versicolor virginica
##   setosa         13          0         0
##   versicolor      0         12         1
##   virginica       0          0        24

Si encuentro un iris en el campo y mido pétalo y sépalo, puedo utilizar mi clasificador para determinar a que variedad pertenece.

miIris <- c( 5.0, 3.5, 1.3, 0.1 )
mi_predict <- knn( train = iris.train[ , 1:4 ], test = miIris, 
                cl = iris.train[ , 5 ], k = 3, prob = TRUE ) 

mi_predict
## [1] setosa
## attr(,"prob")
## [1] 1
## Levels: setosa versicolor virginica

Máquina de soporte de vectores (SVM)

Algoritmo de clasificación supervisada, donde dado un conjunto de datos etiquetados, el algoritmo construye un límite o frontera óptimo, llamado hiperplano, que separa los datos según su categoría para posteriormente asignar nuevos datos al grupo con mayor probabilidad de pertenencia.

Ejemplo en R

data( iris )

Preprocesar datos:

Incluye normalizar si es necesario, reducir el número de variables si fuese necesario….

Generar las muestras

#generar muestras
iris.train <- iris[ sample( c( 1:150 ), 100 ), 1:5 ]

iris.test <- iris[ sample( c( 1:150 ), 30 ), 1:5 ]

Aplicar SVM

# Esta función sólo genera el modelo
svm_model <- svm( Species ~ . , data = iris.train, scale = TRUE, kernel = "radial", probability = TRUE)
summary( svm_model )
## 
## Call:
## svm(formula = Species ~ ., data = iris.train, kernel = "radial", 
##     probability = TRUE, scale = TRUE)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  radial 
##        cost:  1 
##       gamma:  0.25 
## 
## Number of Support Vectors:  36
## 
##  ( 5 15 16 )
## 
## 
## Number of Classes:  3 
## 
## Levels: 
##  setosa versicolor virginica

Hacer predicción con el conjunto de datos de iris.test.

SVM_predict <- predict( svm_model, iris.test[,1:4], probability=TRUE, decision.values=TRUE )
SVM_predict
##         32         11         34         78        135         28 
##     setosa     setosa     setosa  virginica  virginica     setosa 
##         59         66         84         85        113         33 
## versicolor versicolor  virginica versicolor  virginica     setosa 
##        131         18         30         44         24         48 
##  virginica     setosa     setosa     setosa     setosa     setosa 
##         51        114         77         21        143         87 
## versicolor  virginica versicolor     setosa  virginica versicolor 
##         68        137         58         39         64         70 
## versicolor  virginica versicolor     setosa versicolor versicolor 
## attr(,"decision.values")
##     setosa/virginica setosa/versicolor virginica/versicolor
## 32         0.9809602         1.0050895          -0.79562897
## 11         1.0425524         1.1123509          -0.41151230
## 34         1.0533645         1.0690537          -0.07234348
## 78        -1.0230573        -1.1065099           0.11028768
## 135       -1.0381514        -1.0679279           0.34821920
## 28         1.0573757         1.1638427          -0.51423851
## 59        -0.8135834        -1.1381612          -0.99973848
## 66        -0.7685513        -1.1128184          -1.11505966
## 84        -1.0871895        -1.2091425           0.26239049
## 85        -0.7461580        -1.0982352          -0.74635631
## 113       -1.1510783        -0.8812122           1.28817714
## 33         1.0045817         1.0507866          -0.07897456
## 131       -1.0897151        -0.5729400           1.20075192
## 18         1.0707520         1.1657438          -0.50375684
## 30         1.0956063         1.1882959          -0.51935373
## 44         1.0001773         1.0003575          -0.65704603
## 24         1.0000716         0.9727791          -0.87337511
## 48         1.0974388         1.2125220          -0.42392842
## 51        -0.8110662        -1.0000814          -0.74921866
## 114       -1.1536347        -1.0413581           1.00000441
## 77        -0.8953520        -1.0499259          -0.49971160
## 21         0.9857414         1.0557530          -0.72860422
## 143       -1.1486558        -1.1269335           0.89984277
## 87        -0.8742941        -1.1324786          -0.67756808
## 68        -0.6058483        -1.1409474          -1.63821027
## 137       -1.0223631        -0.7535694           1.09897358
## 58        -0.3976681        -1.0001878          -1.10628137
## 39         1.0457813         1.1034242          -0.37786869
## 64        -0.8818025        -1.2516970          -0.77964257
## 70        -0.7102644        -1.2471948          -1.37485871
## attr(,"probabilities")
##          setosa   virginica  versicolor
## 32  0.935998900 0.021559144 0.042441956
## 11  0.945591948 0.023676778 0.030731274
## 34  0.937480997 0.031220932 0.031298071
## 78  0.013827196 0.657005954 0.329166850
## 135 0.013038630 0.810363773 0.176597597
## 28  0.953253899 0.020440647 0.026305453
## 59  0.012160357 0.039832324 0.948007319
## 66  0.013280041 0.027542075 0.959177884
## 84  0.010899713 0.764362825 0.224737462
## 85  0.014854386 0.089654812 0.895490802
## 113 0.009980655 0.981496239 0.008523106
## 33  0.930591632 0.035692707 0.033715661
## 131 0.013757579 0.974040278 0.012202143
## 18  0.954099983 0.019823331 0.026076686
## 30  0.957664240 0.018102512 0.024233248
## 44  0.935501454 0.022562626 0.041935920
## 24  0.933474060 0.019988612 0.046537328
## 48  0.957747098 0.019381633 0.022871268
## 51  0.018836996 0.089036931 0.892126073
## 114 0.009597920 0.968560623 0.021841457
## 77  0.016737371 0.187946155 0.795316474
## 21  0.941801572 0.021601815 0.036596613
## 143 0.009527384 0.959950627 0.030521988
## 87  0.013801830 0.110467137 0.875731033
## 68  0.012787158 0.005679096 0.981533746
## 137 0.015815733 0.967691234 0.016493032
## 58  0.023525603 0.029539084 0.946935313
## 39  0.944246834 0.024297094 0.031456072
## 64  0.009570957 0.080364340 0.910064703
## 70  0.008876588 0.011620259 0.979503153
## Levels: setosa versicolor virginica

Contrastar la predicción con la realidad

# Versión simple
table( SVM_predict, Realidad = as.factor( iris.test[ , 5 ] ) )
##             Realidad
## SVM_predict  setosa versicolor virginica
##   setosa         12          0         0
##   versicolor      0         10         0
##   virginica       0          2         6
# Versión más completa
CrossTable( x = SVM_predict, y =  iris.test[ , 5 ], dnn = c( "Predicción", "Real" ) )
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  30 
## 
##  
##              | Real 
##   Predicción |     setosa | versicolor |  virginica |  Row Total | 
## -------------|------------|------------|------------|------------|
##       setosa |         12 |          0 |          0 |         12 | 
##              |     10.800 |      4.800 |      2.400 |            | 
##              |      1.000 |      0.000 |      0.000 |      0.400 | 
##              |      1.000 |      0.000 |      0.000 |            | 
##              |      0.400 |      0.000 |      0.000 |            | 
## -------------|------------|------------|------------|------------|
##   versicolor |          0 |         10 |          0 |         10 | 
##              |      4.000 |      9.000 |      2.000 |            | 
##              |      0.000 |      1.000 |      0.000 |      0.333 | 
##              |      0.000 |      0.833 |      0.000 |            | 
##              |      0.000 |      0.333 |      0.000 |            | 
## -------------|------------|------------|------------|------------|
##    virginica |          0 |          2 |          6 |          8 | 
##              |      3.200 |      0.450 |     12.100 |            | 
##              |      0.000 |      0.250 |      0.750 |      0.267 | 
##              |      0.000 |      0.167 |      1.000 |            | 
##              |      0.000 |      0.067 |      0.200 |            | 
## -------------|------------|------------|------------|------------|
## Column Total |         12 |         12 |          6 |         30 | 
##              |      0.400 |      0.400 |      0.200 |            | 
## -------------|------------|------------|------------|------------|
## 
## 

Y con mi muestra encontrada en el campo

miIris <- matrix( c( 5.0, 3.5, 1.3, 0.1 ), nrow = 1, ncol = 4 )
colnames( miIris ) <- colnames( iris[ , 1:4 ] )

# predict requiere un matrix o data.frame no un vector
predict( svm_model, miIris )
##      1 
## setosa 
## Levels: setosa versicolor virginica

Clasificador Naïve Bayes

Es un clasificador probabilístico “ingenuo” basado en el teorema de Bayes, que asume que la probabilidad de cada variable es independiente de las demás. Básicamente su lógica se basa en que dado un conjunto de datos de entrenamiento etiquetados, el clasificador calcula la probabilidad observada para cada clase, en función de los valores de sus variables. Cuando es usado posteriormente para predecir datos sin etiquetar, asigna estos datos a la clase con mayor probabilidad de pertenencia.

iris.NB <- naiveBayes( Species ~ ., data = iris.train )
iris.NB
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##     setosa versicolor  virginica 
##       0.29       0.36       0.35 
## 
## Conditional probabilities:
##             Sepal.Length
## Y                [,1]      [,2]
##   setosa     4.965517 0.3763318
##   versicolor 5.938889 0.5044249
##   virginica  6.605714 0.6480481
## 
##             Sepal.Width
## Y                [,1]      [,2]
##   setosa     3.434483 0.4037997
##   versicolor 2.780556 0.3105934
##   virginica  2.980000 0.3279168
## 
##             Petal.Length
## Y                [,1]      [,2]
##   setosa     1.475862 0.1550465
##   versicolor 4.230556 0.4281652
##   virginica  5.594286 0.5161753
## 
##             Petal.Width
## Y                 [,1]      [,2]
##   setosa     0.2275862 0.1098588
##   versicolor 1.3166667 0.1874643
##   virginica  2.0685714 0.2948294
predNB <- predict( iris.NB, iris.test[ , 1:4 ] )
predNB
##  [1] setosa     setosa     setosa     virginica  virginica  setosa    
##  [7] versicolor versicolor versicolor versicolor virginica  setosa    
## [13] virginica  setosa     setosa     setosa     setosa     setosa    
## [19] versicolor virginica  versicolor setosa     virginica  versicolor
## [25] versicolor virginica  versicolor setosa     versicolor versicolor
## Levels: setosa versicolor virginica

Contrastar la predicción

table( Predicción = predNB, Real = iris.test[ , 5 ] )
##             Real
## Predicción  setosa versicolor virginica
##   setosa         12          0         0
##   versicolor      0         11         0
##   virginica       0          1         6

Y con mi muestra encontrada en el campo

miIris<-matrix( c( 5.0, 3.5, 1.3, 0.1 ), nrow = 1, ncol = 4)
colnames( miIris ) <-colnames( iris[ , 1:4 ] )

# predict requiere un matrix o data.frame no un vector
predict( iris.NB, miIris )
## [1] setosa
## Levels: setosa versicolor virginica

Redes Neuronales

Es un modelo de aprendizaje automatizado inspirados en los modelos neuronales biológicos. Constituidos por una serie de nodos (neuronas) y una serie de conexiones entre los nodos (sinapsis).

La topología básica consta de unos nodos de entrada al sistema, generalmente tantos nodos como variables. Una serie de capas ocultas intermedias con un número variable de nodos, y unos nodos de salida, uno por cada respuesta. Cada nodo de entrada tiene asociado un peso \(W_i\) y en cada nodo se aplica una función de activación (opcional) y una de propagación con la suma de las entradas ponderadas por sus pesos.

Aunque hay muchas topologías, ésta es conocida como perceptrón

Ejemplo de clasificación mediante NN

Preprocesar datos:

Incluye normalizar si es necesario, reducir el número de variables si fuese necesario….

Generar las muestras

#generar muestras
iris.train <- iris[ sample( c( 1:150 ), 100 ), 1:5 ]
iris.test <- iris[ sample( c( 1:150 ), 50 ), 1:5 ]

Binarizar las categorias (dummy transformation)

iris.train <- cbind( iris.train, iris.train$Species == "setosa" )
iris.train <- cbind( iris.train, iris.train$Species == "versicolor" )
iris.train <- cbind( iris.train, iris.train$Species == "virginica" )

names( iris.train )[ 6 ] <- "setosa"
names( iris.train )[ 7 ] <- "versicolor"
names( iris.train )[ 8 ] <- "virginica"

Entrenar la red neuronal

iris.nnt <- neuralnet( setosa + versicolor + virginica ~ Sepal.Length +
            Sepal.Width +
            Petal.Length +
            Petal.Width, 
            data = iris.train, hidden = c( 3, 2 ) )
plot( iris.nnt, col.intercept = "blue" )

Predicción

pred.nn <- compute( iris.nnt, iris.test[ 1:4 ] )
pred.nn
## $neurons
## $neurons[[1]]
##     1 Sepal.Length Sepal.Width Petal.Length Petal.Width
## 104 1          6.3         2.9          5.6         1.8
## 128 1          6.1         3.0          4.9         1.8
## 79  1          6.0         2.9          4.5         1.5
## 110 1          7.2         3.6          6.1         2.5
## 126 1          7.2         3.2          6.0         1.8
## 107 1          4.9         2.5          4.5         1.7
## 118 1          7.7         3.8          6.7         2.2
## 39  1          4.4         3.0          1.3         0.2
## 16  1          5.7         4.4          1.5         0.4
## 45  1          5.1         3.8          1.9         0.4
## 14  1          4.3         3.0          1.1         0.1
## 111 1          6.5         3.2          5.1         2.0
## 143 1          5.8         2.7          5.1         1.9
## 46  1          4.8         3.0          1.4         0.3
## 6   1          5.4         3.9          1.7         0.4
## 32  1          5.4         3.4          1.5         0.4
## 144 1          6.8         3.2          5.9         2.3
## 113 1          6.8         3.0          5.5         2.1
## 30  1          4.7         3.2          1.6         0.2
## 9   1          4.4         2.9          1.4         0.2
## 120 1          6.0         2.2          5.0         1.5
## 92  1          6.1         3.0          4.6         1.4
## 58  1          4.9         2.4          3.3         1.0
## 116 1          6.4         3.2          5.3         2.3
## 35  1          4.9         3.1          1.5         0.2
## 17  1          5.4         3.9          1.3         0.4
## 25  1          4.8         3.4          1.9         0.2
## 78  1          6.7         3.0          5.0         1.7
## 51  1          7.0         3.2          4.7         1.4
## 136 1          7.7         3.0          6.1         2.3
## 20  1          5.1         3.8          1.5         0.3
## 103 1          7.1         3.0          5.9         2.1
## 70  1          5.6         2.5          3.9         1.1
## 98  1          6.2         2.9          4.3         1.3
## 22  1          5.1         3.7          1.5         0.4
## 68  1          5.8         2.7          4.1         1.0
## 121 1          6.9         3.2          5.7         2.3
## 81  1          5.5         2.4          3.8         1.1
## 50  1          5.0         3.3          1.4         0.2
## 75  1          6.4         2.9          4.3         1.3
## 139 1          6.0         3.0          4.8         1.8
## 36  1          5.0         3.2          1.2         0.2
## 93  1          5.8         2.6          4.0         1.2
## 77  1          6.8         2.8          4.8         1.4
## 112 1          6.4         2.7          5.3         1.9
## 125 1          6.7         3.3          5.7         2.1
## 115 1          5.8         2.8          5.1         2.4
## 117 1          6.5         3.0          5.5         1.8
## 10  1          4.9         3.1          1.5         0.1
## 55  1          6.5         2.8          4.6         1.5
## 
## $neurons[[2]]
##     [,1]                [,2] [,3]                [,4]
## 104    1 0.00005718474879615    1 0.27102881944308482
## 128    1 0.00008127095437357    1 0.04984524347740969
## 79     1 0.00213824365238305    1 0.01067941381268275
## 110    1 0.00000014937928351    1 0.54266772385051620
## 126    1 0.00016434676807349    1 0.24942374397372888
## 107    1 0.00004639842896279    1 0.07611613968959402
## 118    1 0.00001526289987444    1 0.59481374222258798
## 39     1 0.99997431409721205    1 0.00000019660368896
## 16     1 0.99999901514848810    1 0.00000001817868776
## 45     1 0.99998989627756452    1 0.00000024726039007
## 14     1 0.99999266402207954    1 0.00000009604840811
## 111    1 0.00001414618909919    1 0.07106387798686245
## 143    1 0.00000718113720338    1 0.19732047050187182
## 46     1 0.99989415708343177    1 0.00000024025809223
## 6      1 0.99999221948541361    1 0.00000009427006542
## 32     1 0.99992151138215779    1 0.00000012673479513
## 144    1 0.00000034796224861    1 0.53361514792981479
## 113    1 0.00000157993897936    1 0.24680983083973299
## 30     1 0.99998900657773704    1 0.00000025385945579
## 9      1 0.99996074273634228    1 0.00000030786283770
## 120    1 0.00010416047259701    1 0.12503826808412805
## 92     1 0.01154421409871697    1 0.00866478404968044
## 58     1 0.12789238884593118    1 0.00064931723861630
## 116    1 0.00000035421283230    1 0.22852493961729081
## 35     1 0.99998057866758094    1 0.00000019453819600
## 17     1 0.99999132538882440    1 0.00000003099857452
## 25     1 0.99999570196580811    1 0.00000038409006980
## 78     1 0.00022490937605474    1 0.03277890131633265
## 51     1 0.01931919936184634    1 0.00400649968209708
## 136    1 0.00000009913583353    1 0.57891422122503999
## 20     1 0.99999681206478486    1 0.00000006399086732
## 103    1 0.00000153792780235    1 0.43998192921667240
## 70     1 0.05294163292847986    1 0.00211558767560521
## 98     1 0.02262371585594613    1 0.00326158263173461
## 22     1 0.99998230861630810    1 0.00000009641178610
## 68     1 0.31970102022668234    1 0.00176296085949336
## 121    1 0.00000031496498678    1 0.37737610564252938
## 81     1 0.03497485425298395    1 0.00205648426016415
## 50     1 0.99999153435772647    1 0.00000009678601411
## 75     1 0.02070699821890084    1 0.00278482547287827
## 139    1 0.00008275095578928    1 0.04122922544390645
## 36     1 0.99998596151829733    1 0.00000006581186343
## 93     1 0.02279008397844591    1 0.00255362537164211
## 77     1 0.00362931061848669    1 0.01215690968084207
## 112    1 0.00000577992147512    1 0.21039738498772731
## 125    1 0.00000676133952910    1 0.27060363537782589
## 115    1 0.00000002047165249    1 0.40705847241193593
## 117    1 0.00007983692805829    1 0.16848829756710801
## 10     1 0.99999450372996646    1 0.00000015310888082
## 55     1 0.00111693079884995    1 0.01124525720242552
## 
## $neurons[[3]]
##     [,1]               [,2]         [,3]
## 104    1 1.0000000000000000 1.0000000000
## 128    1 0.9763373088075971 1.0000000000
## 79     1 0.0000073885129229 0.9999999991
## 110    1 1.0000000000000000 1.0000000000
## 126    1 1.0000000000000000 1.0000000000
## 107    1 0.9999992931556394 1.0000000000
## 118    1 1.0000000000000000 1.0000000000
## 39     1 0.5568908771925574 0.1786156419
## 16     1 0.5569728772023507 0.1785504099
## 45     1 0.5569586151771514 0.1786047766
## 14     1 0.5569549318804153 0.1785731170
## 111    1 0.9999947305042159 1.0000000000
## 143    1 1.0000000000000000 1.0000000000
## 46     1 0.5565722379536707 0.1787280274
## 6      1 0.5569529667598010 0.1785733651
## 32     1 0.5566713062772918 0.1786713594
## 144    1 1.0000000000000000 1.0000000000
## 113    1 1.0000000000000000 1.0000000000
## 30     1 0.5569556785910438 0.1786071584
## 9      1 0.5568471206684263 0.1786539452
## 120    1 0.9999999999999976 1.0000000000
## 92     1 0.0000038675850069 0.9999999875
## 58     1 0.0000010678981544 0.9991128901
## 116    1 1.0000000000000000 1.0000000000
## 35     1 0.5569159101285497 0.1786071107
## 17     1 0.5569431588506947 0.1785627876
## 25     1 0.5569954228510801 0.1786226195
## 78     1 0.0447065025836394 1.0000000000
## 51     1 0.0000006892247461 0.9999951475
## 136    1 1.0000000000000000 1.0000000000
## 20     1 0.5569684964720810 0.1785617747
## 103    1 1.0000000000000000 1.0000000000
## 70     1 0.0000005627144109 0.9999285142
## 98     1 0.0000005409872430 0.9999871788
## 22     1 0.5569132534746644 0.1785866510
## 68     1 0.0000380747083740 0.9988127937
## 121    1 1.0000000000000000 1.0000000000
## 81     1 0.0000004099261248 0.9999343072
## 50     1 0.5569504537130211 0.1785747229
## 75     1 0.0000004338015919 0.9999769608
## 139    1 0.5732009706433480 1.0000000000
## 36     1 0.5569249667536954 0.1785762224
## 93     1 0.0000004093976840 0.9999685587
## 77     1 0.0000136206957197 0.9999999999
## 112    1 1.0000000000000000 1.0000000000
## 125    1 1.0000000000000000 1.0000000000
## 115    1 1.0000000000000000 1.0000000000
## 117    1 1.0000000000000000 1.0000000000
## 10     1 0.5569679395945218 0.1785813126
## 55     1 0.0000090991802679 0.9999999996
## 
## 
## $net.result
##                   [,1]               [,2]               [,3]
## 104  0.000001917425144  0.029064923726835  0.970819536581201
## 128 -0.000003334683267  0.052104076185778  0.947790905243489
## 79  -0.000220037197697  1.002706595952870 -0.002377510918818
## 110  0.000001917425144  0.029064923726835  0.970819536581201
## 126  0.000001917425144  0.029064923726835  0.970819536581201
## 107  0.000001917268255  0.029065611945046  0.970818848677275
## 118  0.000001917425144  0.029064923726835  0.970819536581201
## 39   0.999987972345240  0.000061646840231 -0.000044210451455
## 16   1.000067414318925 -0.000054758852131 -0.000007263374684
## 45   1.000001216526319 -0.000010396832361  0.000014574226087
## 14   1.000039763140657 -0.000024557720966 -0.000009809894601
## 111  0.000001916255541  0.029070054365432  0.970814408285575
## 143  0.000001917425144  0.029064923726835  0.970819536581201
## 46   0.999851065539165  0.000434888510821 -0.000280477150188
## 6    1.000039460631559 -0.000022505310005 -0.000011559365038
## 32   0.999920084140357  0.000306664908823 -0.000221292804230
## 144  0.000001917425144  0.029064923726835  0.970819536581201
## 113  0.000001917425144  0.029064923726835  0.970819536581201
## 30   0.999998315884111 -0.000006202481417  0.000013281112198
## 9    0.999941326011575  0.000125721696230 -0.000061630180034
## 120  0.000001917425144  0.029064923726837  0.970819536581199
## 92  -0.000220023856043  1.002710017598087 -0.002380945121391
## 58   0.000860069466202  1.002215471378026 -0.002966469607938
## 116  0.000001917425144  0.029064923726835  0.970819536581201
## 35   0.999998365116635  0.000032491306622 -0.000025453051870
## 17   1.000052337123596 -0.000018885152418 -0.000028053568489
## 25   0.999979499892296 -0.000036232545461  0.000062117934833
## 78  -0.000210116995277  0.959185354706303  0.041123856895427
## 51  -0.000214131537149  1.002710399073561 -0.002387218088037
## 136  0.000001917425144  0.029064923726835  0.970819536581201
## 20   1.000053576084529 -0.000044122923583 -0.000004060375117
## 103  0.000001917425144  0.029064923726835  0.970819536581201
## 70  -0.000133001528532  1.002673170215640 -0.002431117558642
## 98  -0.000204429186355  1.002706076455408 -0.002392597590115
## 22   1.000023275370195  0.000023609074397 -0.000041479974424
## 68   0.001225462994700  1.002011217395728 -0.003127609954754
## 121  0.000001917425144  0.029064923726835  0.970819536581201
## 81  -0.000140054910132  1.002676566318685 -0.002427460389681
## 50   1.000037806874694 -0.000019297356777 -0.000013113035478
## 75  -0.000191988270589  1.002700453043957 -0.002399414817248
## 139 -0.000092813759639  0.444617314903437  0.555456912675450
## 36   1.000035975430484  0.000006358579432 -0.000036931889426
## 93  -0.000181758214757  1.002695766914143 -0.002404958529534
## 77  -0.000220036738094  1.002700528420412 -0.002371445233712
## 112  0.000001917425144  0.029064923726835  0.970819536581201
## 125  0.000001917425144  0.029064923726835  0.970819536581201
## 115  0.000001917425144  0.029064923726835  0.970819536581201
## 117  0.000001917425144  0.029064923726835  0.970819536581201
## 10   1.000029787324393 -0.000032628500828  0.000008233601895
## 55  -0.000220037382494  1.002704930623439 -0.002375845785519
resultado <- 0
for ( i in 1:dim( pred.nn$net.result )[ 1 ] )  resultado[ i ] <- which.max( pred.nn$net.result[ i, ] )

resultado[ resultado == 1 ] <- "setosa"
resultado[ resultado == 2 ] <- "versicolor"
resultado[ resultado == 3 ] <- "virginica"
resultado
##  [1] "virginica"  "virginica"  "versicolor" "virginica"  "virginica" 
##  [6] "virginica"  "virginica"  "setosa"     "setosa"     "setosa"    
## [11] "setosa"     "virginica"  "virginica"  "setosa"     "setosa"    
## [16] "setosa"     "virginica"  "virginica"  "setosa"     "setosa"    
## [21] "virginica"  "versicolor" "versicolor" "virginica"  "setosa"    
## [26] "setosa"     "setosa"     "versicolor" "versicolor" "virginica" 
## [31] "setosa"     "virginica"  "versicolor" "versicolor" "setosa"    
## [36] "versicolor" "virginica"  "versicolor" "setosa"     "versicolor"
## [41] "virginica"  "setosa"     "versicolor" "versicolor" "virginica" 
## [46] "virginica"  "virginica"  "virginica"  "setosa"     "versicolor"
table( Predicción = resultado, Real = iris.test[ , 5 ])
##             Real
## Predicción  setosa versicolor virginica
##   setosa         17          0         0
##   versicolor      0         13         0
##   virginica       0          0        20

Clasificación no supervisada. K-means como clasificador-predictor

En las técnicas multivariantes de clasificación, veremos el clustering no jerárquico o iterativo como técnica para generar grupos de datos en función de sus características.

Ésta es una técnica de clasificación no supervisada pues el clasificador no tiene información sobre las etiquetas de los datos. Genera grupos a los que etiqueta en función de los valores de las variables. Cuando se proporcionan nuevos datos, el clasificador los asignará a los grupos con mayor similitud.

mydata <- iris[ , -5 ]
ccl <- cclust( as.matrix( mydata ), 3, 20, method = "kmeans" )
clusplot( mydata, clus = ccl$cluster )

#observaciones extraidas de iris
test <- as.matrix( iris[ sample( c( 1:150 ), 20, replace = FALSE ) , ] )

#obsevación Simulada
test1 <- matrix( c( 6.6, 3.2, 5.4, 2.4 ), nrow = 1, ncol = 4 )

# Prediciones
kmPred <- predict( ccl, test[ ,1:4 ] )
kmPred$cluster
##  [1] 3 1 3 3 3 1 3 3 2 3 3 3 2 1 1 2 3 3 1 2
kmPred
## 
##                               Clustering on Test Set
## 
## 
## Number of Clusters:  3 
## Sizes  of Clusters:  5 4 11

Comprobar los resultados

kmPredLabel <- factor( kmPred$cluster, labels = c( "setosa", "versicolor", "virginica" ) )
table( Predicción = kmPredLabel, Real = test[ , 5 ] )
##             Real
## Predicción  setosa versicolor virginica
##   setosa          5          0         0
##   versicolor      4          0         0
##   virginica       0          6         5

Evaluar la eficacia del modelo

Vamos a estudiar algunos de los mecanismos existentes de validación de la clasificación realizada por nuestro modelo predictivo. para ello vamos a generar un modelo nuevo con datos de pacientes que tienen un tumor, cuyo diagnóstico está etiquetado como benigno o maligno.

La primera columna contiene un identificador del sujeto, la segunda corresponde al diagnóstico y el resto son variables medidas al tumor.

wdbc <- read.csv( "http://ares.inf.um.es/00RTeam/datos/wdbc.csv" )

head( wdbc )
##         id diagnosis radius_mean texture_mean perimeter_mean area_mean
## 1   842302         M       17.99        10.38         122.80    1001.0
## 2   842517         M       20.57        17.77         132.90    1326.0
## 3 84300903         M       19.69        21.25         130.00    1203.0
## 4 84348301         M       11.42        20.38          77.58     386.1
## 5 84358402         M       20.29        14.34         135.10    1297.0
## 6   843786         M       12.45        15.70          82.57     477.1
##   smoothness_mean compactness_mean concavity_mean concave.points_mean
## 1         0.11840          0.27760         0.3001             0.14710
## 2         0.08474          0.07864         0.0869             0.07017
## 3         0.10960          0.15990         0.1974             0.12790
## 4         0.14250          0.28390         0.2414             0.10520
## 5         0.10030          0.13280         0.1980             0.10430
## 6         0.12780          0.17000         0.1578             0.08089
##   symmetry_mean fractal_dimension_mean radius_se texture_se perimeter_se
## 1        0.2419                0.07871    1.0950     0.9053        8.589
## 2        0.1812                0.05667    0.5435     0.7339        3.398
## 3        0.2069                0.05999    0.7456     0.7869        4.585
## 4        0.2597                0.09744    0.4956     1.1560        3.445
## 5        0.1809                0.05883    0.7572     0.7813        5.438
## 6        0.2087                0.07613    0.3345     0.8902        2.217
##   area_se smoothness_se compactness_se concavity_se concave.points_se
## 1  153.40      0.006399        0.04904      0.05373           0.01587
## 2   74.08      0.005225        0.01308      0.01860           0.01340
## 3   94.03      0.006150        0.04006      0.03832           0.02058
## 4   27.23      0.009110        0.07458      0.05661           0.01867
## 5   94.44      0.011490        0.02461      0.05688           0.01885
## 6   27.19      0.007510        0.03345      0.03672           0.01137
##   symmetry_se fractal_dimension_se radius_worst texture_worst
## 1     0.03003             0.006193        25.38         17.33
## 2     0.01389             0.003532        24.99         23.41
## 3     0.02250             0.004571        23.57         25.53
## 4     0.05963             0.009208        14.91         26.50
## 5     0.01756             0.005115        22.54         16.67
## 6     0.02165             0.005082        15.47         23.75
##   perimeter_worst area_worst smoothness_worst compactness_worst
## 1          184.60     2019.0           0.1622            0.6656
## 2          158.80     1956.0           0.1238            0.1866
## 3          152.50     1709.0           0.1444            0.4245
## 4           98.87      567.7           0.2098            0.8663
## 5          152.20     1575.0           0.1374            0.2050
## 6          103.40      741.6           0.1791            0.5249
##   concavity_worst concave.points_worst symmetry_worst
## 1          0.7119               0.2654         0.4601
## 2          0.2416               0.1860         0.2750
## 3          0.4504               0.2430         0.3613
## 4          0.6869               0.2575         0.6638
## 5          0.4000               0.1625         0.2364
## 6          0.5355               0.1741         0.3985
##   fractal_dimension_worst
## 1                 0.11890
## 2                 0.08902
## 3                 0.08758
## 4                 0.17300
## 5                 0.07678
## 6                 0.12440
#eliminar columna de ID
wdbc <- wdbc[ -1 ]

# Normalizar los datos
wdbcN <- scale( wdbc[ 2:31 ], scale = TRUE, center = TRUE ) 

Crear datos de entrenamiento y datos de test

# Datos
wTrain <- wdbcN[ 1:469, ] # Los 469 primeros registros
wTest  <- wdbcN[ 470:569, ] # Los últimos 100 registros

# Etiquetas
wTrainLabel <- wdbc[ 1:469, 1 ]
wTestLabel  <- wdbc[ 470:569, 1 ]

Entrenar el modelo

wPredict<- knn( wTrain, wTest, cl = wTrainLabel, k = 21, prob = TRUE )
wPredict
##   [1] B B B B B B B B B B M B B B B B B B M B B B B M B B B B B M M B M B M
##  [36] B B B B B M B B M B B B M M B B B M B B B B B B B B B B B M B M M B B
##  [71] B B B B B B B B B B B B B B B B B B B B B B B M M M M M M B
## attr(,"prob")
##   [1] 0.7619047619 1.0000000000 0.8571428571 1.0000000000 0.9523809524
##   [6] 0.9523809524 1.0000000000 0.8571428571 0.9523809524 1.0000000000
##  [11] 0.7619047619 1.0000000000 0.9047619048 0.9523809524 1.0000000000
##  [16] 0.7142857143 0.8571428571 0.9047619048 1.0000000000 1.0000000000
##  [21] 0.6190476190 0.9047619048 0.8571428571 1.0000000000 1.0000000000
##  [26] 1.0000000000 0.8095238095 0.6190476190 1.0000000000 1.0000000000
##  [31] 1.0000000000 0.9523809524 0.9523809524 0.9523809524 1.0000000000
##  [36] 0.6666666667 0.7142857143 1.0000000000 1.0000000000 0.9523809524
##  [41] 1.0000000000 1.0000000000 1.0000000000 0.9523809524 1.0000000000
##  [46] 0.6666666667 1.0000000000 1.0000000000 1.0000000000 0.8571428571
##  [51] 0.9523809524 1.0000000000 1.0000000000 1.0000000000 0.8571428571
##  [56] 1.0000000000 1.0000000000 0.6190476190 1.0000000000 0.8571428571
##  [61] 1.0000000000 0.9523809524 0.9047619048 1.0000000000 1.0000000000
##  [66] 1.0000000000 1.0000000000 0.5238095238 0.6666666667 1.0000000000
##  [71] 0.9523809524 1.0000000000 0.5714285714 0.6190476190 0.8571428571
##  [76] 0.9523809524 0.8571428571 1.0000000000 1.0000000000 1.0000000000
##  [81] 1.0000000000 1.0000000000 1.0000000000 0.8095238095 1.0000000000
##  [86] 0.8571428571 0.9047619048 1.0000000000 1.0000000000 0.9523809524
##  [91] 0.8095238095 0.7619047619 1.0000000000 1.0000000000 1.0000000000
##  [96] 1.0000000000 1.0000000000 0.7619047619 1.0000000000 1.0000000000
## Levels: B M
# length(wKnn)

Evaluar el modelo

Simple tabla con table()

table( Predicción = wPredict, Observación = wTestLabel )
##           Observación
## Predicción  B  M
##          B 77  2
##          M  0 21

Con la función CrossTable()

Calcula una tabla similar a la anterior pero más completa. Aporta proporciones de aciertos por filas, columnas y totales.

CrossTable( x = wPredict, y = wTestLabel, dnn = c( "Predicción", "Observación" ),
            prop.chisq = FALSE )
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  100 
## 
##  
##              | Observación 
##   Predicción |         B |         M | Row Total | 
## -------------|-----------|-----------|-----------|
##            B |        77 |         2 |        79 | 
##              |     0.975 |     0.025 |     0.790 | 
##              |     1.000 |     0.087 |           | 
##              |     0.770 |     0.020 |           | 
## -------------|-----------|-----------|-----------|
##            M |         0 |        21 |        21 | 
##              |     0.000 |     1.000 |     0.210 | 
##              |     0.000 |     0.913 |           | 
##              |     0.000 |     0.210 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |        77 |        23 |       100 | 
##              |     0.770 |     0.230 |           | 
## -------------|-----------|-----------|-----------|
## 
## 

Validación cruzada (cross-validation)

La función knn.cv() entrena al clasificador, hace el test los mismos datos y realiza una validación cruzada al vuelo

knncv <- knn.cv( train = wTest, cl = wTestLabel, k = 21, prob = TRUE )
knncv
##   [1] B B B B B B B B B B M B B B B B B B M B B B B M B B B B B M M B B B M
##  [36] B B B B B M B B B B B B M M B B B M B B B B B B B B B B B M B M B B B
##  [71] B B B B B B B B B B B B B B B B B B B B B B B M M M M B M B
## attr(,"prob")
##   [1] 0.8095238095 1.0000000000 1.0000000000 0.9523809524 1.0000000000
##   [6] 1.0000000000 1.0000000000 0.9047619048 0.9523809524 1.0000000000
##  [11] 0.6190476190 0.9523809524 0.9523809524 1.0000000000 0.9523809524
##  [16] 0.9523809524 0.6666666667 0.9523809524 0.8571428571 1.0000000000
##  [21] 0.9523809524 0.9523809524 0.9523809524 0.6190476190 1.0000000000
##  [26] 0.9523809524 0.9047619048 0.9523809524 0.9523809524 0.6666666667
##  [31] 0.8571428571 0.9523809524 0.6666666667 1.0000000000 0.7619047619
##  [36] 0.8571428571 0.8095238095 1.0000000000 1.0000000000 0.9523809524
##  [41] 0.5714285714 1.0000000000 0.9523809524 0.6666666667 0.9523809524
##  [46] 0.9523809524 1.0000000000 0.5714285714 0.6190476190 1.0000000000
##  [51] 1.0000000000 0.9523809524 0.9047619048 1.0000000000 0.9523809524
##  [56] 1.0000000000 1.0000000000 1.0000000000 1.0000000000 0.9047619048
##  [61] 1.0000000000 0.9523809524 1.0000000000 0.9523809524 0.7619047619
##  [66] 1.0000000000 0.8095238095 0.8571428571 0.8095238095 1.0000000000
##  [71] 0.9523809524 1.0000000000 0.7142857143 0.8571428571 0.9523809524
##  [76] 0.9523809524 0.9523809524 1.0000000000 1.0000000000 1.0000000000
##  [81] 1.0000000000 1.0000000000 1.0000000000 0.9523809524 1.0000000000
##  [86] 0.8571428571 0.9523809524 1.0000000000 1.0000000000 0.8571428571
##  [91] 0.9047619048 0.8571428571 1.0000000000 0.7142857143 0.9047619048
##  [96] 0.8095238095 0.6190476190 0.7142857143 0.9047619048 1.0000000000
## Levels: B M
table( Predicción = knncv, Observación =  wTestLabel)
##           Observación
## Predicción  B  M
##          B 77  6
##          M  0 17

Con el paquete caret

confusionMatrix( knncv, wTestLabel, positive = "M", dnn = "" )
## Confusion Matrix and Statistics
## 
##    NA
##      B  M
##   B 77  6
##   M  0 17
##                                                 
##                Accuracy : 0.94                  
##                  95% CI : (0.8739701, 0.9776651)
##     No Information Rate : 0.77                  
##     P-Value [Acc > NIR] : 0.000004732313        
##                                                 
##                   Kappa : 0.8135488             
##  Mcnemar's Test P-Value : 0.04122683            
##                                                 
##             Sensitivity : 0.7391304             
##             Specificity : 1.0000000             
##          Pos Pred Value : 1.0000000             
##          Neg Pred Value : 0.9277108             
##              Prevalence : 0.2300000             
##          Detection Rate : 0.1700000             
##    Detection Prevalence : 0.1700000             
##       Balanced Accuracy : 0.8695652             
##                                                 
##        'Positive' Class : M                     
## 

Curvas ROC (Receiver Operating Characteristic)

Es una representación gráfica de la \(sensibilidad\) frente a \(1 - especificidad\) para un clasificador binario, es decir sólo hay dos respuestas, positivo y negativo.

prd <- ifelse( wPredict == "M", 1, 0 )
real <- ifelse( wTestLabel == "M", 1, 0 )
predKnn <- ROCR::prediction( prd, real )
perf <- performance( predKnn, measure = "tpr", x.measure = "fpr" )
plot( perf, avg = "threshold", colorize = T )
abline( a =0, b = 1)

# área bajo la curva
AUC <- performance( predKnn, measure = "auc" )
AUCtumor <- AUC@y.values
paste( "Área bajo la curva: ", round( AUCtumor[[ 1 ]], 4 ) )
## [1] "Área bajo la curva:  0.9565"

Variar parámetro k (número de vecinos)

knnPerf <- function (cost = 1){
  wPredict <- knn( wTrain, wTest, cl = wTrainLabel, k = cost, prob = TRUE )
  prd <- ifelse( wPredict == "M", 1, 0 )
  real <- ifelse( wTestLabel == "M", 1, 0 )
  predKnn <- ROCR::prediction( prd, real )
  perf <- performance( predKnn, measure = "tpr", x.measure = "fpr" )
  data.frame( fpr = perf@x.values[[ 1 ]][ 2 ], 
              tpr = perf@y.values[[ 1 ]][ 2 ],
              threshold = perf@alpha.values[[ 1 ]], 
              k = cost) }

df <- data.frame ()
for (cost in 10:200){
  df <- rbind ( df, knnPerf( cost ) ) }

df2 <- df[with( df, order( fpr, tpr ) ),]
df3 <- rbind( c( 0, 0, 0, 0 ), df2, c( 1, 1, 0, 0 ) )
plot ( df3$fpr, df3$tpr, type = "l", xlab = "1 - Especificidad", ylab = "Sensibilidad" )
points( df3$fpr, df3$tpr, pch = "* ")
abline( a = 0, b = 1, col = "red" )

Alternativa al cálculo de parámetros de la curva ROC

dfAlt <- data.frame()
for ( cost in 10:300 ){
  wPredict<- knn( wTrain, wTest, cl = wTrainLabel, k = cost, prob = TRUE )
  aux <- t( as.data.frame( ( confusionMatrix( wPredict, wTestLabel,
                                              positive = "M", dnn = "" ) )$byClass[ 1:2 ] ) ) 
  rownames( aux ) <- NULL
  dfAlt <- rbind( dfAlt, aux )
}

dfAlt$Specificity <- 1 - dfAlt$Specificity
dfAlt2 <- dfAlt[ with( dfAlt, order( Specificity, Sensitivity ) ), ]
dfAlt3 <- rbind( c( 0, 0), dfAlt2, c( 1, 1) )
plot ( dfAlt3$Specificity, dfAlt3$Sensitivity, type = "l", 
       xlab = "1 - Especificidad", ylab = "Sensibilidad" )
points( dfAlt3$Specificity, dfAlt3$Sensitivity, pch = "* ")
abline( a = 0, b = 1 , col = "red" )