Ejercicio 1

1.1. Construir un pipeline de clasificación con un modelo Keras MLP. Pueden comenzar con una versión simplicada que sólo tenga una capa de Input donde pasen los valores de one-hot-encodings.

Análisis Descriptivo

A continuación se realiza un pequeño análisis de las variables de la base de datos.

train %>%
  group_by(AdoptionSpeed) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2))
## # A tibble: 5 x 3
##   AdoptionSpeed  cant  porc
##           <dbl> <int> <dbl>
## 1             0   285  2.69
## 2             1  2177 20.6 
## 3             2  2846 26.9 
## 4             3  2310 21.8 
## 5             4  2964 28.0
ggplot(train, aes(AdoptionSpeed)) + 
  geom_histogram(binwidth=1, fill="#69b3a2", color="#e9ecef", alpha=0.9)

Tipo de mascota:

train %>%
  group_by(Type) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2))
## # A tibble: 2 x 3
##    Type  cant  porc
##   <dbl> <int> <dbl>
## 1     1  5770  54.5
## 2     2  4812  45.5

Raza Principal:

train %>%
  group_by(Breed1) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2)) %>%
  arrange(desc(cant))
## # A tibble: 164 x 3
##    Breed1  cant  porc
##     <dbl> <int> <dbl>
##  1    307  4228 40.0 
##  2    266  2579 24.4 
##  3    265   881  8.33
##  4    299   246  2.32
##  5    264   194  1.83
##  6    292   191  1.8 
##  7    141   151  1.43
##  8    285   146  1.38
##  9    205   130  1.23
## 10    179   115  1.09
## # ... with 154 more rows

La variable raza tiene 164 categorías. Las tres razas con mayor cantidad de casos agrupan el 72.65% del total; “Mixed Breed”, para tipo 1, “Domestic Short Hair” para tipo 2, “Domestic Medium Hair” para tipo 2.

La variable edad es la única continua que utilizaré en el modelo, la media es de 10.52 y la mediana de 3, se verifica un valor máximo de 255, lo que pareciera indicar un error en los datos.

summary(train$Age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00    2.00    3.00   10.52   12.00  255.00
t1 <- train %>%
  group_by(Gender, AdoptionSpeed) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2))

t1
## # A tibble: 15 x 4
## # Groups:   Gender [3]
##    Gender AdoptionSpeed  cant  porc
##     <dbl>         <dbl> <int> <dbl>
##  1      1             0   115  1.09
##  2      1             1   912  8.62
##  3      1             2  1144 10.8 
##  4      1             3   773  7.3 
##  5      1             4   964  9.11
##  6      2             0   140  1.32
##  7      2             1   940  8.88
##  8      2             2  1321 12.5 
##  9      2             3  1183 11.2 
## 10      2             4  1520 14.4 
## 11      3             0    30  0.28
## 12      3             1   325  3.07
## 13      3             2   381  3.6 
## 14      3             3   354  3.35
## 15      3             4   480  4.54

La variable Gender presenta 3 categorías, no se observa una relación directa con la velocidad de adopción.

ggplot(t1, aes(fill=as.factor(Gender), y=cant, x=AdoptionSpeed)) + 
    geom_bar(position="stack", stat="identity")

La varible Color1, presenta 7 categorías donde los colores “Black” y “Brown”, agrupan casi el 75% de los datos.

t2 <- train %>%
  group_by(Color1) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2))
t2
## # A tibble: 7 x 3
##   Color1  cant  porc
##    <dbl> <int> <dbl>
## 1      1  5267 49.8 
## 2      2  2630 24.8 
## 3      3   652  6.16
## 4      4   455  4.3 
## 5      5   626  5.92
## 6      6   492  4.65
## 7      7   460  4.35

Tamaño en edad madura.

train %>%
  group_by(MaturitySize) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2)) 
## # A tibble: 4 x 3
##   MaturitySize  cant  porc
##          <dbl> <int> <dbl>
## 1            1  2404 22.7 
## 2            2  7273 68.7 
## 3            3   882  8.33
## 4            4    23  0.22

Estado de salud

train %>%
  group_by(Health) %>%
  summarise(cant = n(),
            porc = round(cant/nrow(train)*100,2))
## # A tibble: 3 x 3
##   Health  cant  porc
##    <dbl> <int> <dbl>
## 1      1 10215 96.5 
## 2      2   346  3.27
## 3      3    21  0.2

Preparación de los datos

Se prepara un primer data frame con las variables que habían resultado de interés en el trabajo práctico anterior: Type, Gender, MaturitySize, Heath, Age. Se normaliza la variable Age por ser la única continua, luego se deben recodificar las variables categóricas dado que keras considera valores de 0 a n y se utiliza la función to_categorical para pasarlas al modelo.

Se separan los datos en train y evaluación, se considera el 70% para entrenamiento y el 30% para evaluación.

a <- as.integer(dim(x)[1]*0.7)

x_train <- x[1:a, ]
x_val <- x[ (a+1) : dim(x)[1], ]

y_train <- y[1:a]
y_val <- y[(a+1) : dim(x)[1]]

Definición del modelo

En primer lugar se define un modelo secuencial simple de una sola capa, con 32 neuronas de activación “relu” y 5 unidades de salida para lograr la clasificación de la velocidad de adopción con activación ‘softmax’

model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 32, activation = 'relu', input_shape = 13) %>% 
  layer_dense(units = 5, activation = 'softmax')

summary(model)
## Model: "sequential"
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## dense (Dense)                    (None, 32)                    448         
## ___________________________________________________________________________
## dense_1 (Dense)                  (None, 5)                     165         
## ===========================================================================
## Total params: 613
## Trainable params: 613
## Non-trainable params: 0
## ___________________________________________________________________________

Compilación del modelo

Teniendo en cuenta que se trata de una clasificación categórica multinomial, con features categóricas y una continua (edad), utilizamos como función de pérdida “sparse_categorical_crossentropy”, con optimizador “adam”.

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'adam',
  metrics = c('accuracy')
)

Entrenamiento

Se definen 10 épocas de entrenamiento

model_0 <- model %>% 
  fit(x_train, y_train, epochs = 10)

Las métricas del modelo son:

model_0$metrics$accuracy[10]
## [1] 0.3479141
model_0$metrics$loss[10]
## [1] 1.4217

Validación

score_0 <- model %>% evaluate(x_val, y_val)

Las métricas para el conjunto de evaluación:

cat('Evaluation loss:', score_0$loss, "\n")
## Evaluation loss: 1.415645
cat('Evaluation accuracy:', score_0$acc, "\n")
## Evaluation accuracy: 0.3527559
plot(model_0)

1.2 Entrenar uno o varios modelos (con dos o tres es suficiente, veremos más de esto en el práctico 2). Evaluar los modelos en el conjunto de ev y test con el mismo conjunto de datos entrenamos otro modelo.

En primer lugar agrego una nueva capa con 32 nodos y activación “relu” y una capa dropout con una tasa de 0.5; se utiliza la misma complilación.

model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 64, activation = 'relu', input_shape = 13) %>% 
  layer_dropout(rate = 0.5) %>% 
  layer_dense(units = 32, activation = 'relu') %>%
  layer_dense(units = 5, activation = 'softmax')

summary(model)
## Model: "sequential_1"
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## dense_2 (Dense)                  (None, 64)                    896         
## ___________________________________________________________________________
## dropout (Dropout)                (None, 64)                    0           
## ___________________________________________________________________________
## dense_3 (Dense)                  (None, 32)                    2080        
## ___________________________________________________________________________
## dense_4 (Dense)                  (None, 5)                     165         
## ===========================================================================
## Total params: 3,141
## Trainable params: 3,141
## Non-trainable params: 0
## ___________________________________________________________________________

Compilación del modelo:

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'adam',
  metrics = c('accuracy')
)

Entrenamiento:

model_1 <- model %>% 
  fit(x_train, y_train, epochs = 10)

model_1$metrics$accuracy[10]
## [1] 0.3395437
model_1$metrics$loss[10]
## [1] 1.430682

Validación:

score_1 <- model %>% evaluate(x_val, y_val)

cat('Evaluation loss:', score_1$loss, "\n")
## Evaluation loss: 1.407884
cat('Evaluation accuracy:', score_1$acc, "\n")
## Evaluation accuracy: 0.3631496

El accuracy sigue siendo bajo, se agregan épocas de entrenamiento

model_2 <- model %>% 
  fit(x_train, y_train, epochs = 20)

Métricas:

model_2$metrics$accuracy[20]
## [1] 0.3542595
model_2$metrics$loss[20]
## [1] 1.415962

Validación:

score_2 <- model %>% evaluate(x_val, y_val)

cat('Evaluation loss:', score_2$loss, "\n")
## Evaluation loss: 1.401618
cat('Evaluation accuracy:', score_2$acc, "\n")
## Evaluation accuracy: 0.3703937

No se observa una mejora significativa incrementando las épocas de entrenamiento. Se realizarán pruebas cambiando el optimizador. La función de pérdida no se considera adecuado cambiarla ya que entre todas las features categoricas, se encuentra la variable continua edad que fue normalizada para entrar al modelo.

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'Nadam',
  metrics = c('accuracy')
)

Entrenamiento:

model_3 <- model %>% 
  fit(x_train, y_train, epochs = 10)

model_3$metrics$accuracy[10]
## [1] 0.3585797
model_3$metrics$loss[10]
## [1] 1.410173

Validación:

score_3 <- model %>% evaluate(x_val, y_val)

cat('Evaluation loss:', score_3$loss, "\n")
## Evaluation loss: 1.401556
cat('Evaluation accuracy:', score_3$acc, "\n")
## Evaluation accuracy: 0.3719685

No se verifican grandes cambios. Se prueba el optimizador “Adamax”, con 15 épocas de entrenamiento.

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'Adamax',
  metrics = c('accuracy')
)

model_4 <- model %>% 
  fit(x_train, y_train, epochs = 15)

Métricas:

model_4$metrics$accuracy[15]
## [1] 0.3549345
model_4$metrics$loss[15]
## [1] 1.406578

Validación:

score_4 <- model %>% evaluate(x_val, y_val)

cat('Evaluation loss:', score_4$loss, "\n")
## Evaluation loss: 1.401002
cat('Evaluation accuracy:', score_4$acc, "\n")
## Evaluation accuracy: 0.3725984

EJERCICIO 2

2.1. Utilizar el mismo modelo anterior y explorar cómo cambian los resultados a medida que agregamos o quitamos columnas.

A continuación se presentan diferentes resultados a partir de cambios en los datos, manteniendo el mismo modelo. En primer lugar agregamos color y raza; en el análisis descriptivo se observó que la variable color1, no tiene valores vacíos o ceros, en cambio color2 y color3 tiene valores en cero (valor no codificado), lo que da la idea de ausencia de color. Teniendo en cuenta lo anterior se decidió crear una variable que indique la cantidad de colores y utilizar color1 como variable categórica.

Para las variables Breed1 y Breed2, se realiza un procedimiento similar, creando una nueva variable que indique si la mascota tiene una o dos razas y la raza señalada como principal en la variable Breed1.

A continuación se agregan los features seleccionadas al data frame anterior y se define el conjunto de entrenamiento y evaluación.

x1 <- cbind(x, color, color_1, raza, raza_1)

a <- as.integer(dim(x1)[1]*0.7)

x1_train <- x1[1:a, ]
x1_val <- x1[ (a+1) : dim(x1)[1], ]

dim(x1_train)
## [1] 7407  330

Definición del modelo

dim(x1_train)
## [1] 7407  330
model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 64, activation = 'relu', input_shape = 330) %>% 
  layer_dropout(rate = 0.5) %>% 
  layer_dense(units = 32, activation = 'relu') %>%
  layer_dense(units = 5, activation = 'softmax')

summary(model)
## Model: "sequential_2"
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## dense_5 (Dense)                  (None, 64)                    21184       
## ___________________________________________________________________________
## dropout_1 (Dropout)              (None, 64)                    0           
## ___________________________________________________________________________
## dense_6 (Dense)                  (None, 32)                    2080        
## ___________________________________________________________________________
## dense_7 (Dense)                  (None, 5)                     165         
## ===========================================================================
## Total params: 23,429
## Trainable params: 23,429
## Non-trainable params: 0
## ___________________________________________________________________________

Compilado:

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'Adamax',
  metrics = c('accuracy')
)

Entrenamiento:

model_5 <- model %>% 
  fit(x1_train, y_train, epochs = 10)

model_5$metrics$accuracy[10]
## [1] 0.3369785
model_5$metrics$loss[10]
## [1] 1.428467

Validación:

score_5 <- model %>% evaluate(x1_val, y_val)

cat('Evaluation loss:', score_5$loss, "\n")
## Evaluation loss: 1.411337
cat('Evaluation accuracy:', score_5$acc, "\n")
## Evaluation accuracy: 0.3584252
plot(model_5)

Definimos un nuevo conjunto de datos agregando vacunación y desparasitado (“Vaccinated”, “Dewormed”)

Definición del Modelo

dim(x2_train)
## [1] 7407  336
model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 64, activation = 'relu', input_shape = 336) %>% 
  layer_dropout(rate = 0.5) %>% 
  layer_dense(units = 32, activation = 'relu') %>%
  layer_dense(units = 5, activation = 'softmax')

#Compilando el modelo

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'Adamax',
  metrics = c('accuracy')
)

Entrenamiento

model_6 <- model %>% 
  fit(x2_train, y_train, epochs = 10)

model_6$metrics$accuracy[10]
## [1] 0.3375186
model_6$metrics$loss[10]
## [1] 1.426778
score_6 <- model %>% evaluate(x2_val, y_val)

cat('Evaluation loss:', score_6$loss, "\n")
## Evaluation loss: 1.407765
cat('Evaluation accuracy:', score_6$acc, "\n")
## Evaluation accuracy: 0.3584252

El accurancy del modelo sigue siendo muy bajo; se intenta quitar variables del conjunto de datos anterior para observar si el mismo mejora. Se eliminan las variables “Health” y “MaturitySize”

Definición del modelo:

model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 64, activation = 'relu', input_shape = 327) %>% 
  layer_dropout(rate = 0.5) %>% 
  layer_dense(units = 32, activation = 'relu') %>%
  layer_dense(units = 5, activation = 'softmax')

#Compilando el modelo

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'Adamax',
  metrics = c('accuracy')
)

Entrenamiento:

model_7 <- model %>% 
  fit(x3_train, y_train, epochs = 10)

model_7$metrics$accuracy[10]
## [1] 0.3427838
model_7$metrics$loss[10]
## [1] 1.422105

Validación:

score_7 <- model %>% evaluate(x3_val, y_val)

cat('Evaluation loss:', score_7$loss, "\n")
## Evaluation loss: 1.407449
cat('Evaluation accuracy:', score_7$acc, "\n")
## Evaluation accuracy: 0.3461417

Dado que no se logra mejorar la calidad del modelo, se intenta categorizando la variable edad, de forma tal que todos los features queden definidos como categóricos. Para ello se confeccionan intervalos de 0 a 3 meses, de 3 a 6, de 6 a 12 y más de 12.

dim(x4_train)
## [1] 7407  330
model <- keras_model_sequential() 
model %>% 
  layer_dense(units = 64, activation = 'relu', input_shape = 330) %>% 
  layer_dropout(rate = 0.5) %>% 
  layer_dense(units = 32, activation = 'relu') %>%
  layer_dense(units = 5, activation = 'softmax')

#Compilando el modelo

model %>% compile(
  loss = 'sparse_categorical_crossentropy',
  optimizer = 'Adamax',
  metrics = c('accuracy')
)

Entrenamiento:

model_8 <- model %>% 
  fit(x4_train, y_train, epochs = 10)

model_8$metrics$accuracy[10]
## [1] 0.3603348
model_8$metrics$loss[10]
## [1] 1.40025

Validación:

score_8 <- model %>% evaluate(x4_val, y_val)

cat('Evaluation loss:', score_8$loss, "\n")
## Evaluation loss: 1.38783
cat('Evaluation accuracy:', score_8$acc, "\n")
## Evaluation accuracy: 0.3719685
plot(model_8)

A continuación se presenta una comparación de los modelos entrenados:

a
##    modelo
## 1 Modelo0
## 2 Modelo1
## 3 Modelo2
## 4 Modelo3
## 5 Modelo4
## 6 Modelo5
## 7 Modelo6
## 8 Modelo7
## 9 Modelo8
##                                                                                      feature
## 1                                                    Type, Age, Gender, MaturitySize, Health
## 2                                                    Type, Age, Gender, MaturitySize, Health
## 3                                                    Type, Age, Gender, MaturitySize, Health
## 4                                                    Type, Age, Gender, MaturitySize, Health
## 5                                                    Type, Age, Gender, MaturitySize, Health
## 6                      Type, Age, Gender, MaturitySize, Health, color, color_1, raza, raza_1
## 7 Type, Age, Gender, MaturitySize, Health, color, color1, raza, raza_1, Vaccinated, Dewormed
## 8                                   Type, Age, Gender, color_1, raza_1, vaccinated, dewormed
## 9                                 Type, Age_r, Gender, color_1, raza_1, vaccinated, dewormed
##   batch_size epochs steps samples                   loss_function
## 1         32     10   232    7407 sparse_categorical_crossentropy
## 2         32     10   232    7407 sparse_categorical_crossentropy
## 3         32     20   232    7407 sparse_categorical_crossentropy
## 4         32     10   232    7407 sparse_categorical_crossentropy
## 5         32     15   232    7407 sparse_categorical_crossentropy
## 6         32     10   232    7407 sparse_categorical_crossentropy
## 7         32     10   232    7407 sparse_categorical_crossentropy
## 8         32     10   232    7407 sparse_categorical_crossentropy
## 9         32     10   232    7407 sparse_categorical_crossentropy
##   optimizer loss_train acc_train  loss_ev    acc_ev
## 1      adam   1.421700 0.3479141 1.415645 0.3527559
## 2      adam   1.430682 0.3395437 1.407884 0.3631496
## 3      adam   1.415962 0.3542595 1.401618 0.3703937
## 4     Nadam   1.410173 0.3585797 1.401556 0.3719685
## 5    Adamax   1.406578 0.3549345 1.401002 0.3725984
## 6    Adamax   1.428467 0.3369785 1.411337 0.3584252
## 7    Adamax   1.426778 0.3375186 1.407765 0.3584252
## 8    Adamax   1.422105 0.3427838 1.407449 0.3461417
## 9    Adamax   1.400250 0.3603348 1.387830 0.3719685

En la tabla anterior se presenta un resumen de los hiperparámetros utilizados en el diseño, la función de pérdida, el optimizador y los resultados que fue arrojando cada modelo en los conjuntos de entrenamiento y evaluación.

Es posible observar que el acurracy de todos los modelos es muy bajo, tanto en los conjuntos de entrenamiento como evaluación. En el primer caso, el accuracy varía entre 0.337 y 0.36; para los conjuntos de validación varían entre 0.346 y 0.373.

No se verifica la presencia de overfiting ya que en todos los casos el accuracy de la base de evaluación es levemente mayor a la de entrenamiento.