Teoría

El paquete caret (Clasification And REgression Training) es un paquete integral con una amplia variedad de algoritmos para el aprendizaje automático.

Librerias

library(ggplot2)
library(lattice)
library(caret)
library(datasets)
library(DataExplorer)
library(kernlab)
## Warning: package 'kernlab' was built under R version 4.3.3
## 
## Attaching package: 'kernlab'
## The following object is masked from 'package:ggplot2':
## 
##     alpha
library(randomForest)
## randomForest 4.7-1.1
## Type rfNews() to see new features/changes/bug fixes.
## 
## Attaching package: 'randomForest'
## The following object is masked from 'package:ggplot2':
## 
##     margin

Crear Base de datos

df <- data.frame(iris)

Analisis exploratorio

summary(df)
##   Sepal.Length    Sepal.Width     Petal.Length    Petal.Width   
##  Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100  
##  1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300  
##  Median :5.800   Median :3.000   Median :4.350   Median :1.300  
##  Mean   :5.843   Mean   :3.057   Mean   :3.758   Mean   :1.199  
##  3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100   3rd Qu.:1.800  
##  Max.   :7.900   Max.   :4.400   Max.   :6.900   Max.   :2.500  
##        Species  
##  setosa    :50  
##  versicolor:50  
##  virginica :50  
##                 
##                 
## 
str(df)
## 'data.frame':    150 obs. of  5 variables:
##  $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
##  $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
##  $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
##  $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
##  $ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
#plot_missing(df)

** NOTA: Variable que queremos predecir debe de tener formato de FACTOR **

Partir datos en 80/20

set.seed (123)
renglones_entrenamiento <- createDataPartition(df$Species, p=0.8, list=FALSE)
entrenamiento <- iris[renglones_entrenamiento, ]
prueba <- iris[-renglones_entrenamiento, ]

Métodos para Modelar

Los métodos más utilizados para modelar aprendizaje automático son: SVM: Support Vector Machine o Máquina de Vectores de Soporte. Hay varios subtipos: Lineal (symLinear), Radial (svmRadial), Polinómico (symPoly), etc. * Árbol de Decisión: rpart * Redes Neuronales: nnet * Random Forest o Bosques Aleatorios: rf

Modelo con el metodo svmLinear

modelo1 <- train(Species ~ ., data=entrenamiento,
                 method = "svmLinear", #Cambiar
                 preProcess = c("scale", "center"),
                 trControl = trainControl (method ="cv", number =10),
                 tuneGrid = data.frame(C=1) #Cambiar
                 )

resultado_entrenamiento1 <- predict(modelo1, entrenamiento)
resultado_prueba1 <- predict(modelo1, prueba)

# Matriz de Confusión del Resultado del Entrenamiento
mcre <- confusionMatrix(resultado_entrenamiento1, entrenamiento$Species)

# Matriz de Confusión del Resultado de la Prueba
mcrp <- confusionMatrix(resultado_prueba1, prueba$Species)

Modelo con el metodo svmRadial

modelo2<- train(Species ~ ., data=entrenamiento,
                method = "svmRadial", #Cambiar
                preProcess=c("scale","center"),
                trControl = trainControl(method="cv", number=10),
                tuneGrid = data.frame(sigma=1,C=1) #Cambiar
                )
resultado_entrenamiento2 <- predict(modelo2,entrenamiento)
resultado_prueba2 <- predict(modelo2,prueba)

# Matriz de Confusión del Resultado de Entrenamiento
mcre2 <- confusionMatrix(resultado_entrenamiento2, entrenamiento$Species)

# Matriz de Confusión del Resultado de Prueba
mcrp2 <- confusionMatrix(resultado_prueba2, prueba$Species)

Modelo con método svmPoly

modelo3<- train(Species ~ ., data=entrenamiento,
                method = "svmPoly", #Cambiar
                preProcess=c("scale","center"),
                trControl = trainControl(method="cv", number=10),
                tuneGrid = data.frame(degree=1, scale=1, C=1) #Cambiar
                )
resultado_entrenamiento3 <- predict(modelo3,entrenamiento)
resultado_prueba3 <- predict(modelo3,prueba)

# Matriz de Confusión del Resultado de Entrenamiento
mcre3 <- confusionMatrix(resultado_entrenamiento3, entrenamiento$Species)

# Matriz de Confusión del Resultado de Prueba
mcrp3 <- confusionMatrix(resultado_prueba3, prueba$Species)

Modelo con método Ramdom Forest

# Construir el modelo Random Forest
modelo4 <- randomForest(Species ~ ., data = entrenamiento)


resultado_entrenamiento <- predict(modelo4,entrenamiento)
resultado_prueba <- predict(modelo4,prueba)

# Matriz de Confusión
mcre <- confusionMatrix(resultado_entrenamiento, entrenamiento$Species) # matriz de confusión del resultado del entrenamiento
mcre
## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   setosa versicolor virginica
##   setosa         40          0         0
##   versicolor      0         40         0
##   virginica       0          0        40
## 
## Overall Statistics
##                                      
##                Accuracy : 1          
##                  95% CI : (0.9697, 1)
##     No Information Rate : 0.3333     
##     P-Value [Acc > NIR] : < 2.2e-16  
##                                      
##                   Kappa : 1          
##                                      
##  Mcnemar's Test P-Value : NA         
## 
## Statistics by Class:
## 
##                      Class: setosa Class: versicolor Class: virginica
## Sensitivity                 1.0000            1.0000           1.0000
## Specificity                 1.0000            1.0000           1.0000
## Pos Pred Value              1.0000            1.0000           1.0000
## Neg Pred Value              1.0000            1.0000           1.0000
## Prevalence                  0.3333            0.3333           0.3333
## Detection Rate              0.3333            0.3333           0.3333
## Detection Prevalence        0.3333            0.3333           0.3333
## Balanced Accuracy           1.0000            1.0000           1.0000
mcrp <- confusionMatrix(resultado_prueba,prueba$Species) # matriz de confusión del resultado de la prueba
mcrp
## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   setosa versicolor virginica
##   setosa         10          0         0
##   versicolor      0         10         2
##   virginica       0          0         8
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9333          
##                  95% CI : (0.7793, 0.9918)
##     No Information Rate : 0.3333          
##     P-Value [Acc > NIR] : 8.747e-12       
##                                           
##                   Kappa : 0.9             
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: setosa Class: versicolor Class: virginica
## Sensitivity                 1.0000            1.0000           0.8000
## Specificity                 1.0000            0.9000           1.0000
## Pos Pred Value              1.0000            0.8333           1.0000
## Neg Pred Value              1.0000            1.0000           0.9091
## Prevalence                  0.3333            0.3333           0.3333
## Detection Rate              0.3333            0.3333           0.2667
## Detection Prevalence        0.3333            0.4000           0.2667
## Balanced Accuracy           1.0000            0.9500           0.9000

Conclusiones

El modelo con el método de bosques aleatorios (rf) es el que presenta sobreajustes ya que tiene una alta precisión en entrenamiento, pero una baja en prueba.

Acorde al resumen de resultados el mejor modelo evaluado es el de máquina de vectores de soporte linear (svmLinear)

LS0tCnRpdGxlOiAiQ0FSRVQgSXJpcyIKYXV0aG9yOiAiTHVpcyBBbmdlbCBEaWF6IgpkYXRlOiAiMjAyNC0wOC0xOSIKb3V0cHV0OiAKICBodG1sX2RvY3VtZW50OgogICAgdG9jOiBUUlVFCiAgICB0b2NfZmxvYXQ6IFRSVUUKICAgIGNvZGVfZG93bmxvYWQ6IFRSVUUKICAgIHRoZW1lOiAiY2VydWxlYW4iCiAgICBoaWdobGlnaHQ6ICJweWdtZW50cyIKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGVjaG8gPSBUUlVFKQpgYGAKCiFbXSgvVXNlcnMvbHVpc2FuZ2VsL0xpYnJhcnkvQ2xvdWRTdG9yYWdlL09uZURyaXZlLUluc3RpdHV0b1RlY25vbG9naWNveWRlRXN0dWRpb3NTdXBlcmlvcmVzZGVNb250ZXJyZXkvN3RoIFNlYXNvbi9NMi9pcmlzLmpwZykKCiMgPHNwYW4gc3R5bGUgPSAiY29sb3I6IHZpb2xldDsgIj5UZW9yw61hPC9zcGFuPgpFbCBwYXF1ZXRlICpjYXJldCAoQ2xhc2lmaWNhdGlvbiBBbmQgUkVncmVzc2lvbiBUcmFpbmluZykqIGVzIHVuIHBhcXVldGUgaW50ZWdyYWwgY29uIHVuYSBhbXBsaWEgdmFyaWVkYWQgZGUgYWxnb3JpdG1vcyBwYXJhIGVsIGFwcmVuZGl6YWplIGF1dG9tw6F0aWNvLgoKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiB2aW9sZXQ7Ij5MaWJyZXJpYXM8L3NwYW4+CgpgYGB7cn0KbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KGxhdHRpY2UpCmxpYnJhcnkoY2FyZXQpCmxpYnJhcnkoZGF0YXNldHMpCmxpYnJhcnkoRGF0YUV4cGxvcmVyKQpsaWJyYXJ5KGtlcm5sYWIpCmxpYnJhcnkocmFuZG9tRm9yZXN0KQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiB2aW9sZXQ7Ij5DcmVhciBCYXNlIGRlIGRhdG9zPC9zcGFuPgpgYGB7cn0KZGYgPC0gZGF0YS5mcmFtZShpcmlzKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiB2aW9sZXQ7Ij5BbmFsaXNpcyBleHBsb3JhdG9yaW88L3NwYW4+CmBgYHtyfQpzdW1tYXJ5KGRmKQpzdHIoZGYpCiNwbG90X21pc3NpbmcoZGYpCmBgYAoqKiBOT1RBOiBWYXJpYWJsZSBxdWUgcXVlcmVtb3MgcHJlZGVjaXIgZGViZSBkZSB0ZW5lciBmb3JtYXRvIGRlIEZBQ1RPUiAqKgoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IHZpb2xldDsiPlBhcnRpciBkYXRvcyBlbiA4MC8yMDwvc3Bhbj4KYGBge3J9CnNldC5zZWVkICgxMjMpCnJlbmdsb25lc19lbnRyZW5hbWllbnRvIDwtIGNyZWF0ZURhdGFQYXJ0aXRpb24oZGYkU3BlY2llcywgcD0wLjgsIGxpc3Q9RkFMU0UpCmVudHJlbmFtaWVudG8gPC0gaXJpc1tyZW5nbG9uZXNfZW50cmVuYW1pZW50bywgXQpwcnVlYmEgPC0gaXJpc1stcmVuZ2xvbmVzX2VudHJlbmFtaWVudG8sIF0KYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogdmlvbGV0OyI+TcOpdG9kb3MgcGFyYSBNb2RlbGFyPC9zcGFuPgoKTG9zIG3DqXRvZG9zIG3DoXMgdXRpbGl6YWRvcyBwYXJhIG1vZGVsYXIgYXByZW5kaXphamUgYXV0b23DoXRpY28gc29uOgoqKlNWTSoqOgoqU3VwcG9ydCBWZWN0b3IgTWFjaGluZSogbyBNw6FxdWluYSBkZSBWZWN0b3JlcyBkZSBTb3BvcnRlLiBIYXkgdmFyaW9zIHN1YnRpcG9zOgpMaW5lYWwgKHN5bUxpbmVhciksIFJhZGlhbCAoc3ZtUmFkaWFsKSwgUG9saW7Ds21pY28gKHN5bVBvbHkpLCBldGMuCiogKirDgXJib2wgZGUgRGVjaXNpw7NuKio6IHJwYXJ0CiogKipSZWRlcyBOZXVyb25hbGVzKio6IG5uZXQKKiAqKlJhbmRvbSBGb3Jlc3QqKiBvIEJvc3F1ZXMgQWxlYXRvcmlvczogcmYKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiB2aW9sZXQ7Ij5Nb2RlbG8gY29uIGVsIG1ldG9kbyBzdm1MaW5lYXI8L3NwYW4+CmBgYHtyfQptb2RlbG8xIDwtIHRyYWluKFNwZWNpZXMgfiAuLCBkYXRhPWVudHJlbmFtaWVudG8sCiAgICAgICAgICAgICAgICAgbWV0aG9kID0gInN2bUxpbmVhciIsICNDYW1iaWFyCiAgICAgICAgICAgICAgICAgcHJlUHJvY2VzcyA9IGMoInNjYWxlIiwgImNlbnRlciIpLAogICAgICAgICAgICAgICAgIHRyQ29udHJvbCA9IHRyYWluQ29udHJvbCAobWV0aG9kID0iY3YiLCBudW1iZXIgPTEwKSwKICAgICAgICAgICAgICAgICB0dW5lR3JpZCA9IGRhdGEuZnJhbWUoQz0xKSAjQ2FtYmlhcgogICAgICAgICAgICAgICAgICkKCnJlc3VsdGFkb19lbnRyZW5hbWllbnRvMSA8LSBwcmVkaWN0KG1vZGVsbzEsIGVudHJlbmFtaWVudG8pCnJlc3VsdGFkb19wcnVlYmExIDwtIHByZWRpY3QobW9kZWxvMSwgcHJ1ZWJhKQoKIyBNYXRyaXogZGUgQ29uZnVzacOzbiBkZWwgUmVzdWx0YWRvIGRlbCBFbnRyZW5hbWllbnRvCm1jcmUgPC0gY29uZnVzaW9uTWF0cml4KHJlc3VsdGFkb19lbnRyZW5hbWllbnRvMSwgZW50cmVuYW1pZW50byRTcGVjaWVzKQoKIyBNYXRyaXogZGUgQ29uZnVzacOzbiBkZWwgUmVzdWx0YWRvIGRlIGxhIFBydWViYQptY3JwIDwtIGNvbmZ1c2lvbk1hdHJpeChyZXN1bHRhZG9fcHJ1ZWJhMSwgcHJ1ZWJhJFNwZWNpZXMpCmBgYAoKIyA8c3BhbiBzdHlsZT0iY29sb3I6IHZpb2xldDsiPk1vZGVsbyBjb24gZWwgbWV0b2RvIHN2bVJhZGlhbDwvc3Bhbj4KYGBge3J9Cm1vZGVsbzI8LSB0cmFpbihTcGVjaWVzIH4gLiwgZGF0YT1lbnRyZW5hbWllbnRvLAogICAgICAgICAgICAgICAgbWV0aG9kID0gInN2bVJhZGlhbCIsICNDYW1iaWFyCiAgICAgICAgICAgICAgICBwcmVQcm9jZXNzPWMoInNjYWxlIiwiY2VudGVyIiksCiAgICAgICAgICAgICAgICB0ckNvbnRyb2wgPSB0cmFpbkNvbnRyb2wobWV0aG9kPSJjdiIsIG51bWJlcj0xMCksCiAgICAgICAgICAgICAgICB0dW5lR3JpZCA9IGRhdGEuZnJhbWUoc2lnbWE9MSxDPTEpICNDYW1iaWFyCiAgICAgICAgICAgICAgICApCnJlc3VsdGFkb19lbnRyZW5hbWllbnRvMiA8LSBwcmVkaWN0KG1vZGVsbzIsZW50cmVuYW1pZW50bykKcmVzdWx0YWRvX3BydWViYTIgPC0gcHJlZGljdChtb2RlbG8yLHBydWViYSkKCiMgTWF0cml6IGRlIENvbmZ1c2nDs24gZGVsIFJlc3VsdGFkbyBkZSBFbnRyZW5hbWllbnRvCm1jcmUyIDwtIGNvbmZ1c2lvbk1hdHJpeChyZXN1bHRhZG9fZW50cmVuYW1pZW50bzIsIGVudHJlbmFtaWVudG8kU3BlY2llcykKCiMgTWF0cml6IGRlIENvbmZ1c2nDs24gZGVsIFJlc3VsdGFkbyBkZSBQcnVlYmEKbWNycDIgPC0gY29uZnVzaW9uTWF0cml4KHJlc3VsdGFkb19wcnVlYmEyLCBwcnVlYmEkU3BlY2llcykKYGBgCgoKIyA8c3BhbiBzdHlsZSA9ICJjb2xvcjogdmlvbGV0OyAiPk1vZGVsbyBjb24gbcOpdG9kbyBzdm1Qb2x5PC9zcGFuPgpgYGB7cn0KbW9kZWxvMzwtIHRyYWluKFNwZWNpZXMgfiAuLCBkYXRhPWVudHJlbmFtaWVudG8sCiAgICAgICAgICAgICAgICBtZXRob2QgPSAic3ZtUG9seSIsICNDYW1iaWFyCiAgICAgICAgICAgICAgICBwcmVQcm9jZXNzPWMoInNjYWxlIiwiY2VudGVyIiksCiAgICAgICAgICAgICAgICB0ckNvbnRyb2wgPSB0cmFpbkNvbnRyb2wobWV0aG9kPSJjdiIsIG51bWJlcj0xMCksCiAgICAgICAgICAgICAgICB0dW5lR3JpZCA9IGRhdGEuZnJhbWUoZGVncmVlPTEsIHNjYWxlPTEsIEM9MSkgI0NhbWJpYXIKICAgICAgICAgICAgICAgICkKcmVzdWx0YWRvX2VudHJlbmFtaWVudG8zIDwtIHByZWRpY3QobW9kZWxvMyxlbnRyZW5hbWllbnRvKQpyZXN1bHRhZG9fcHJ1ZWJhMyA8LSBwcmVkaWN0KG1vZGVsbzMscHJ1ZWJhKQoKIyBNYXRyaXogZGUgQ29uZnVzacOzbiBkZWwgUmVzdWx0YWRvIGRlIEVudHJlbmFtaWVudG8KbWNyZTMgPC0gY29uZnVzaW9uTWF0cml4KHJlc3VsdGFkb19lbnRyZW5hbWllbnRvMywgZW50cmVuYW1pZW50byRTcGVjaWVzKQoKIyBNYXRyaXogZGUgQ29uZnVzacOzbiBkZWwgUmVzdWx0YWRvIGRlIFBydWViYQptY3JwMyA8LSBjb25mdXNpb25NYXRyaXgocmVzdWx0YWRvX3BydWViYTMsIHBydWViYSRTcGVjaWVzKQpgYGAKCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiB2aW9sZXQ7Ij5Nb2RlbG8gY29uIG3DqXRvZG8gUmFtZG9tIEZvcmVzdDwvc3Bhbj4KYGBge3J9CiMgQ29uc3RydWlyIGVsIG1vZGVsbyBSYW5kb20gRm9yZXN0Cm1vZGVsbzQgPC0gcmFuZG9tRm9yZXN0KFNwZWNpZXMgfiAuLCBkYXRhID0gZW50cmVuYW1pZW50bykKCgpyZXN1bHRhZG9fZW50cmVuYW1pZW50byA8LSBwcmVkaWN0KG1vZGVsbzQsZW50cmVuYW1pZW50bykKcmVzdWx0YWRvX3BydWViYSA8LSBwcmVkaWN0KG1vZGVsbzQscHJ1ZWJhKQoKIyBNYXRyaXogZGUgQ29uZnVzacOzbgptY3JlIDwtIGNvbmZ1c2lvbk1hdHJpeChyZXN1bHRhZG9fZW50cmVuYW1pZW50bywgZW50cmVuYW1pZW50byRTcGVjaWVzKSAjIG1hdHJpeiBkZSBjb25mdXNpw7NuIGRlbCByZXN1bHRhZG8gZGVsIGVudHJlbmFtaWVudG8KbWNyZQptY3JwIDwtIGNvbmZ1c2lvbk1hdHJpeChyZXN1bHRhZG9fcHJ1ZWJhLHBydWViYSRTcGVjaWVzKSAjIG1hdHJpeiBkZSBjb25mdXNpw7NuIGRlbCByZXN1bHRhZG8gZGUgbGEgcHJ1ZWJhCm1jcnAKYGBgCgojIDxzcGFuIHN0eWxlPSJjb2xvcjogdmlvbGV0OyI+Q29uY2x1c2lvbmVzPC9zcGFuPgoKRWwgbW9kZWxvIGNvbiBlbCBtw6l0b2RvIGRlIGJvc3F1ZXMgYWxlYXRvcmlvcyAqKHJmKSogZXMgZWwgcXVlIHByZXNlbnRhIHNvYnJlYWp1c3RlcyB5YSBxdWUgdGllbmUgdW5hIGFsdGEgcHJlY2lzacOzbiBlbiBlbnRyZW5hbWllbnRvLCBwZXJvIHVuYSBiYWphIGVuIHBydWViYS4KCkFjb3JkZSBhbCByZXN1bWVuIGRlIHJlc3VsdGFkb3MgZWwgbWVqb3IgbW9kZWxvIGV2YWx1YWRvIGVzIGVsIGRlIG3DoXF1aW5hIGRlIHZlY3RvcmVzIGRlIHNvcG9ydGUgbGluZWFyICooc3ZtTGluZWFyKSoKCg==