La base de datos fue reunida de diversas fuentes por Alberto Barradas (https://www.kaggle.com/abcsds), la cual incluye 721 pokemon con algunas de sus estadísticas básicas:
> pokemon <- as.data.frame(read.csv('Pokemon.csv', header=T))
> str(pokemon)
'data.frame': 800 obs. of 13 variables:
$ X. : int 1 2 3 3 4 5 6 6 6 7 ...
$ Name : Factor w/ 800 levels "Abomasnow","AbomasnowMega Abomasnow",..: 81 330 746 747 103 104 100 101 102 666 ...
$ Type.1 : Factor w/ 18 levels "Bug","Dark","Dragon",..: 10 10 10 10 7 7 7 7 7 18 ...
$ Type.2 : Factor w/ 19 levels "","Bug","Dark",..: 15 15 15 15 1 1 9 4 9 1 ...
$ Total : int 318 405 525 625 309 405 534 634 634 314 ...
$ HP : int 45 60 80 80 39 58 78 78 78 44 ...
$ Attack : int 49 62 82 100 52 64 84 130 104 48 ...
$ Defense : int 49 63 83 123 43 58 78 111 78 65 ...
$ Sp..Atk : int 65 80 100 122 60 80 109 130 159 50 ...
$ Sp..Def : int 65 80 100 120 50 65 85 85 115 64 ...
$ Speed : int 45 60 80 80 65 80 100 100 100 43 ...
$ Generation: Ord.factor w/ 6 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
$ Legendary : Factor w/ 2 levels "False","True": 1 1 1 1 1 1 1 1 1 1 ...
- X.: ID para cada pokemon
- Name: Nombre de cada pokemon
- Type.1: Cada pokemon tiene un tipo, el cual determina vulnerabilidades o fortalezas a los ataques.
- Type.2; Algunos pokemones son tipo dual y tienen un segundo "tipo".
- Total: Suma de las estadísticas que se listan a continuación, da una idea general sobre que tan fuerte es el pokemon.
- HP: Hit points, o salud, define que tanto daño puede soportar un pokemon después de pelear
- Attack: Modificador de base para ataques normales.
- Defense: Resistencia al daño base contra ataques normales.
- SP Atk: Ataques especiales, el modificador de base para ataques especiales como rafaga de fuego, etc.
- SP Def: Resistencia al daño base contra ataques especiales.
- Speed: Determina que pokemon ataca primero cada ronda.
- Generation: La generación a la que pertenece el pokemon.
- Legendary: Variable booleana que indica TRUE cuando el pokemon es catalogado como legendario.
Promedio "Total" por tipo (1) de pokemon y generación
pkmn <- melt(with(pokemon, tapply(Total, list(Generation,Type.1), mean)))
pkmn <- pkmn[,c(2,1,3)]
ina <- which(is.na(pkmn$value))
pkmn <- pkmn[-ina,]
colnames(pkmn) <- c('Type','Generation','Total')
freq <- count(pokemon, c('Type.1','Generation'))
pkmn$Freq <- freq[,3]
rownames(pkmn) <- seq(1,nrow(pkmn))
pkmn
p <- ggplot(pkmn) +
geom_point(aes(x = as.character(Type),
y = as.character(Generation),
size = Freq,
color = Total)) +
scale_x_discrete(name = 'Type') +
scale_y_discrete(name = 'Generation') +
scale_colour_gradient(name='Avg Total', low='yellow', high='red3') +
theme_bw() +
theme(axis.text.x=element_text(angle = 90, hjust = 0, vjust = 0.5)) +
ggtitle('Pokemons by Generation, type \n and Total Score')
p
Los pokemon tipo "Dragón" tienen en promedio los mejores puntajes, por otro lado los pokemones tipo "Agua" son los más abundantes.
Tipos de pokemon y puntaje "Total"
pkmn.1 <- melt(with(pokemon, tapply(Total, Type.1, mean )))
colnames(pkmn.1) <- c('Type.1','Total')
pkmn.1$freq <- melt(table(pokemon$Type.1))[,2]
mypalette <- rev(rainbow(20))
treemap(pkmn.1, index=c('Type.1'), vSize='freq', vColor='Total',
palette= mypalette,type='value', title.legend='Avg Total',
title='Pokemons by type and Total')
Clasificando pokemones legendarios
Convertimos la variable "Generation" a escala ordinal
pokemon$Generation <- as.ordered(pokemon$Generation)
Dividimos la base de datos original, en una muestra de entrenamiento con el 60% de los datos y el resto será la muestra de evaluación del modelo:
set.seed(1111)
id.train <- sample(seq(1,nrow(pokemon)), round(nrow(pokemon)*0.6))
train <- pokemon[id.train,] # Muestra entrenamiento
test <- pokemon[-id.train,] # Muestra evaluación
El modelo sólo considerará las variables numéricas y la variable ordinal que definimos previamente.
> form <- as.formula(paste('Legendary', paste(names(train[c(5:12)]),
+ collapse=' + '), sep=' ~ '))
> form
Legendary ~ Total + HP + Attack + Defense + Sp..Atk + Sp..Def +
Speed + Generation
Regresión logística
> log <- glm(form, data=train, family = binomial())
> summary(log)
Call:
glm(formula = form, family = binomial(), data = train)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.41554 -0.14484 -0.03142 -0.00470 2.42037
Coefficients: (1 not defined because of singularities)
Estimate Std. Error z value Pr(>|z|)
(Intercept) -22.619056 3.338589 -6.775 1.24e-11 ***
Total 0.047109 0.011872 3.968 7.25e-05 ***
HP -0.021168 0.015201 -1.393 0.1638
Attack -0.026050 0.015030 -1.733 0.0831 .
Defense -0.008286 0.011818 -0.701 0.4832
Sp..Atk -0.005889 0.014302 -0.412 0.6805
Sp..Def -0.002507 0.013974 -0.179 0.8576
Speed NA NA NA NA
Generation.L 1.660818 0.768322 2.162 0.0306 *
Generation.Q -0.438145 0.718330 -0.610 0.5419
Generation.C 0.113477 0.711620 0.159 0.8733
Generation^4 -0.715514 0.640430 -1.117 0.2639
Generation^5 -0.565000 0.570013 -0.991 0.3216
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 284.85 on 479 degrees of freedom
Residual deviance: 112.57 on 468 degrees of freedom
AIC: 136.57
Number of Fisher Scoring iterations: 8
La fortaleza general del pokemon es el mejor predictor de los pokemones legendarios, seguido del ataque, y en menor medida la resistencia al daño. De igual forma, la primera generación de pokemones, se distingue significativamente de la 6a generación en cuanto a la cantidad de legendarios.
> cm.l <- table(train$Legendary, ifelse(fitted(log)>0.5,1,0));cm.l
0 1
False 430 8
True 17 25
> cr.l <- sum(diag(cm.l)/sum(cm.l));cr.l # Razón de exactitud
[1] 0.9479167
> rsq<- (1 - (log$deviance/log$null.deviance));rsq #Pseudo R cuadrada
[1] 0.6047947
La matriz de confusión sobre la muestra de entrenamiento, y la razón de "exactitud" indican que es un buen modelo, no así el valor de la pseudo-R cuadrada. En cuanto al pronóstico sobre la muestra de evaluación:
> cm.l <- table(test$Legendary, ifelse(test$score.l>0.5,1,0));cm.l
0 1
False 292 5
True 10 13
> cr.l <- sum(diag(cm.l)/sum(cm.l));cr.l
[1] 0.953125
> pred.l <- prediction(test$score.l,test$Legendary)
> perf.l <- performance(pred.l,"tpr","fpr")
> max(attr(perf.l,'y.values')[[1]]-attr(perf.l,'x.values')[[1]])
[1] 0.9360269
> auc.l <- paste('Logistic=',round(performance(pred.l,'auc')@y.values[[1]],3))
> auc.l
[1] "Logistic= 0.984"
De acuerdo con la matriz de confusión, la razón de "exactitud", el estadístico de Kolmogórov-Smirnov y el Área Bajo la Curva, se puede apreciar que es un buen modelo.
A pesar de lo bueno que resulta ser el modelo de clasificación de máxima entropia, o de regresión logística, en el siguiente gráfico se muestran los resultados del desempeño predictivo de otros dos modelos de clasificación: Splines de Regresión Adaptativa Multivariante (MARS por sus siglas en inglés) y AdaBoost con el algoritmo SAMME.
clr <- palette(rev(rainbow(3)));clr <- palette(rev(rainbow(3)))
plot(perf.l, col=clr[1], lty=6, lwd=2, # LOG
xlab='Tasa Falso Positivo',ylab='Tasa Verdadero Positivo')
plot(perf.m, add=T, col=clr[2],lty=5, lwd=2) # MARS
plot(perf.a, add=T, col=clr[3],lty=4, lwd=2) # ADABOOST
abline(a=0, b= 1)
legend(0.20,0.80,
c(auc.l,auc.m,auc.a),
col=clr, lwd=3, lty= c(6,5,4))
grid(col='gray85')
