Análisis Pokemon

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')