En primer lugar cargamos la librería que contiene base de datos Cpus así como el resto de librerías que necesitaremos para resolver los ejercicios
library(tree)
library(MASS)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::select() masks MASS::select()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
Ahora vamos a revisar los nombres de la base de datos y las características principales.
names(cpus)## [1] "name" "syct" "mmin" "mmax" "cach" "chmin" "chmax"
## [8] "perf" "estperf"
summary(cpus)## name syct mmin mmax
## ADVISOR 32/60 : 1 Min. : 17.0 Min. : 64 Min. : 64
## AMDAHL 470/7A : 1 1st Qu.: 50.0 1st Qu.: 768 1st Qu.: 4000
## AMDAHL 470V/7 : 1 Median : 110.0 Median : 2000 Median : 8000
## AMDAHL 470V/7B: 1 Mean : 203.8 Mean : 2868 Mean :11796
## AMDAHL 470V/7C: 1 3rd Qu.: 225.0 3rd Qu.: 4000 3rd Qu.:16000
## AMDAHL 470V/8 : 1 Max. :1500.0 Max. :32000 Max. :64000
## (Other) :203
## cach chmin chmax perf
## Min. : 0.00 Min. : 0.000 Min. : 0.00 Min. : 6.0
## 1st Qu.: 0.00 1st Qu.: 1.000 1st Qu.: 5.00 1st Qu.: 27.0
## Median : 8.00 Median : 2.000 Median : 8.00 Median : 50.0
## Mean : 25.21 Mean : 4.699 Mean : 18.27 Mean : 105.6
## 3rd Qu.: 32.00 3rd Qu.: 6.000 3rd Qu.: 24.00 3rd Qu.: 113.0
## Max. :256.00 Max. :52.000 Max. :176.00 Max. :1150.0
##
## estperf
## Min. : 15.00
## 1st Qu.: 28.00
## Median : 45.00
## Mean : 99.33
## 3rd Qu.: 101.00
## Max. :1238.00
##
Como para el ejercico no necesitaremos todas las variables, adecuamos la base de datos eliminado las inncesarias
cpus2 <- cpus [ , -c(1, 9)]Las variables no tienen un rango de valores parecido. Por lo tanto, las normalizaremos. Para ello crearemos una función de normalización llamada min-max. Una vez aplicada la transformación todas las variables se encontraran entre 0 y 1
cpus_norm <- as.data.frame(apply(cpus2, 2, function(x)(x-min(x))/(max(x)-min(x))))
summary(cpus_norm)## syct mmin mmax cach
## Min. :0.00000 Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.02225 1st Qu.:0.02204 1st Qu.:0.06156 1st Qu.:0.00000
## Median :0.06271 Median :0.06062 Median :0.12412 Median :0.03125
## Mean :0.12598 Mean :0.08780 Mean :0.18350 Mean :0.09846
## 3rd Qu.:0.14026 3rd Qu.:0.12325 3rd Qu.:0.24925 3rd Qu.:0.12500
## Max. :1.00000 Max. :1.00000 Max. :1.00000 Max. :1.00000
## chmin chmax perf
## Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.01923 1st Qu.:0.02841 1st Qu.:0.01836
## Median :0.03846 Median :0.04545 Median :0.03846
## Mean :0.09036 Mean :0.10380 Mean :0.08708
## 3rd Qu.:0.11538 3rd Qu.:0.13636 3rd Qu.:0.09353
## Max. :1.00000 Max. :1.00000 Max. :1.00000
A continuación dividimos la base de datos en un conjunto de entrenamiento (2/3) y un conjunto de prueba (1/3)
set.seed(123)
training.samples <- cpus_norm$perf %>% createDataPartition(p = 0.66, list = FALSE)
train.data <- cpus_norm [training.samples, ]
test.data <- cpus_norm [-training.samples, ]Observamos la base de datos de train.data
summary(train.data)## syct mmin mmax cach
## Min. :0.00000 Min. :0.001002 Min. :0.007007 Min. :0.00000
## 1st Qu.:0.02225 1st Qu.:0.022044 1st Qu.:0.061562 1st Qu.:0.00000
## Median :0.07552 Median :0.060621 Median :0.124124 Median :0.03125
## Mean :0.14121 Mean :0.086415 Mean :0.178537 Mean :0.08923
## 3rd Qu.:0.19083 3rd Qu.:0.123246 3rd Qu.:0.249249 3rd Qu.:0.12500
## Max. :1.00000 Max. :1.000000 Max. :1.000000 Max. :0.62500
## chmin chmax perf
## Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.01923 1st Qu.:0.02699 1st Qu.:0.01836
## Median :0.01923 Median :0.04545 Median :0.03846
## Mean :0.08338 Mean :0.09387 Mean :0.08460
## 3rd Qu.:0.11538 3rd Qu.:0.13636 3rd Qu.:0.09419
## Max. :1.00000 Max. :1.00000 Max. :0.99476
Como venis observando, la variable perf es continua, por lo que la convertimos en binaria. Para ello usamos la instrucción ifelse() y tomamos como valore de corte la media (0.08460). Posteriormente eliminamos la variable perf y nos quedamos con la nueva variable binaria
train.data$perf <- as.numeric(train.data$perf)
High <- factor(ifelse(train.data$perf <= 0.08460, "No", "Yes"))
train.data <- data.frame(train.data, High)
summary(train.data)## syct mmin mmax cach
## Min. :0.00000 Min. :0.001002 Min. :0.007007 Min. :0.00000
## 1st Qu.:0.02225 1st Qu.:0.022044 1st Qu.:0.061562 1st Qu.:0.00000
## Median :0.07552 Median :0.060621 Median :0.124124 Median :0.03125
## Mean :0.14121 Mean :0.086415 Mean :0.178537 Mean :0.08923
## 3rd Qu.:0.19083 3rd Qu.:0.123246 3rd Qu.:0.249249 3rd Qu.:0.12500
## Max. :1.00000 Max. :1.000000 Max. :1.000000 Max. :0.62500
## chmin chmax perf High
## Min. :0.00000 Min. :0.00000 Min. :0.00000 No :100
## 1st Qu.:0.01923 1st Qu.:0.02699 1st Qu.:0.01836 Yes: 40
## Median :0.01923 Median :0.04545 Median :0.03846
## Mean :0.08338 Mean :0.09387 Mean :0.08460
## 3rd Qu.:0.11538 3rd Qu.:0.13636 3rd Qu.:0.09419
## Max. :1.00000 Max. :1.00000 Max. :0.99476
Preparamos la base de datos y el nombre de las variables
train.data <- train.data[,-7]
train.data$perf <- train.data$High
train.data <- train.data[,-7]
summary(train.data)## syct mmin mmax cach
## Min. :0.00000 Min. :0.001002 Min. :0.007007 Min. :0.00000
## 1st Qu.:0.02225 1st Qu.:0.022044 1st Qu.:0.061562 1st Qu.:0.00000
## Median :0.07552 Median :0.060621 Median :0.124124 Median :0.03125
## Mean :0.14121 Mean :0.086415 Mean :0.178537 Mean :0.08923
## 3rd Qu.:0.19083 3rd Qu.:0.123246 3rd Qu.:0.249249 3rd Qu.:0.12500
## Max. :1.00000 Max. :1.000000 Max. :1.000000 Max. :0.62500
## chmin chmax perf
## Min. :0.00000 Min. :0.00000 No :100
## 1st Qu.:0.01923 1st Qu.:0.02699 Yes: 40
## Median :0.01923 Median :0.04545
## Mean :0.08338 Mean :0.09387
## 3rd Qu.:0.11538 3rd Qu.:0.13636
## Max. :1.00000 Max. :1.00000
A continuación realizamos el ajuste del arbol de regresión con el conjutno de entrenamiento. Tal como podemos observar, a pesar de haber incluido todas las variables predictoras ( syct, mmin, mmax, cach, + chmin y + chmax), el modelo únicamente ha considerado mmax, cach”_ y chmin. Por otor lado, tal como observamos la tase de error es del 5.71% y se producen seis nodos.
tree.train <- tree(perf ~ . , data = train.data)
summary(tree.train)##
## Classification tree:
## tree(formula = perf ~ ., data = train.data)
## Variables actually used in tree construction:
## [1] "cach" "mmax" "chmax"
## Number of terminal nodes: 6
## Residual mean deviance: 0.263 = 35.25 / 134
## Misclassification error rate: 0.05714 = 8 / 140
Para poder observar el arbol procedemos a graficarlo. A modo de resumen, podemos observar que para obterner mayor perf es necesario un cach mayor de 0.105469, y un chmax superior a 0.0511364.
plot(tree.train)
text(tree.train)Para evaluar el rendimiento, en prier lugar realizamos el arbol con el conjunto de prueba, realizamos la misma conversión que hicimos anteriormente
test.data$perf <- as.numeric(test.data$perf)
High <- factor(ifelse(test.data$perf <= 0.08460, "No", "Yes"))
test.data <- data.frame(test.data, High)
test..data <- test.data[,-7]
summary(test.data)## syct mmin mmax cach
## Min. :0.00000 Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.02225 1st Qu.:0.02931 1st Qu.:0.06156 1st Qu.:0.00000
## Median :0.04922 Median :0.06062 Median :0.12412 Median :0.03125
## Mean :0.09506 Mean :0.09061 Mean :0.19356 Mean :0.11719
## 3rd Qu.:0.10654 3rd Qu.:0.09193 3rd Qu.:0.24925 3rd Qu.:0.12500
## Max. :1.00000 Max. :0.49900 Max. :1.00000 Max. :1.00000
## chmin chmax perf High
## Min. :0.00000 Min. :0.00000 Min. :0.001748 No :52
## 1st Qu.:0.01923 1st Qu.:0.03409 1st Qu.:0.018357 Yes:17
## Median :0.05769 Median :0.05682 Median :0.034965
## Mean :0.10452 Mean :0.12393 Mean :0.092113
## 3rd Qu.:0.13462 3rd Qu.:0.13636 3rd Qu.:0.082168
## Max. :1.00000 Max. :1.00000 Max. :1.000000
test.data$perf <- test.data$High
test.data <- test.data[,-8]
summary(test.data)## syct mmin mmax cach
## Min. :0.00000 Min. :0.00000 Min. :0.00000 Min. :0.00000
## 1st Qu.:0.02225 1st Qu.:0.02931 1st Qu.:0.06156 1st Qu.:0.00000
## Median :0.04922 Median :0.06062 Median :0.12412 Median :0.03125
## Mean :0.09506 Mean :0.09061 Mean :0.19356 Mean :0.11719
## 3rd Qu.:0.10654 3rd Qu.:0.09193 3rd Qu.:0.24925 3rd Qu.:0.12500
## Max. :1.00000 Max. :0.49900 Max. :1.00000 Max. :1.00000
## chmin chmax perf
## Min. :0.00000 Min. :0.00000 No :52
## 1st Qu.:0.01923 1st Qu.:0.03409 Yes:17
## Median :0.05769 Median :0.05682
## Mean :0.10452 Mean :0.12393
## 3rd Qu.:0.13462 3rd Qu.:0.13636
## Max. :1.00000 Max. :1.00000
Con la función predict predecimos la validez del modelo creado. Posteriormente comparamos en la tabla los datos obtenidos en la predicción con la base de datos de prueba. Tal como podemos observar, las predicciones han sido correctas para un 92.75% de los casos.
tree.pred <- predict(tree.train, test.data, type = "class")
table(tree.pred, test.data$perf)##
## tree.pred No Yes
## No 49 2
## Yes 3 15
print(paste("Porcentaje de predicciones correctas:",(49+15)/(49+15+3+2)*100))## [1] "Porcentaje de predicciones correctas: 92.7536231884058"
A continuación, examinamos si la poda del árbol puede mejorar los resultados. Para ello, usaremos la función cv.tree() realiza una validación cruzada para determinar el nivel óptimo de complejidad del árbol; la poda de complejidad de costes se utiliza para seleccionar una secuencia de árboles para su consideración. Como guía en el proceso de validación cruzada y de poda, considere la tasa de error de clasificación en lugar del valor por defecto de la función cv.tree(), que es la desviación. Para ello usaremos el argumento FUN = prune.misclass.
cv.cpus <- cv.tree(tree.train, FUN = prune.misclass)
names(cv.cpus)## [1] "size" "dev" "k" "method"
cv.cpus## $size
## [1] 6 3 2 1
##
## $dev
## [1] 13 13 13 40
##
## $k
## [1] -Inf 0 3 29
##
## $method
## [1] "misclass"
##
## attr(,"class")
## [1] "prune" "tree.sequence"
El parametro $dev corresponde al número de errores en la validación cruzada. En este caso, el arbol con 3 nodos resulta en 13 validaciones cruzadas
A continuación, realizamos el gráfico de la tasa de error tanot de size como de k
par(mfrow = c(1, 2))
plot(cv.cpus$size, cv.cpus$dev, type = "b")
plot(cv.cpus$k, cv.cpus$dev, type = "b")Ahora aplicamos la función prune.misclass() para podar el árbol y obtener el árbol de tres nodos. Como podemos observar, ahora únicamente interviene que cach sea mayor que 0.10469 y que chmax sea mayor que 0.0511364
prune.cpus <- prune.misclass(tree.train, best = 3)
plot(prune.cpus)
text(prune.cpus, pretty = 0)Para evaluar si el proceso ha mejorado la preddicción volvemos a usar la función predict
tree.pred2 <- predict(prune.cpus, test.data, type = "class")
table(tree.pred2, test.data$perf)##
## tree.pred2 No Yes
## No 49 2
## Yes 3 15
print(paste("Porcentaje de predicciones correctas:",(49+15)/(49+15+3+2)*100))## [1] "Porcentaje de predicciones correctas: 92.7536231884058"
En este caso podemos observa que la poda no ha mejorado el resultado
A nivel personal, me ha parecido una técnica interesante y poco usada en mi área de conocimiento. Estas semanas he estado practicado el uso de arboles de decisión en una investigación que se basaba en la elección del alumnado de los grados de maestro por realizar la mención de educación musical en función de una serie de competencias (nivel de conocimiento de las leyes educativas, facilidad para cantar delante de otras personas, etc.). Me ha sido relametne útil en esa investigación.