diff --git a/01-introduccion.html b/01-introduccion.html index a759020a..6e976dc0 100644 --- a/01-introduccion.html +++ b/01-introduccion.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/01-introduccion_files/figure-html/unnamed-chunk-14-1.png b/01-introduccion_files/figure-html/unnamed-chunk-14-1.png index d87c0dae..19f119d0 100644 Binary files a/01-introduccion_files/figure-html/unnamed-chunk-14-1.png and b/01-introduccion_files/figure-html/unnamed-chunk-14-1.png differ diff --git a/02-principios-supervisado.html b/02-principios-supervisado.html index c0704d0c..ef694961 100644 --- a/02-principios-supervisado.html +++ b/02-principios-supervisado.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/03-metodos-locales.html b/03-metodos-locales.html index b48d9821..85ba7985 100644 --- a/03-metodos-locales.html +++ b/03-metodos-locales.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/04-lineales-ingenieria.html b/04-lineales-ingenieria.html index 21bc9201..a234c520 100644 --- a/04-lineales-ingenieria.html +++ b/04-lineales-ingenieria.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/05-regularizacion-1.html b/05-regularizacion-1.html index 1a2571b9..325c81f9 100644 --- a/05-regularizacion-1.html +++ b/05-regularizacion-1.html @@ -216,7 +216,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/05-regularizacion-1_files/figure-html/unnamed-chunk-34-1.png b/05-regularizacion-1_files/figure-html/unnamed-chunk-34-1.png index 256a0d27..a41f21a6 100644 Binary files a/05-regularizacion-1_files/figure-html/unnamed-chunk-34-1.png and b/05-regularizacion-1_files/figure-html/unnamed-chunk-34-1.png differ diff --git a/06-redes-neuronales-1.html b/06-redes-neuronales-1.html index 3e7d9a52..6b2bbdad 100644 --- a/06-redes-neuronales-1.html +++ b/06-redes-neuronales-1.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • @@ -683,13 +683,13 @@ 

    [[1]]
           [,1]
-[1,] -5.422091
-[2,]  4.781280
-[3,]  5.289693
-[4,] -5.083941
+[1,] -5.422077
+[2,]  4.781271
+[3,]  5.289690
+[4,] -5.083926
 
 [[2]]
-[1] 2.370601
    +[1] 2.370607

    Ejercicio: interpreta la red en términos de qué unidades están encendidas (valor cercano a 1) o apagadas (valor cercano a 0). ¿Puedes ajustar este modelo con dos tres unidades intermedias? Haz varias pruebas: ¿qué dificultades encuentras?

    @@ -1062,12 +1062,12 @@

    Ejemplo (reg preds |> head() 
              [,1]
-[1,]  9.117618
-[2,] 22.663441
-[3,]  8.569652
-[4,]  8.558598
-[5,]  8.842549
-[6,]  8.559493
    +[1,] 9.117623 +[2,] 22.663464 +[3,] 8.569628 +[4,] 8.558584 +[5,] 8.842519 +[6,] 8.559466

    Y obtenemos el siguiente resultado:

    diff --git a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-31-1.png b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-31-1.png index 11865af9..2040e7fa 100644 Binary files a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-31-1.png and b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-31-1.png differ diff --git a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-48-1.png b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-48-1.png index 41d37b2a..4c178bca 100644 Binary files a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-48-1.png and b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-48-1.png differ diff --git a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-50-1.png b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-50-1.png index 1a15a1c3..55bce8dd 100644 Binary files a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-50-1.png and b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-50-1.png differ diff --git a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-53-1.png b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-53-1.png index d3dbfc28..2712c543 100644 Binary files a/06-redes-neuronales-1_files/figure-html/unnamed-chunk-53-1.png and b/06-redes-neuronales-1_files/figure-html/unnamed-chunk-53-1.png differ diff --git a/07-intervalos-predictivos.html b/07-intervalos-predictivos.html index f53ef0d5..9b713d3f 100644 --- a/07-intervalos-predictivos.html +++ b/07-intervalos-predictivos.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/08-clasificacion-1.html b/08-clasificacion-1.html index 7f4e6dce..2cd6dbcb 100644 --- a/08-clasificacion-1.html +++ b/08-clasificacion-1.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • @@ -2589,14 +2589,14 @@

    - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades

  • @@ -699,8 +699,8 @@

    Ejemplo

    <dbl> <dbl> <dbl> 1 -Inf 0 1 2 0.00305 0 1 - 3 0.00346 0.00448 1 - 4 0.00407 0.00897 1 + 3 0.00345 0.00448 1 + 4 0.00406 0.00897 1 5 0.00437 0.0135 1 6 0.00476 0.0224 1 7 0.00486 0.0269 1 @@ -788,7 +788,7 @@

    Ejemplo

    modelo .metric .estimator .estimate <chr> <chr> <chr> <dbl> 1 IMC y edad roc_auc binary 0.761 -2 Todas roc_auc binary 0.865 +2 Todas roc_auc binary 0.866

    En este ejemplo, vemos que casi no importa qué perfil de especificidad y sensibilidad busquemos: el clasificador que usa todas las variables domina casi siempre al clasificador que sólo utiliza IMC y edad.

    @@ -1102,7 +1102,7 @@

    - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-17-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-17-1.png index b31090b9..50c15b03 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-17-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-17-1.png differ diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-20-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-20-1.png index 70ad999f..16b11685 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-20-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-20-1.png differ diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-22-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-22-1.png index c9262a61..ec25ab47 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-22-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-22-1.png differ diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-23-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-23-1.png index b13ee6c4..77a5b635 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-23-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-23-1.png differ diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-24-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-24-1.png index 639b8332..d5c83637 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-24-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-24-1.png differ diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-25-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-25-1.png index ce5a9db4..9df5fa21 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-25-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-25-1.png differ diff --git a/09-clasificacion-2_files/figure-html/unnamed-chunk-3-1.png b/09-clasificacion-2_files/figure-html/unnamed-chunk-3-1.png index fc43f32c..5d2be342 100644 Binary files a/09-clasificacion-2_files/figure-html/unnamed-chunk-3-1.png and b/09-clasificacion-2_files/figure-html/unnamed-chunk-3-1.png differ diff --git a/10-clasificacion-calibracion.html b/10-clasificacion-calibracion.html index ef1e9cbc..366e7812 100644 --- a/10-clasificacion-calibracion.html +++ b/10-clasificacion-calibracion.html @@ -7,7 +7,7 @@ -Aprendizaje Máquina - 10  Incertidumbre en clasificación +Aprendizaje Máquina - 10  Calibración de probabilidades @@ -849,23 +849,23 @@

    Ejemplo: dia calibracion_gpos |> gt() |> fmt_number(where(is_double), decimals = 3)
    -
    - @@ -1422,23 +1422,23 @@

    preds_tbl |> head() |> gt() |> fmt_number(where(is_double), decimals = 3)

    -
    - diff --git a/10-clasificacion-calibracion_files/figure-html/unnamed-chunk-4-1.png b/10-clasificacion-calibracion_files/figure-html/unnamed-chunk-4-1.png index 4d13aa1a..5d7ad6ca 100644 Binary files a/10-clasificacion-calibracion_files/figure-html/unnamed-chunk-4-1.png and b/10-clasificacion-calibracion_files/figure-html/unnamed-chunk-4-1.png differ diff --git a/81-apendice-descenso.html b/81-apendice-descenso.html index fffd9481..b639fb33 100644 --- a/81-apendice-descenso.html +++ b/81-apendice-descenso.html @@ -197,7 +197,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • @@ -589,7 +589,7 @@

    [[1]] [,1] [1,] 0.007331367 -[2,] 0.016437238 +[2,] 0.016437240 [3,] 0.004633876 [[2]] @@ -787,8 +787,8 @@

    Ejemplo

    [[1]]
              [,1]
 [1,] 0.0079817399
-[2,] 0.0019486141
-[3,] 0.0005532745
+[2,] 0.0019486139
+[3,] 0.0005532746
 
 [[2]]
 [1] 0.0003491882
    @@ -1041,7 +1041,7 @@

    Ejemplo

    • Y verificamos que concuerda con la salida de lm:

    diff --git a/82-apendice-descenso-estocastico_files/figure-html/unnamed-chunk-24-1.png b/82-apendice-descenso-estocastico_files/figure-html/unnamed-chunk-24-1.png index 5386c9d2..50486fb1 100644 Binary files a/82-apendice-descenso-estocastico_files/figure-html/unnamed-chunk-24-1.png and b/82-apendice-descenso-estocastico_files/figure-html/unnamed-chunk-24-1.png differ diff --git a/99-referencias.html b/99-referencias.html index bff69e9d..100c9863 100644 --- a/99-referencias.html +++ b/99-referencias.html @@ -179,7 +179,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/index.html b/index.html index b76cd253..53c54555 100644 --- a/index.html +++ b/index.html @@ -180,7 +180,7 @@
  • - 10  Incertidumbre en clasificación + 10  Calibración de probabilidades
  • diff --git a/search.json b/search.json index 3b5318cc..5c0e25b3 100644 --- a/search.json +++ b/search.json @@ -228,7 +228,7 @@ "href": "06-redes-neuronales-1.html#interacciones-en-redes-neuronales", "title": "6  Redes neuronales (intro)", "section": "6.2 Interacciones en redes neuronales", - "text": "6.2 Interacciones en redes neuronales\nEs posible capturar interacciones con redes neuronales. Consideremos el siguiente ejemplo simple:\n\nf <- function(x1, x2){\n 2 + 0.1* x1 + 0.1 * x2 + 10 * (x1 - 0.5) * (x2 - 0.5)\n}\ndat <- expand.grid(x1 = seq(0, 1, 0.05), x2 = seq(0, 1, 0.05))\ndat <- dat |> mutate(f = f(x1, x2))\nggplot(dat, aes(x=x1, y=x2)) + geom_tile(aes(fill=f))\n\n\n\n\nEsta función puede entenderse como un o exclusivo: la respuesta es alta sólo cuando \\(x_1\\) y \\(x_2\\) tienen valores opuestos (\\(x_1\\) grande pero \\(x_2\\) chica y viceversa).\nNo es posible modelar correctamente esta función mediante el modelo lineal (sin interacciones). Pero podemos incluir la interacción en el modelo lineal o intentar usar una red neuronal. Primero simulamos unos datos y probamos el modelo logístico con y sin interacciones:\n\nset.seed(322)\nn <- 2000\ndat_ent <- tibble(x1 = rbeta(n, 1, 1), x2 = rbeta(n, 1, 1)) |>\n mutate(f = f(x1, x2)) |>\n mutate(y = f + rnorm(n, 0, 0.1))\nmod_1 <- lm(y ~ x1 + x2, data = dat_ent)\nmod_1\n\n\nCall:\nlm(formula = y ~ x1 + x2, data = dat_ent)\n\nCoefficients:\n(Intercept) x1 x2 \n 1.8936 0.2046 0.2097 \n\n\nEl resultado del modelo lineal no es bueno:\n\ntibble(y_hat = fitted(mod_1), y = dat_ent$y) |> \n ggplot(aes(x = y_hat, y = y)) + geom_point(color = \"red\") +\n geom_abline() +\n coord_obs_pred()\n\n\n\n\nSin embargo, agregando una interacción lo mejoramos considerablemente (examina la raíz del error cuadrático medio, por ejemplo):\n\nmod_2 <- lm(y ~ x1 + x2 + x1:x2, data = dat_ent)\nmod_2\n\n\nCall:\nlm(formula = y ~ x1 + x2 + x1:x2, data = dat_ent)\n\nCoefficients:\n(Intercept) x1 x2 x1:x2 \n 4.499 -4.895 -4.885 9.964 \n\ntibble(y_hat = fitted(mod_2), y = dat_ent$y) |> \n ggplot(aes(x = y_hat, y = y)) + geom_point(color = \"red\") +\n geom_abline() +\n coord_obs_pred()\n\n\n\n\nObservese la gran diferencia de error entre los dos modelos (en este caso, el sobreajuste no es un problema).\nAhora consideramos qué red neuronal puede ser apropiada.\n\ntensorflow::set_random_seed(421) \nmod_inter <- keras_model_sequential()\nmod_inter |> \n layer_dense(units = 4, activation = \"sigmoid\",\n name = \"capa_intermedia\", input_shape = c(2)) |>\n layer_dense(units = 1, name = \"capa_final\",\n activation = \"linear\") \n\n\nmod_inter |> compile(loss = \"mse\", \n optimizer = optimizer_sgd(learning_rate = 0.3, momentum = 0.5))\nhistoria <- mod_inter |> \n fit(dat_ent |> select(x1, x2) |> as.matrix(), dat_ent$y,\n batch_size = 20,\n epochs = 100, verbose = 0)\n\nVerificamos que esta red captura la interacción:\n\npreds <- predict(mod_inter,\n dat |> select(x1, x2) |> as.matrix())\ndat <- dat |> mutate(f_red = preds)\nggplot(dat, aes(x = x1, y = x2)) + \n geom_tile(aes(fill = f_red))\n\n\n\n\n\npreds_ent <- predict(mod_inter, dat_ent |> select(x1, x2) |> as.matrix())\ntibble(pred = preds_ent[,1], f = dat_ent$y) |> \n ggplot(aes(x = pred, y = f)) +\n geom_point() +\n geom_abline(colour = \"red\") +\n coord_obs_pred()\n\n\n\n\nAunque podemos extraer los cálculos de la red ajustada, vamos a hacer el cálculo de la red a mano. La función feed forward es:\n\nbeta <- get_weights(mod_inter)\nfeed_fow <- function(beta, x){\n a <- h(t(beta[[1]]) %*% x + as.matrix(beta[[2]], 2, 1)) \n f <- t(beta[[3]]) %*% a + as.matrix(beta[[4]], 1, 1)\n f\n}\n\nObservación: ¿cómo funciona esta red? Consideremos la capa intermedia (3 unidades) para cuatro casos: \\((0,0), (0,1), (1,0), (1,1)\\):\n\nmat_entrada <- tibble(x_1 = c(0,0,1,1), x_2 = c(0,1,0,1)) |> as.matrix()\ncapa_1 <- keras_model(inputs = mod_inter$input,\n outputs = get_layer(mod_inter, \"capa_intermedia\")$output)\npred_mat <- predict(capa_1, mat_entrada) |> round(2)\nrownames(pred_mat) <- c(\"apagadas\", \"segunda\", \"primera\", \"ambas\")\npred_mat\n\n [,1] [,2] [,3] [,4]\napagadas 0.15 0.00 0.64 0.12\nsegunda 0.59 0.05 0.09 0.01\nprimera 0.01 0.05 0.07 0.60\nambas 0.05 0.56 0.00 0.06\n\n\nLos pesos de la última capa son:\n\nbeta[3:4]\n\n[[1]]\n [,1]\n[1,] -5.422091\n[2,] 4.781280\n[3,] 5.289693\n[4,] -5.083941\n\n[[2]]\n[1] 2.370601\n\n\nEjercicio: interpreta la red en términos de qué unidades están encendidas (valor cercano a 1) o apagadas (valor cercano a 0). ¿Puedes ajustar este modelo con dos tres unidades intermedias? Haz varias pruebas: ¿qué dificultades encuentras?" + "text": "6.2 Interacciones en redes neuronales\nEs posible capturar interacciones con redes neuronales. Consideremos el siguiente ejemplo simple:\n\nf <- function(x1, x2){\n 2 + 0.1* x1 + 0.1 * x2 + 10 * (x1 - 0.5) * (x2 - 0.5)\n}\ndat <- expand.grid(x1 = seq(0, 1, 0.05), x2 = seq(0, 1, 0.05))\ndat <- dat |> mutate(f = f(x1, x2))\nggplot(dat, aes(x=x1, y=x2)) + geom_tile(aes(fill=f))\n\n\n\n\nEsta función puede entenderse como un o exclusivo: la respuesta es alta sólo cuando \\(x_1\\) y \\(x_2\\) tienen valores opuestos (\\(x_1\\) grande pero \\(x_2\\) chica y viceversa).\nNo es posible modelar correctamente esta función mediante el modelo lineal (sin interacciones). Pero podemos incluir la interacción en el modelo lineal o intentar usar una red neuronal. Primero simulamos unos datos y probamos el modelo logístico con y sin interacciones:\n\nset.seed(322)\nn <- 2000\ndat_ent <- tibble(x1 = rbeta(n, 1, 1), x2 = rbeta(n, 1, 1)) |>\n mutate(f = f(x1, x2)) |>\n mutate(y = f + rnorm(n, 0, 0.1))\nmod_1 <- lm(y ~ x1 + x2, data = dat_ent)\nmod_1\n\n\nCall:\nlm(formula = y ~ x1 + x2, data = dat_ent)\n\nCoefficients:\n(Intercept) x1 x2 \n 1.8936 0.2046 0.2097 \n\n\nEl resultado del modelo lineal no es bueno:\n\ntibble(y_hat = fitted(mod_1), y = dat_ent$y) |> \n ggplot(aes(x = y_hat, y = y)) + geom_point(color = \"red\") +\n geom_abline() +\n coord_obs_pred()\n\n\n\n\nSin embargo, agregando una interacción lo mejoramos considerablemente (examina la raíz del error cuadrático medio, por ejemplo):\n\nmod_2 <- lm(y ~ x1 + x2 + x1:x2, data = dat_ent)\nmod_2\n\n\nCall:\nlm(formula = y ~ x1 + x2 + x1:x2, data = dat_ent)\n\nCoefficients:\n(Intercept) x1 x2 x1:x2 \n 4.499 -4.895 -4.885 9.964 \n\ntibble(y_hat = fitted(mod_2), y = dat_ent$y) |> \n ggplot(aes(x = y_hat, y = y)) + geom_point(color = \"red\") +\n geom_abline() +\n coord_obs_pred()\n\n\n\n\nObservese la gran diferencia de error entre los dos modelos (en este caso, el sobreajuste no es un problema).\nAhora consideramos qué red neuronal puede ser apropiada.\n\ntensorflow::set_random_seed(421) \nmod_inter <- keras_model_sequential()\nmod_inter |> \n layer_dense(units = 4, activation = \"sigmoid\",\n name = \"capa_intermedia\", input_shape = c(2)) |>\n layer_dense(units = 1, name = \"capa_final\",\n activation = \"linear\") \n\n\nmod_inter |> compile(loss = \"mse\", \n optimizer = optimizer_sgd(learning_rate = 0.3, momentum = 0.5))\nhistoria <- mod_inter |> \n fit(dat_ent |> select(x1, x2) |> as.matrix(), dat_ent$y,\n batch_size = 20,\n epochs = 100, verbose = 0)\n\nVerificamos que esta red captura la interacción:\n\npreds <- predict(mod_inter,\n dat |> select(x1, x2) |> as.matrix())\ndat <- dat |> mutate(f_red = preds)\nggplot(dat, aes(x = x1, y = x2)) + \n geom_tile(aes(fill = f_red))\n\n\n\n\n\npreds_ent <- predict(mod_inter, dat_ent |> select(x1, x2) |> as.matrix())\ntibble(pred = preds_ent[,1], f = dat_ent$y) |> \n ggplot(aes(x = pred, y = f)) +\n geom_point() +\n geom_abline(colour = \"red\") +\n coord_obs_pred()\n\n\n\n\nAunque podemos extraer los cálculos de la red ajustada, vamos a hacer el cálculo de la red a mano. La función feed forward es:\n\nbeta <- get_weights(mod_inter)\nfeed_fow <- function(beta, x){\n a <- h(t(beta[[1]]) %*% x + as.matrix(beta[[2]], 2, 1)) \n f <- t(beta[[3]]) %*% a + as.matrix(beta[[4]], 1, 1)\n f\n}\n\nObservación: ¿cómo funciona esta red? Consideremos la capa intermedia (3 unidades) para cuatro casos: \\((0,0), (0,1), (1,0), (1,1)\\):\n\nmat_entrada <- tibble(x_1 = c(0,0,1,1), x_2 = c(0,1,0,1)) |> as.matrix()\ncapa_1 <- keras_model(inputs = mod_inter$input,\n outputs = get_layer(mod_inter, \"capa_intermedia\")$output)\npred_mat <- predict(capa_1, mat_entrada) |> round(2)\nrownames(pred_mat) <- c(\"apagadas\", \"segunda\", \"primera\", \"ambas\")\npred_mat\n\n [,1] [,2] [,3] [,4]\napagadas 0.15 0.00 0.64 0.12\nsegunda 0.59 0.05 0.09 0.01\nprimera 0.01 0.05 0.07 0.60\nambas 0.05 0.56 0.00 0.06\n\n\nLos pesos de la última capa son:\n\nbeta[3:4]\n\n[[1]]\n [,1]\n[1,] -5.422077\n[2,] 4.781271\n[3,] 5.289690\n[4,] -5.083926\n\n[[2]]\n[1] 2.370607\n\n\nEjercicio: interpreta la red en términos de qué unidades están encendidas (valor cercano a 1) o apagadas (valor cercano a 0). ¿Puedes ajustar este modelo con dos tres unidades intermedias? Haz varias pruebas: ¿qué dificultades encuentras?" }, { "objectID": "06-redes-neuronales-1.html#cálculo-en-redes-feed-forward", @@ -263,7 +263,7 @@ "href": "06-redes-neuronales-1.html#ajuste-de-parámetros-introducción", "title": "6  Redes neuronales (intro)", "section": "6.7 Ajuste de parámetros (introducción)", - "text": "6.7 Ajuste de parámetros (introducción)\nConsideramos la versión con regularización ridge (también llamada L2) de la devianza de entrenamiento como nuestro función objetivo:\n\n\n\n\n\n\nAjuste de redes neuronales\n\n\n\nPara un problema de regresión, ajustamos los pesos \\(\\Theta^{(1)},\\Theta^{(2)},\\ldots, \\Theta^{(L)}\\) de la red intentando minimizar el error cuadrático medio (penalizado) sobre la muestra de entrenamiento: \\[D = -\\frac{1}{2n}\\sum_{i=1}^n (y^{(i)} - f(x^{i}))^2= + \\lambda \\sum_{l=2}^{L} \\sum_{k=1}^{n_{l-1}} \\sum_{j=1}^{n_l}(\\theta_{j,k}^{(l)})^2.\\] Este problema en general no es convexo y puede tener múltiples mínimos.\n\n\nVeremos el proceso de ajuste, selección de arquitectura, etc. más adelante. Por el momento hacemos unas observaciones acerca de este problema de minimización:\n\nHay varios algoritmos para minimizar este error, algunos avanzados incluyendo información de segundo orden (como Newton), pero actualmente las técnicas más populares, para redes grandes, están derivadas de descenso en gradiente. Más específicamente, una variación, que es descenso estocástico.\nQue el algoritmo depende principalmente de multiplicaciones de matrices y acumulaciones implica que puede escalarse de diversas maneras. Una es paralelizando sobre la muestra de entrenamiento (y calcular acumulados al final), pero también se pueden paralelizar las multiplicaciones de matrices (para lo cual los GPUs se prestan muy bien).\nPara redes neuronales, el gradiente se calcula con un algoritmo que se llama back-propagation, que es una aplicación de la regla de la cadena para propagar errores desde la capa de salida a lo largo de todas las capas para ajustar los pesos y sesgos.\nEn estos problemas no buscamos el mínimo global, sino un mínimo local de buen desempeño. Puede haber múltiples mínimos, puntos silla, regiones relativamente planas, precipicios (curvatura alta). Nótese que la simetría implica que podemos obtener la misma red cambiando pesos entre neuronas y las conexiones correspondientes. Esto implica que necesariamente hay varios mínimos.\nTodo esto dificulta el entrenamiento de redes neuronales grandes. Para redes grandes, ni siquiera esperamos a alcanzar un mínimo local, sino que nos a veces detenemos prematuramente cuando obtenemos el mejor desempeño posible.\nPara este problema, no tiene sentido comenzar las iteraciones con todos los pesos igual a cero, pues las unidades de la red son simétricas: no hay nada que distinga una de otra si todos los pesos son iguales. Esto quiere decir que si iteramos, todas las neuronas van a aprender lo mismo.\nEs importante no comenzar valores de los pesos grandes, pues las funciones logísticas pueden quedar en regiones planas donde la minimización es lenta, o podemos tener gradientes demasiado grandes y produzcan inestabilidad en el cálculo del gradiente.\nEl ajuste de la tasa de aprendizaje es un parámetro importante, más delicado que para problemas convexos. Generalmente lo tratamos con un hiperparámetro más que hay que afinar. Tasas demasiado grandes pueden llevarnos a mínimos locales relativamente malos.\nGeneralmente los pesos se inicializan al azar con variables independientes gaussianas o uniformes centradas en cero, y con varianza chica (por ejemplo \\(U(-0.5,0.5)\\)). Una recomendación es usar \\(U(-1/\\sqrt{m}, 1/\\sqrt{m})\\) donde \\(m\\) es el número de entradas. En general, hay que experimentar con este parámetro.\n\nEl proceso para ajustar una red es entonces:\n\nDefinir número de capas ocultas, número de neuronas por cada capa, y un valor del parámetro de regularización. Estandarizar las entradas. Usualmente podemos probar comenzar con una o dos capas ocultas, de tamaño proporcional al número de entradas. Es buena idea comenzar con una red relativamente grande que tienen error bajo de entrenamiento aunque sobreajuste, y después regularizar y refinar su tamaño.\nSeleccionar parámetros al azar para \\(\\Theta^{(2)},\\Theta^{(3)},\\ldots, \\Theta^{(L)}\\). Se toman, por ejemplo, normales con media 0 y varianza chica.\nCorrer un algoritmo de minimización del error mostrada arriba. Es necesario experimentar con los parámetros del algoritmo de minimización.\nVerificar convergencia del algoritmo a un mínimo local (o el algoritmo no está mejorando).\nPredecir usando el modelo ajustado.\n\nFinalmente, podemos probar distintas arquitecturas y valores del parámetros de regularización, para afinar estos parámetros según validación cruzada o una muestra de validación.\n\nEjemplo (regresión)\n\ndat_grasa <- read_csv(file = '../datos/bodyfat.csv') \nset.seed(183)\ngrasa_particion <- initial_split(dat_grasa, 0.5)\ngrasa_ent <- training(grasa_particion)\ngrasa_pr <- testing(grasa_particion)\nnrow(grasa_ent)\n\n[1] 126\n\n\nUna exploración de este conjunto de datos revela algunos datos sospechosos. En particular un individuo con estatura de 30 pulgadas (alrededor de 75 cm), con peso normal. Probablemente no queremos incluir en entrenamiento este caso, y tampoco hacer predicciones para posibles personas que tengan tales dimensiones:\n\nlibrary(patchwork)\ng_1 <- grasa_ent |> ggplot(aes(x = estatura, y = peso)) + \n geom_point()\ng_2 <- grasa_ent |> ggplot(aes(x = abdomen, y = peso)) + \n geom_point()\ng_1 + g_2\n\n\n\n\n\ngrasa_receta <- recipe(grasacorp ~ ., grasa_ent) |> \n step_filter(estatura > 50) |>\n step_normalize(all_predictors()) |> \n prep()\n\n\nlibrary(keras)\n# entrenamiento\nx_grasa <- grasa_receta |> juice() |> \n select(-grasacorp) |> as.matrix()\nvars_nombres <- colnames(x_grasa)\ny_grasa <- grasa_receta |> juice() |> pull(grasacorp)\n# validación\nx_grasa_pr <- grasa_receta |> bake(grasa_pr) |> \n select(-grasacorp) |> as.matrix()\ny_grasa_pr <- grasa_receta |> bake(grasa_pr) |> pull(grasacorp)\n\n\nmodelo_red <- keras_model_sequential() |> \n layer_dense(units = 50, activation = \"sigmoid\") |> \n layer_dense(units = 50, activation = \"sigmoid\") |> \n layer_dense(units = 1, activation = \"linear\")\nmodelo_red |> compile(\n loss = \"mse\", metrics = \"mse\",\n optimizer = optimizer_sgd(learning_rate = 0.01, momentum = 0.9)\n)\n# esto es más eficiente hacerlo con callbacks en general:\nhistoria <- modelo_red |> fit(\n x = x_grasa, y = y_grasa,\n validation_data = list(x_grasa_pr, y_grasa_pr),\n batch_size = 30, epochs = 250, verbose = 1)\n\nVemos que con esta red podemos alcanzar un error de entrenamiento cercano a cero, aún cuando vemos que sobreajusta al evaluar con la muestra de validación.\n\nplot(historia, smooth = FALSE)\n\n\n\n\nNotamos que las predicciones no son muy buenas:\n\npreds <- predict(modelo_red, x_grasa_pr) \npreds |> head()\n\n [,1]\n[1,] 9.117618\n[2,] 22.663441\n[3,] 8.569652\n[4,] 8.558598\n[5,] 8.842549\n[6,] 8.559493\n\n\nY obtenemos el siguiente resultado:\n\ng_1 <- tibble(preds = preds[, 1], y = y_grasa_pr) |> \n ggplot(aes(x = preds, y = y)) + \n geom_point() + \n geom_abline(slope = 1, intercept = 0, color = \"red\") +\n coord_obs_pred()\ng_1\n\n\n\n\nPodemos ahora experimentar con los parámetros del optimizador, número de unidades, número de capas y regularización L2.\n\nCada cambio de número de unidades/capas o regularización requiere ajustes a la tasa de aprendizaje y otros parámetros del optimizador.\nVarias arquitecturas (número de capas y unidades) pueden dar resultados similares. En este caso, usualmente escogemos el modelo más computacionalmente simple, o dependiendo del tipo de errores de cada modelo.\nRecordamos que una consecuencia del sobreajuste es que el error de prueba es mayor que el de entrenamiento (hay un gap de generalización). Para mejorar el desempeño, podemos reducir el error de entrenamiento (reducir sesgo), y/o reducir sobreajuste (gap entre entrenamiento y prueba).\n\n\nmodelo_red_2 <- keras_model_sequential() |> \n layer_dense(units = 30, activation = \"sigmoid\", \n kernel_regularizer = regularizer_l2(0.1)) |> \n layer_dense(units = 30, activation = \"sigmoid\",\n kernel_regularizer = regularizer_l2(0.1)) |> \n layer_dense(units = 1, activation = \"linear\", \n kernel_regularizer = regularizer_l2(0.01))\nmodelo_red_2 |> compile(loss = \"mse\",metrics = c(\"mse\"),\n optimizer = optimizer_sgd(learning_rate = 0.0005, momentum = 0.95)\n)\n# esto es más eficiente hacerlo con callbacks en general:\nhistoria <- modelo_red_2 |> fit(\n x = x_grasa, y = y_grasa,\n validation_data = list(x_grasa_pr, y_grasa_pr),\n batch_size = 30, epochs = 500, verbose = 1)\n\n\nplot(historia, smooth = FALSE)\n\n\n\n\nLa afinación nos da mejores resultados:\n\npreds_2 <- predict(modelo_red_2, x_grasa_pr) \ng_2 <- tibble(preds_2 = preds_2[, 1], y = y_grasa_pr) |> \n ggplot(aes(x = preds_2, y = y)) + \n geom_point() + \n geom_abline(slope = 1, intercept = 0, color = \"red\") +\n coord_obs_pred()\ng_1 + g_2\n\n\n\n\n\n\nResumen\nEjercicio: En nuestra referencia The Deep Learning Book, puedes revisar la sección 11.4.1 (afinación manual) y 11.4.2 (afinación por búsqueda automática). Explica qué efecto tienen sobre sesgo y sobreajuste los siguientes parámetros:\n\nNúmero de capas\nNúmero de unidades por capa oculta\nRegularización L2 de los pesos\nTasa de aprendizaje (ojo, este parámetro es especial)\n\nEn la parte 2 de redes neuronales veremos más estrategias de regularización, y cómo agregar estructura a redes adaptada a problemas particulares. Notamos para por el momento que las redes neuronales con solamente capas conexas no han sido particularmente exitosas para ningún problema particular. Típicamente requieren una gran cantidad de datos y entrenarlas es más difícil que otros métodos. Sin embargo, la historia es diferente cuando escogemos adecuadamente la arquitectura de la red para un problema dado, es decir, qué unidades están conectadas y bajo qué patrones. En estos casos, las conexiones pueden ser relativamente pocas comparadas con redes totalmente conexas con el mismo tamaño de unidades, y si la estructura es correcta, no incurrimos en mucho sesgo. Ejemplos son procesamiento de imágenes, audio, o lenguaje natural." + "text": "6.7 Ajuste de parámetros (introducción)\nConsideramos la versión con regularización ridge (también llamada L2) de la devianza de entrenamiento como nuestro función objetivo:\n\n\n\n\n\n\nAjuste de redes neuronales\n\n\n\nPara un problema de regresión, ajustamos los pesos \\(\\Theta^{(1)},\\Theta^{(2)},\\ldots, \\Theta^{(L)}\\) de la red intentando minimizar el error cuadrático medio (penalizado) sobre la muestra de entrenamiento: \\[D = -\\frac{1}{2n}\\sum_{i=1}^n (y^{(i)} - f(x^{i}))^2= + \\lambda \\sum_{l=2}^{L} \\sum_{k=1}^{n_{l-1}} \\sum_{j=1}^{n_l}(\\theta_{j,k}^{(l)})^2.\\] Este problema en general no es convexo y puede tener múltiples mínimos.\n\n\nVeremos el proceso de ajuste, selección de arquitectura, etc. más adelante. Por el momento hacemos unas observaciones acerca de este problema de minimización:\n\nHay varios algoritmos para minimizar este error, algunos avanzados incluyendo información de segundo orden (como Newton), pero actualmente las técnicas más populares, para redes grandes, están derivadas de descenso en gradiente. Más específicamente, una variación, que es descenso estocástico.\nQue el algoritmo depende principalmente de multiplicaciones de matrices y acumulaciones implica que puede escalarse de diversas maneras. Una es paralelizando sobre la muestra de entrenamiento (y calcular acumulados al final), pero también se pueden paralelizar las multiplicaciones de matrices (para lo cual los GPUs se prestan muy bien).\nPara redes neuronales, el gradiente se calcula con un algoritmo que se llama back-propagation, que es una aplicación de la regla de la cadena para propagar errores desde la capa de salida a lo largo de todas las capas para ajustar los pesos y sesgos.\nEn estos problemas no buscamos el mínimo global, sino un mínimo local de buen desempeño. Puede haber múltiples mínimos, puntos silla, regiones relativamente planas, precipicios (curvatura alta). Nótese que la simetría implica que podemos obtener la misma red cambiando pesos entre neuronas y las conexiones correspondientes. Esto implica que necesariamente hay varios mínimos.\nTodo esto dificulta el entrenamiento de redes neuronales grandes. Para redes grandes, ni siquiera esperamos a alcanzar un mínimo local, sino que nos a veces detenemos prematuramente cuando obtenemos el mejor desempeño posible.\nPara este problema, no tiene sentido comenzar las iteraciones con todos los pesos igual a cero, pues las unidades de la red son simétricas: no hay nada que distinga una de otra si todos los pesos son iguales. Esto quiere decir que si iteramos, todas las neuronas van a aprender lo mismo.\nEs importante no comenzar valores de los pesos grandes, pues las funciones logísticas pueden quedar en regiones planas donde la minimización es lenta, o podemos tener gradientes demasiado grandes y produzcan inestabilidad en el cálculo del gradiente.\nEl ajuste de la tasa de aprendizaje es un parámetro importante, más delicado que para problemas convexos. Generalmente lo tratamos con un hiperparámetro más que hay que afinar. Tasas demasiado grandes pueden llevarnos a mínimos locales relativamente malos.\nGeneralmente los pesos se inicializan al azar con variables independientes gaussianas o uniformes centradas en cero, y con varianza chica (por ejemplo \\(U(-0.5,0.5)\\)). Una recomendación es usar \\(U(-1/\\sqrt{m}, 1/\\sqrt{m})\\) donde \\(m\\) es el número de entradas. En general, hay que experimentar con este parámetro.\n\nEl proceso para ajustar una red es entonces:\n\nDefinir número de capas ocultas, número de neuronas por cada capa, y un valor del parámetro de regularización. Estandarizar las entradas. Usualmente podemos probar comenzar con una o dos capas ocultas, de tamaño proporcional al número de entradas. Es buena idea comenzar con una red relativamente grande que tienen error bajo de entrenamiento aunque sobreajuste, y después regularizar y refinar su tamaño.\nSeleccionar parámetros al azar para \\(\\Theta^{(2)},\\Theta^{(3)},\\ldots, \\Theta^{(L)}\\). Se toman, por ejemplo, normales con media 0 y varianza chica.\nCorrer un algoritmo de minimización del error mostrada arriba. Es necesario experimentar con los parámetros del algoritmo de minimización.\nVerificar convergencia del algoritmo a un mínimo local (o el algoritmo no está mejorando).\nPredecir usando el modelo ajustado.\n\nFinalmente, podemos probar distintas arquitecturas y valores del parámetros de regularización, para afinar estos parámetros según validación cruzada o una muestra de validación.\n\nEjemplo (regresión)\n\ndat_grasa <- read_csv(file = '../datos/bodyfat.csv') \nset.seed(183)\ngrasa_particion <- initial_split(dat_grasa, 0.5)\ngrasa_ent <- training(grasa_particion)\ngrasa_pr <- testing(grasa_particion)\nnrow(grasa_ent)\n\n[1] 126\n\n\nUna exploración de este conjunto de datos revela algunos datos sospechosos. En particular un individuo con estatura de 30 pulgadas (alrededor de 75 cm), con peso normal. Probablemente no queremos incluir en entrenamiento este caso, y tampoco hacer predicciones para posibles personas que tengan tales dimensiones:\n\nlibrary(patchwork)\ng_1 <- grasa_ent |> ggplot(aes(x = estatura, y = peso)) + \n geom_point()\ng_2 <- grasa_ent |> ggplot(aes(x = abdomen, y = peso)) + \n geom_point()\ng_1 + g_2\n\n\n\n\n\ngrasa_receta <- recipe(grasacorp ~ ., grasa_ent) |> \n step_filter(estatura > 50) |>\n step_normalize(all_predictors()) |> \n prep()\n\n\nlibrary(keras)\n# entrenamiento\nx_grasa <- grasa_receta |> juice() |> \n select(-grasacorp) |> as.matrix()\nvars_nombres <- colnames(x_grasa)\ny_grasa <- grasa_receta |> juice() |> pull(grasacorp)\n# validación\nx_grasa_pr <- grasa_receta |> bake(grasa_pr) |> \n select(-grasacorp) |> as.matrix()\ny_grasa_pr <- grasa_receta |> bake(grasa_pr) |> pull(grasacorp)\n\n\nmodelo_red <- keras_model_sequential() |> \n layer_dense(units = 50, activation = \"sigmoid\") |> \n layer_dense(units = 50, activation = \"sigmoid\") |> \n layer_dense(units = 1, activation = \"linear\")\nmodelo_red |> compile(\n loss = \"mse\", metrics = \"mse\",\n optimizer = optimizer_sgd(learning_rate = 0.01, momentum = 0.9)\n)\n# esto es más eficiente hacerlo con callbacks en general:\nhistoria <- modelo_red |> fit(\n x = x_grasa, y = y_grasa,\n validation_data = list(x_grasa_pr, y_grasa_pr),\n batch_size = 30, epochs = 250, verbose = 1)\n\nVemos que con esta red podemos alcanzar un error de entrenamiento cercano a cero, aún cuando vemos que sobreajusta al evaluar con la muestra de validación.\n\nplot(historia, smooth = FALSE)\n\n\n\n\nNotamos que las predicciones no son muy buenas:\n\npreds <- predict(modelo_red, x_grasa_pr) \npreds |> head()\n\n [,1]\n[1,] 9.117623\n[2,] 22.663464\n[3,] 8.569628\n[4,] 8.558584\n[5,] 8.842519\n[6,] 8.559466\n\n\nY obtenemos el siguiente resultado:\n\ng_1 <- tibble(preds = preds[, 1], y = y_grasa_pr) |> \n ggplot(aes(x = preds, y = y)) + \n geom_point() + \n geom_abline(slope = 1, intercept = 0, color = \"red\") +\n coord_obs_pred()\ng_1\n\n\n\n\nPodemos ahora experimentar con los parámetros del optimizador, número de unidades, número de capas y regularización L2.\n\nCada cambio de número de unidades/capas o regularización requiere ajustes a la tasa de aprendizaje y otros parámetros del optimizador.\nVarias arquitecturas (número de capas y unidades) pueden dar resultados similares. En este caso, usualmente escogemos el modelo más computacionalmente simple, o dependiendo del tipo de errores de cada modelo.\nRecordamos que una consecuencia del sobreajuste es que el error de prueba es mayor que el de entrenamiento (hay un gap de generalización). Para mejorar el desempeño, podemos reducir el error de entrenamiento (reducir sesgo), y/o reducir sobreajuste (gap entre entrenamiento y prueba).\n\n\nmodelo_red_2 <- keras_model_sequential() |> \n layer_dense(units = 30, activation = \"sigmoid\", \n kernel_regularizer = regularizer_l2(0.1)) |> \n layer_dense(units = 30, activation = \"sigmoid\",\n kernel_regularizer = regularizer_l2(0.1)) |> \n layer_dense(units = 1, activation = \"linear\", \n kernel_regularizer = regularizer_l2(0.01))\nmodelo_red_2 |> compile(loss = \"mse\",metrics = c(\"mse\"),\n optimizer = optimizer_sgd(learning_rate = 0.0005, momentum = 0.95)\n)\n# esto es más eficiente hacerlo con callbacks en general:\nhistoria <- modelo_red_2 |> fit(\n x = x_grasa, y = y_grasa,\n validation_data = list(x_grasa_pr, y_grasa_pr),\n batch_size = 30, epochs = 500, verbose = 1)\n\n\nplot(historia, smooth = FALSE)\n\n\n\n\nLa afinación nos da mejores resultados:\n\npreds_2 <- predict(modelo_red_2, x_grasa_pr) \ng_2 <- tibble(preds_2 = preds_2[, 1], y = y_grasa_pr) |> \n ggplot(aes(x = preds_2, y = y)) + \n geom_point() + \n geom_abline(slope = 1, intercept = 0, color = \"red\") +\n coord_obs_pred()\ng_1 + g_2\n\n\n\n\n\n\nResumen\nEjercicio: En nuestra referencia The Deep Learning Book, puedes revisar la sección 11.4.1 (afinación manual) y 11.4.2 (afinación por búsqueda automática). Explica qué efecto tienen sobre sesgo y sobreajuste los siguientes parámetros:\n\nNúmero de capas\nNúmero de unidades por capa oculta\nRegularización L2 de los pesos\nTasa de aprendizaje (ojo, este parámetro es especial)\n\nEn la parte 2 de redes neuronales veremos más estrategias de regularización, y cómo agregar estructura a redes adaptada a problemas particulares. Notamos para por el momento que las redes neuronales con solamente capas conexas no han sido particularmente exitosas para ningún problema particular. Típicamente requieren una gran cantidad de datos y entrenarlas es más difícil que otros métodos. Sin embargo, la historia es diferente cuando escogemos adecuadamente la arquitectura de la red para un problema dado, es decir, qué unidades están conectadas y bajo qué patrones. En estos casos, las conexiones pueden ser relativamente pocas comparadas con redes totalmente conexas con el mismo tamaño de unidades, y si la estructura es correcta, no incurrimos en mucho sesgo. Ejemplos son procesamiento de imágenes, audio, o lenguaje natural." }, { "objectID": "07-intervalos-predictivos.html#inferencia-predictiva-conforme", @@ -361,7 +361,7 @@ "href": "08-clasificacion-1.html#ejercicio-datos-de-diabetes", "title": "8  Clasificación y probabilidad", "section": "8.8 Ejercicio: datos de diabetes", - "text": "8.8 Ejercicio: datos de diabetes\nYa están divididos los datos en entrenamiento y prueba\n\ndiabetes_ent <- as_tibble(MASS::Pima.tr)\ndiabetes_pr <- as_tibble(MASS::Pima.te)\ndiabetes_ent |> head() |> gt()\n\n\n\n\n\n \n \n \n npreg\n glu\n bp\n skin\n bmi\n ped\n age\n type\n \n \n \n 5\n86\n68\n28\n30.2\n0.364\n24\nNo\n 7\n195\n70\n33\n25.1\n0.163\n55\nYes\n 5\n77\n82\n41\n35.8\n0.156\n35\nNo\n 0\n165\n76\n43\n47.9\n0.259\n26\nNo\n 0\n107\n60\n25\n26.4\n0.133\n23\nNo\n 5\n97\n76\n27\n35.6\n0.378\n52\nYes\n \n \n \n\n\n\ndiabetes_ent$id <- 1:nrow(diabetes_ent)\ndiabetes_pr$id <- 1:nrow(diabetes_pr)\n\nAunque no es necesario, podemos normalizar:\n\nreceta_diabetes <- recipe(type ~ ., diabetes_ent) |>\n update_role(id, new_role = \"id_variable\") |> \n step_normalize(all_numeric()) \ndiabetes_ent_s <- receta_diabetes |> prep() |> juice() \ndiabetes_pr_s <- receta_diabetes |> prep() |> bake(diabetes_pr)\n\n\nmodelo_lineal <- logistic_reg(mode = \"classification\") |> \n set_engine(\"glm\")\nflujo_diabetes <- workflow() |> \n add_model(modelo_lineal) |> \n add_recipe(receta_diabetes)\nflujo_ajustado <- fit(flujo_diabetes, diabetes_ent)\nsaveRDS(flujo_ajustado, \"cache/flujo_ajustado_diabetes.rds\")\nflujo_ajustado\n\n══ Workflow [trained] ══════════════════════════════════════════════════════════\nPreprocessor: Recipe\nModel: logistic_reg()\n\n── Preprocessor ────────────────────────────────────────────────────────────────\n1 Recipe Step\n\n• step_normalize()\n\n── Model ───────────────────────────────────────────────────────────────────────\n\nCall: stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)\n\nCoefficients:\n(Intercept) npreg glu bp skin bmi \n -0.95583 0.34734 1.01705 -0.05473 -0.02247 0.51263 \n ped age \n 0.55928 0.45201 \n\nDegrees of Freedom: 199 Total (i.e. Null); 192 Residual\nNull Deviance: 256.4 \nResidual Deviance: 178.4 AIC: 194.4\n\n\nAhora calculamos devianza de prueba y error de clasificación:\n\npreds_prueba <- \n predict(flujo_ajustado, diabetes_pr, type= \"prob\") |> \n bind_cols(predict(flujo_ajustado, diabetes_pr)) |> \n bind_cols(diabetes_pr |> select(type))\npreds_prueba\n\n# A tibble: 332 × 4\n .pred_No .pred_Yes .pred_class type \n <dbl> <dbl> <fct> <fct>\n 1 0.232 0.768 Yes Yes \n 2 0.960 0.0403 No No \n 3 0.975 0.0253 No No \n 4 0.959 0.0413 No Yes \n 5 0.204 0.796 Yes Yes \n 6 0.265 0.735 Yes Yes \n 7 0.590 0.410 No Yes \n 8 0.780 0.220 No No \n 9 0.558 0.442 No No \n10 0.798 0.202 No Yes \n# ℹ 322 more rows\n\n\n\nlevels(preds_prueba$type)\n\n[1] \"No\" \"Yes\"\n\n# ponemos event_level si \"positivo\" no es el primer factor\nmetricas <- metric_set(accuracy, mn_log_loss)\nmetricas(preds_prueba, truth = type, .pred_Yes, estimate = .pred_class, \n event_level = \"second\")\n\n# A tibble: 2 × 3\n .metric .estimator .estimate\n <chr> <chr> <dbl>\n1 accuracy binary 0.801\n2 mn_log_loss binary 0.441\n\n\nVamos a repetir usando keras.\n\nlibrary(keras)\nx_ent <- diabetes_ent_s |> select(-type, -id) |> as.matrix()\ny_ent <- diabetes_ent_s$type == \"Yes\"\nx_prueba <- diabetes_pr_s |> select(-type, -id) |> as.matrix()\ny_prueba <- diabetes_pr_s$type == 'Yes'\n# definición de estructura del modelo (regresión logística)\n# es posible hacerlo con workflows como vimos arriba, \n# pero aquí usamos directamente la interfaz de keras en R\nn_entrena <- nrow(x_ent)\nmodelo_diabetes <- keras_model_sequential() |>\n layer_dense(units = 1, #una sola respuesta,\n activation = \"sigmoid\", # combinar variables linealmente y aplicar función logística\n kernel_initializer = initializer_constant(0), #inicializamos coeficientes en 0\n bias_initializer = initializer_constant(0)) #inicializamos ordenada en 0\n# compilar seleccionando cantidad a minimizar, optimizador y métricas\nmodelo_diabetes |> compile(\n loss = \"binary_crossentropy\", # devianza es entropía cruzada\n optimizer = optimizer_sgd(learning_rate = 0.75), # descenso en gradiente\n metrics = list(\"binary_crossentropy\"))\n# Ahora iteramos\n# Primero probamos con un número bajo de iteraciones\nhistoria <- modelo_diabetes |> fit(\n as.matrix(x_ent), # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 10 # número de iteraciones\n)\nplot(historia)\n\n\n\n\nY ahora podemos correr más iteraciones adicionales:\n\nhistoria <- modelo_diabetes |> fit(\n as.matrix(x_ent), # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 1000, # número de iteraciones\n verbose = 0\n)\n\nLos errores de entrenamiento y prueba son:\n\nevaluate(modelo_diabetes, x_ent, y_ent)\n\n loss binary_crossentropy \n 0.4459766 0.4459766 \n\n\n\nevaluate(modelo_diabetes, x_prueba, y_prueba)\n\n loss binary_crossentropy \n 0.4406986 0.4406986 \n\n\nVeamos que coeficientes obtuvimos:\n\nget_weights(modelo_diabetes)\n\n[[1]]\n [,1]\n[1,] 0.34734306\n[2,] 1.01705003\n[3,] -0.05472933\n[4,] -0.02247144\n[5,] 0.51263183\n[6,] 0.55927497\n[7,] 0.45200703\n\n[[2]]\n[1] -0.9558302\n\n\nque coinciden con los valores que obtuvimos usando regresión logística de glm. La única diferencia es que el algoritmo de optimización que se usa en cada caso es diferente: con keras utilizamos descenso en gradiente, mientras que glm usa Newton-Raphson.\n\nflujo_ajustado |> extract_fit_parsnip()\n\nparsnip model object\n\n\nCall: stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)\n\nCoefficients:\n(Intercept) npreg glu bp skin bmi \n -0.95583 0.34734 1.01705 -0.05473 -0.02247 0.51263 \n ped age \n 0.55928 0.45201 \n\nDegrees of Freedom: 199 Total (i.e. Null); 192 Residual\nNull Deviance: 256.4 \nResidual Deviance: 178.4 AIC: 194.4" + "text": "8.8 Ejercicio: datos de diabetes\nYa están divididos los datos en entrenamiento y prueba\n\ndiabetes_ent <- as_tibble(MASS::Pima.tr)\ndiabetes_pr <- as_tibble(MASS::Pima.te)\ndiabetes_ent |> head() |> gt()\n\n\n\n\n\n \n \n \n npreg\n glu\n bp\n skin\n bmi\n ped\n age\n type\n \n \n \n 5\n86\n68\n28\n30.2\n0.364\n24\nNo\n 7\n195\n70\n33\n25.1\n0.163\n55\nYes\n 5\n77\n82\n41\n35.8\n0.156\n35\nNo\n 0\n165\n76\n43\n47.9\n0.259\n26\nNo\n 0\n107\n60\n25\n26.4\n0.133\n23\nNo\n 5\n97\n76\n27\n35.6\n0.378\n52\nYes\n \n \n \n\n\n\ndiabetes_ent$id <- 1:nrow(diabetes_ent)\ndiabetes_pr$id <- 1:nrow(diabetes_pr)\n\nAunque no es necesario, podemos normalizar:\n\nreceta_diabetes <- recipe(type ~ ., diabetes_ent) |>\n update_role(id, new_role = \"id_variable\") |> \n step_normalize(all_numeric()) \ndiabetes_ent_s <- receta_diabetes |> prep() |> juice() \ndiabetes_pr_s <- receta_diabetes |> prep() |> bake(diabetes_pr)\n\n\nmodelo_lineal <- logistic_reg(mode = \"classification\") |> \n set_engine(\"glm\")\nflujo_diabetes <- workflow() |> \n add_model(modelo_lineal) |> \n add_recipe(receta_diabetes)\nflujo_ajustado <- fit(flujo_diabetes, diabetes_ent)\nsaveRDS(flujo_ajustado, \"cache/flujo_ajustado_diabetes.rds\")\nflujo_ajustado\n\n══ Workflow [trained] ══════════════════════════════════════════════════════════\nPreprocessor: Recipe\nModel: logistic_reg()\n\n── Preprocessor ────────────────────────────────────────────────────────────────\n1 Recipe Step\n\n• step_normalize()\n\n── Model ───────────────────────────────────────────────────────────────────────\n\nCall: stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)\n\nCoefficients:\n(Intercept) npreg glu bp skin bmi \n -0.95583 0.34734 1.01705 -0.05473 -0.02247 0.51263 \n ped age \n 0.55928 0.45201 \n\nDegrees of Freedom: 199 Total (i.e. Null); 192 Residual\nNull Deviance: 256.4 \nResidual Deviance: 178.4 AIC: 194.4\n\n\nAhora calculamos devianza de prueba y error de clasificación:\n\npreds_prueba <- \n predict(flujo_ajustado, diabetes_pr, type= \"prob\") |> \n bind_cols(predict(flujo_ajustado, diabetes_pr)) |> \n bind_cols(diabetes_pr |> select(type))\npreds_prueba\n\n# A tibble: 332 × 4\n .pred_No .pred_Yes .pred_class type \n <dbl> <dbl> <fct> <fct>\n 1 0.232 0.768 Yes Yes \n 2 0.960 0.0403 No No \n 3 0.975 0.0253 No No \n 4 0.959 0.0413 No Yes \n 5 0.204 0.796 Yes Yes \n 6 0.265 0.735 Yes Yes \n 7 0.590 0.410 No Yes \n 8 0.780 0.220 No No \n 9 0.558 0.442 No No \n10 0.798 0.202 No Yes \n# ℹ 322 more rows\n\n\n\nlevels(preds_prueba$type)\n\n[1] \"No\" \"Yes\"\n\n# ponemos event_level si \"positivo\" no es el primer factor\nmetricas <- metric_set(accuracy, mn_log_loss)\nmetricas(preds_prueba, truth = type, .pred_Yes, estimate = .pred_class, \n event_level = \"second\")\n\n# A tibble: 2 × 3\n .metric .estimator .estimate\n <chr> <chr> <dbl>\n1 accuracy binary 0.801\n2 mn_log_loss binary 0.441\n\n\nVamos a repetir usando keras.\n\nlibrary(keras)\nx_ent <- diabetes_ent_s |> select(-type, -id) |> as.matrix()\ny_ent <- diabetes_ent_s$type == \"Yes\"\nx_prueba <- diabetes_pr_s |> select(-type, -id) |> as.matrix()\ny_prueba <- diabetes_pr_s$type == 'Yes'\n# definición de estructura del modelo (regresión logística)\n# es posible hacerlo con workflows como vimos arriba, \n# pero aquí usamos directamente la interfaz de keras en R\nn_entrena <- nrow(x_ent)\nmodelo_diabetes <- keras_model_sequential() |>\n layer_dense(units = 1, #una sola respuesta,\n activation = \"sigmoid\", # combinar variables linealmente y aplicar función logística\n kernel_initializer = initializer_constant(0), #inicializamos coeficientes en 0\n bias_initializer = initializer_constant(0)) #inicializamos ordenada en 0\n# compilar seleccionando cantidad a minimizar, optimizador y métricas\nmodelo_diabetes |> compile(\n loss = \"binary_crossentropy\", # devianza es entropía cruzada\n optimizer = optimizer_sgd(learning_rate = 0.75), # descenso en gradiente\n metrics = list(\"binary_crossentropy\"))\n# Ahora iteramos\n# Primero probamos con un número bajo de iteraciones\nhistoria <- modelo_diabetes |> fit(\n as.matrix(x_ent), # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 10 # número de iteraciones\n)\nplot(historia)\n\n\n\n\nY ahora podemos correr más iteraciones adicionales:\n\nhistoria <- modelo_diabetes |> fit(\n as.matrix(x_ent), # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 1000, # número de iteraciones\n verbose = 0\n)\n\nLos errores de entrenamiento y prueba son:\n\nevaluate(modelo_diabetes, x_ent, y_ent)\n\n loss binary_crossentropy \n 0.4459766 0.4459766 \n\n\n\nevaluate(modelo_diabetes, x_prueba, y_prueba)\n\n loss binary_crossentropy \n 0.4406986 0.4406986 \n\n\nVeamos que coeficientes obtuvimos:\n\nget_weights(modelo_diabetes)\n\n[[1]]\n [,1]\n[1,] 0.34734306\n[2,] 1.01705003\n[3,] -0.05472932\n[4,] -0.02247145\n[5,] 0.51263183\n[6,] 0.55927497\n[7,] 0.45200700\n\n[[2]]\n[1] -0.9558301\n\n\nque coinciden con los valores que obtuvimos usando regresión logística de glm. La única diferencia es que el algoritmo de optimización que se usa en cada caso es diferente: con keras utilizamos descenso en gradiente, mientras que glm usa Newton-Raphson.\n\nflujo_ajustado |> extract_fit_parsnip()\n\nparsnip model object\n\n\nCall: stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)\n\nCoefficients:\n(Intercept) npreg glu bp skin bmi \n -0.95583 0.34734 1.01705 -0.05473 -0.02247 0.51263 \n ped age \n 0.55928 0.45201 \n\nDegrees of Freedom: 199 Total (i.e. Null); 192 Residual\nNull Deviance: 256.4 \nResidual Deviance: 178.4 AIC: 194.4" }, { "objectID": "08-clasificacion-1.html#probabilidades-y-pérdida-0-1", @@ -417,7 +417,7 @@ "href": "09-clasificacion-2.html#perfil-de-un-clasificador-binario-y-curvas-roc", "title": "9  Decisiones de clasificación", "section": "9.5 Perfil de un clasificador binario y curvas ROC", - "text": "9.5 Perfil de un clasificador binario y curvas ROC\nEn lugar de examinar cada punto de corte por separado, podemos hacer el análisis de todos los posibles puntos de corte mediante la curva ROC (receiver operating characteristic, de ingeniería).\n\n\n\n\n\n\nTip\n\n\n\nPara un problema de clasificación binaria, dadas estimaciones \\(\\hat{p}_1(x)\\), la curva ROC grafica todos los pares de (1-especificidad, sensibilidad) para cada posible punto de corte \\(\\hat{p}_1(x) > \\alpha\\).\n\n\n\nEjemplo\n\nroc_tbl <- roc_curve(preds_prueba, \n truth = type, .pred_Yes)\nroc_tbl\n\n# A tibble: 321 × 3\n .threshold specificity sensitivity\n <dbl> <dbl> <dbl>\n 1 -Inf 0 1\n 2 0.00305 0 1\n 3 0.00346 0.00448 1\n 4 0.00407 0.00897 1\n 5 0.00437 0.0135 1\n 6 0.00476 0.0224 1\n 7 0.00486 0.0269 1\n 8 0.00504 0.0314 1\n 9 0.00512 0.0359 1\n10 0.00562 0.0404 1\n# ℹ 311 more rows\n\nggplot(roc_tbl, \n aes(x = 1 - specificity, y = sensitivity)) +\n geom_path(aes(colour = .threshold), size = 1.2) +\n geom_abline(colour = \"gray\") + \n coord_equal() +\n xlab(\"Tasa de falsos positivos\") + \n ylab(\"Sensibilidad\")\n\nWarning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.\nℹ Please use `linewidth` instead.\n\n\n\n\n\nEn esta gráfica podemos ver todos los clasificadores posibles basados en las probabilidades de clase. Podemos usar estas curvas como evaluación de nuestros clasificadores, dejando para más tarde la selección del punto de corte, si esto es necesario (por ejemplo, dependiendo de los costos de cada tipo de error).\nTambién podemos definir una medida resumen del desempeño de un clasificador según esta curva:\n\n\n\n\n\n\nTip\n\n\n\nLa medida AUC (area under the curve) para un clasificador es el área bajo la curva generada por los pares sensibilidad-especificidad de la curva ROC.\n\n\n\nroc_auc(preds_prueba, type, .pred_Yes)\n\n# A tibble: 1 × 3\n .metric .estimator .estimate\n <chr> <chr> <dbl>\n1 roc_auc binary 0.761\n\n\nCuanto más cerca de uno es este valor, mejor discriminan las probabilidades.\nTambién es útil para comparar modelos. Consideremos el modelo de los datos de diabetes que incluyen todas las variables:\n\nmod_2 <- logistic_reg() |> \n set_engine(\"keras\") |> \n set_mode(\"classification\") |>\n set_args(epochs = 250, \n optimizer = optimizer_sgd(lr = 0.3),\n batch_size = nrow(diabetes_ent), \n verbose = FALSE) |> \n fit(type ~ ., juice(receta_diabetes))\npreds_prueba_completo <- predict(\n mod_2, prueba_baked, type ='prob') |> \n bind_cols(prueba_baked)\npreds_prueba_2 <- bind_rows(\n preds_prueba |> mutate(modelo = \"IMC y edad\"),\n preds_prueba_completo |> mutate(modelo = \"Todas\")) |> \n group_by(modelo)\n\nY graficamos juntas:\n\nroc_2_tbl <- roc_curve(preds_prueba_2, type, .pred_Yes)\nggplot(roc_2_tbl, aes(x = 1 - specificity, y = sensitivity)) +\n geom_path(aes(colour = modelo), size = 1.2) +\n geom_abline(colour = \"gray\") + \n coord_equal() +\n xlab(\"Tasa de falsos positivos\") + \n ylab(\"Sensibilidad\")\n\n\n\n\nComparación auc:\n\nroc_auc(preds_prueba_2, type, .pred_Yes) \n\n# A tibble: 2 × 4\n modelo .metric .estimator .estimate\n <chr> <chr> <chr> <dbl>\n1 IMC y edad roc_auc binary 0.761\n2 Todas roc_auc binary 0.865\n\n\nEn este ejemplo, vemos que casi no importa qué perfil de especificidad y sensibilidad busquemos: el clasificador que usa todas las variables domina casi siempre al clasificador que sólo utiliza IMC y edad." + "text": "9.5 Perfil de un clasificador binario y curvas ROC\nEn lugar de examinar cada punto de corte por separado, podemos hacer el análisis de todos los posibles puntos de corte mediante la curva ROC (receiver operating characteristic, de ingeniería).\n\n\n\n\n\n\nTip\n\n\n\nPara un problema de clasificación binaria, dadas estimaciones \\(\\hat{p}_1(x)\\), la curva ROC grafica todos los pares de (1-especificidad, sensibilidad) para cada posible punto de corte \\(\\hat{p}_1(x) > \\alpha\\).\n\n\n\nEjemplo\n\nroc_tbl <- roc_curve(preds_prueba, \n truth = type, .pred_Yes)\nroc_tbl\n\n# A tibble: 321 × 3\n .threshold specificity sensitivity\n <dbl> <dbl> <dbl>\n 1 -Inf 0 1\n 2 0.00305 0 1\n 3 0.00345 0.00448 1\n 4 0.00406 0.00897 1\n 5 0.00437 0.0135 1\n 6 0.00476 0.0224 1\n 7 0.00486 0.0269 1\n 8 0.00504 0.0314 1\n 9 0.00512 0.0359 1\n10 0.00562 0.0404 1\n# ℹ 311 more rows\n\nggplot(roc_tbl, \n aes(x = 1 - specificity, y = sensitivity)) +\n geom_path(aes(colour = .threshold), size = 1.2) +\n geom_abline(colour = \"gray\") + \n coord_equal() +\n xlab(\"Tasa de falsos positivos\") + \n ylab(\"Sensibilidad\")\n\nWarning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.\nℹ Please use `linewidth` instead.\n\n\n\n\n\nEn esta gráfica podemos ver todos los clasificadores posibles basados en las probabilidades de clase. Podemos usar estas curvas como evaluación de nuestros clasificadores, dejando para más tarde la selección del punto de corte, si esto es necesario (por ejemplo, dependiendo de los costos de cada tipo de error).\nTambién podemos definir una medida resumen del desempeño de un clasificador según esta curva:\n\n\n\n\n\n\nTip\n\n\n\nLa medida AUC (area under the curve) para un clasificador es el área bajo la curva generada por los pares sensibilidad-especificidad de la curva ROC.\n\n\n\nroc_auc(preds_prueba, type, .pred_Yes)\n\n# A tibble: 1 × 3\n .metric .estimator .estimate\n <chr> <chr> <dbl>\n1 roc_auc binary 0.761\n\n\nCuanto más cerca de uno es este valor, mejor discriminan las probabilidades.\nTambién es útil para comparar modelos. Consideremos el modelo de los datos de diabetes que incluyen todas las variables:\n\nmod_2 <- logistic_reg() |> \n set_engine(\"keras\") |> \n set_mode(\"classification\") |>\n set_args(epochs = 250, \n optimizer = optimizer_sgd(lr = 0.3),\n batch_size = nrow(diabetes_ent), \n verbose = FALSE) |> \n fit(type ~ ., juice(receta_diabetes))\npreds_prueba_completo <- predict(\n mod_2, prueba_baked, type ='prob') |> \n bind_cols(prueba_baked)\npreds_prueba_2 <- bind_rows(\n preds_prueba |> mutate(modelo = \"IMC y edad\"),\n preds_prueba_completo |> mutate(modelo = \"Todas\")) |> \n group_by(modelo)\n\nY graficamos juntas:\n\nroc_2_tbl <- roc_curve(preds_prueba_2, type, .pred_Yes)\nggplot(roc_2_tbl, aes(x = 1 - specificity, y = sensitivity)) +\n geom_path(aes(colour = modelo), size = 1.2) +\n geom_abline(colour = \"gray\") + \n coord_equal() +\n xlab(\"Tasa de falsos positivos\") + \n ylab(\"Sensibilidad\")\n\n\n\n\nComparación auc:\n\nroc_auc(preds_prueba_2, type, .pred_Yes) \n\n# A tibble: 2 × 4\n modelo .metric .estimator .estimate\n <chr> <chr> <chr> <dbl>\n1 IMC y edad roc_auc binary 0.761\n2 Todas roc_auc binary 0.866\n\n\nEn este ejemplo, vemos que casi no importa qué perfil de especificidad y sensibilidad busquemos: el clasificador que usa todas las variables domina casi siempre al clasificador que sólo utiliza IMC y edad." }, { "objectID": "09-clasificacion-2.html#curvas-de-precisión-sensibilidad", @@ -436,35 +436,35 @@ { "objectID": "10-clasificacion-calibracion.html#calibración-de-probabilidades", "href": "10-clasificacion-calibracion.html#calibración-de-probabilidades", - "title": "10  Incertidumbre en clasificación", + "title": "10  Calibración de probabilidades", "section": "10.1 Calibración de probabilidades", "text": "10.1 Calibración de probabilidades\nEn un principio podemos considerar las probabilidades estimadas en nuestros predictores como scores que califican qué tan creíble es que una observación particular sea de una categoría o clase dada. Sin embargo, quisiéramos interpretarlas también de manera frecuentista, como frecuencia relativa de ocurrencia de eventos a largo plazo. Esto nos permite utilizarlas en procesos downstream y en la toma de decisiones de manera más efectiva.\nPor ejemplo, en pronósticos meteorológicos, todos los días expresan una probabilidad de lluvia. Resulta ser que entre aquellos días donde los metereológos dicen que hay 10% de lluvia, en 1 de cada 10 llueve en realidad. Entre aquellos días donde dicen que hay 90% de probabilidad de lluvia, aproximadamente 9 de cada 10 días llueve. Esto quiere decir que estos pronósticos probabilísticos de la meteorología están bien calibrados, independientemente de nuestra interpretación de esas probabilidades como grados de creencia.\nIgual que buscábamos que nuestros intervalos predictivos estuvieran bien calibrados en los problemas de regresión, también buscamos que nuestras predictores en clasificación estén probabilísticamente bien calibrados. Es decir: lo que decimos que puede ocurrir con 10% de probabilidad ocurre efectivamente 1 de cada 10 veces, si decimos 20% entonces ocurre 2 de 20, etc.\nPodemos hacer esto realizando pruebas de la calibración de las probabilidades que arroja el modelo. Esto quiere decir que si el modelo nos dice que la probabilidad de que la clase 1 es 0.8, entonces si tenemos un número grande de estos casos (con probabilidad 0.8), alrededor de 80% de éstos tienen que ser positivos.\n\nEjemplo: diabetes\nPodemos checar la calibración de nuestro modelo para el ejemplo de diabetes de la sección anterior\n\nlibrary(tidyverse)\nlibrary(tidymodels)\nlibrary(gt)\ndiabetes_pr <- as_tibble(MASS::Pima.te)\ndiabetes_pr$id <- 1:nrow(diabetes_pr)\nflujo_diabetes <- read_rds(\"cache/flujo_ajustado_diabetes.rds\")\n\nAquí están las probabilidades estimadas de tener diabetes sobre la muestra de prueba:\n\nproba_mod <- predict(flujo_diabetes, diabetes_pr, type = \"prob\")\ndat_calibracion <- tibble(obs = diabetes_pr |> pull(type), \n probabilidad = proba_mod$.pred_Yes) |> \n mutate(y = ifelse(obs == \"Yes\", 1, 0))\ndat_calibracion |> head() |> gt()\n\n\n\n\n\n \n \n \n obs\n probabilidad\n y\n \n \n \n Yes\n0.76840395\n1\n No\n0.04030505\n0\n No\n0.02529504\n0\n Yes\n0.04134683\n1\n Yes\n0.79595860\n1\n Yes\n0.73516870\n1\n \n \n \n\n\n\n\nPara ver si estas probabilidades son realistas, podemos por ejemplo hacer una gráfica como la que sigue:\n\nggplot(dat_calibracion, aes(x = probabilidad, y = y)) + \n geom_jitter(width = 0, height = 0.02, alpha = 0.2) +\n geom_smooth(method = \"loess\", span = 0.7, colour = \"red\", se = FALSE) + \n geom_abline() +\n coord_equal()\n\n`geom_smooth()` using formula = 'y ~ x'\n\n\n\n\n\nY en esta gráfica verificamos que los promedios locales de proporciones de 0-1’s son consistentes con las probabilidades que estimamos." }, { "objectID": "10-clasificacion-calibracion.html#gráficas-de-calibración-binaria", "href": "10-clasificacion-calibracion.html#gráficas-de-calibración-binaria", - "title": "10  Incertidumbre en clasificación", + "title": "10  Calibración de probabilidades", "section": "10.2 Gráficas de calibración binaria", "text": "10.2 Gráficas de calibración binaria\nOtra manera de hacer esta gráfica es cortando las probabilidades en cubetas y calculando intervalos de credibilidad para cada estimación: con esto checamos si el observado es consistente con las probabilidades de clase.\n\n\n\n\n\n\nPruebas de calibración\n\n\n\nSobre una muestra de prueba y para un problema de clasificación binaria, donde \\(\\hat{p} (x)\\) es la probabilidad estimada de la clase 1:\n\nProducimos las probabilidades de clase \\(\\hat{p}(\\mathbf{x}^{(i)}).\\)\nOrdenamos estas probabilidades de clase de la más grande a la más chica, y las agrupamos en cubetas \\(C_1, C_2, \\ldots, C_r\\).\nCalculamos en cada cubeta la probabilidad de clase promedio y el porcentaje de casos de clase 1.\n\nSi en cada cubeta la probabilidad de clase promedio y el porcentaje de casos de clase 1 son consistentes (similares módulo variación muestral), entonces decimos que nuestras probabilidades pasan esta prueba de calibración.\n\n\n\nEjemplo: diabetes\n\n# usamos intervalos suavizados (bayesiano beta-binomial) en lugar de los basados\n# en los errores estándar sqrt(p*(1-p) / n)\ncalibracion_gpos <- dat_calibracion |> \n mutate(proba_grupo = cut(probabilidad, \n quantile(probabilidad, seq(0, 1, 0.1)), include.lowest = TRUE)) |> \n group_by(proba_grupo) |> \n summarise(prob_media = mean(probabilidad), \n n = n(),\n obs = sum(y), .groups = \"drop\") |> \n mutate(obs_prop = (obs + 1) / (n + 2), \n inferior = qbeta(0.05, obs + 1, n - obs + 2),\n superior = qbeta(0.95, obs + 1, n - obs + 2))\ncalibracion_gpos |> gt() |> fmt_number(where(is_double), decimals = 3)\n\n\n\n\n\n \n \n \n proba_grupo\n prob_media\n n\n obs\n obs_prop\n inferior\n superior\n \n \n \n [0.00988,0.0412]\n0.029\n34\n0.000\n0.028\n0.001\n0.080\n (0.0412,0.0714]\n0.057\n33\n1.000\n0.057\n0.010\n0.129\n (0.0714,0.114]\n0.094\n33\n1.000\n0.057\n0.010\n0.129\n (0.114,0.158]\n0.136\n33\n6.000\n0.200\n0.098\n0.311\n (0.158,0.224]\n0.191\n33\n4.000\n0.143\n0.058\n0.243\n (0.224,0.334]\n0.276\n33\n12.000\n0.371\n0.236\n0.496\n (0.334,0.454]\n0.399\n33\n14.000\n0.429\n0.286\n0.553\n (0.454,0.65]\n0.548\n33\n17.000\n0.514\n0.365\n0.635\n (0.65,0.805]\n0.733\n33\n24.000\n0.714\n0.564\n0.813\n (0.805,0.997]\n0.901\n34\n30.000\n0.861\n0.730\n0.925\n \n \n \n\n\n\n\n\nggplot(calibracion_gpos, \n aes(x = prob_media, y = obs_prop, ymin = inferior, ymax = superior)) +\n geom_abline() +\n geom_linerange() +\n geom_point(colour = \"red\") + coord_equal() +\n xlab(\"Probabilidad de clase\") +\n ylab(\"Proporción observada\") +\n labs(subtitle = \"Intervalos de 90% para prop observada\")\n\n\n\n\nY con esto verificamos que calibración del modelo es razonable, y que es razonable usar estas probabilidades para tomar decisiones o incluir en ejercicios de simulación.\nObservación: 1. Si las probabilidades no están calibradas, y las queremos utilizar como tales (no simplemente como scores), entonces puede ser necesario hacer un paso adicional de calibración, con una muestra separada de calibración (ver por ejemplo Kuhn y Johnson (2013), sección 11.1). 2. En este ejemplo construimos intervalos para las proporciones observadas usando intervalos bayesianos. Es posible usar intervalos normales o t (usando el error estándar), pero estos intervalos tienen cobertura mala para proporciones muy chicas o muy grandes Binomial proportion wikipedia. Nuestro ejemplo es similar a los intervalos de Agresti-Coull." }, { "objectID": "10-clasificacion-calibracion.html#ejemplo-artículos-de-ropa", "href": "10-clasificacion-calibracion.html#ejemplo-artículos-de-ropa", - "title": "10  Incertidumbre en clasificación", + "title": "10  Calibración de probabilidades", "section": "10.3 Ejemplo: artículos de ropa", "text": "10.3 Ejemplo: artículos de ropa\nRegresamos a nuestro modelo para clasificar imágenes de artículos de ropa:\n\nlibrary(keras)\nropa_datos <- dataset_fashion_mnist()\nropa_prueba <- ropa_datos$test\n# estas son las categorias:\narticulos <- c(\"playera/top\", \"pantalón\", \"suéter\", \"vestido\", \"abrigo\", \"sandalia\", \n \"camisa\", \"tenis\", \"bolsa\", \"bota\")\netiquetas_tbl <- tibble(codigo = 0:9, articulo = articulos)\nx_prueba <- ropa_prueba$x / 255\ny_prueba <- to_categorical(ropa_prueba$y, 10)\nmodelo <- load_model_tf(\"cache/red_ropa_1\")\n\n\npreds_mat <- predict(modelo, x_prueba)\ncolnames(preds_mat) <- articulos\npreds_tbl <- as_tibble(preds_mat) |> \n mutate(id = 1:nrow(preds_mat), .before = 1) |> \n mutate(codigo = ropa_prueba$y) |> \n left_join(etiquetas_tbl)\npreds_tbl |> head() |> gt() |> fmt_number(where(is_double), decimals = 3)\n\n\n\n\n\n \n \n \n id\n playera/top\n pantalón\n suéter\n vestido\n abrigo\n sandalia\n camisa\n tenis\n bolsa\n bota\n codigo\n articulo\n \n \n \n 1\n0.000\n0.000\n0.000\n0.000\n0.000\n0.117\n0.000\n0.051\n0.005\n0.827\n9\nbota\n 2\n0.000\n0.000\n0.913\n0.000\n0.026\n0.000\n0.061\n0.000\n0.000\n0.000\n2\nsuéter\n 3\n0.000\n1.000\n0.000\n0.000\n0.000\n0.000\n0.000\n0.000\n0.000\n0.000\n1\npantalón\n 4\n0.000\n1.000\n0.000\n0.000\n0.000\n0.000\n0.000\n0.000\n0.000\n0.000\n1\npantalón\n 5\n0.274\n0.000\n0.075\n0.011\n0.073\n0.000\n0.565\n0.000\n0.002\n0.000\n6\ncamisa\n 6\n0.001\n0.998\n0.000\n0.000\n0.001\n0.000\n0.000\n0.000\n0.000\n0.000\n1\npantalón\n \n \n \n\n\n\n\nNuestra gráfica de calibración para la categoría camisa es:\n\npreds_tbl |> select(camisa, articulo) |> \n mutate(obs_camisa = articulo == \"camisa\") |> \n mutate(grupo_prob = cut_number(camisa, 40)) |> \n group_by(grupo_prob) |> \n summarise(n = n(),\n pred_camisa = mean(camisa), \n prop_camisa = mean(obs_camisa)) |>\n mutate(ee = sqrt(prop_camisa * (1 - prop_camisa) / n)) |> \nggplot(aes(x = pred_camisa, y = prop_camisa, ymin = prop_camisa - 2*ee,\n ymax = prop_camisa + 2* ee)) +\n geom_abline() +\n geom_linerange() + \n geom_point(colour = \"red\") + xlim(0,1) + ylim(0,1)\n\nWarning: Removed 4 rows containing missing values (`geom_segment()`).\n\n\n\n\n\nVemos que la calibración no es muy mala, al menos para la categoría de camisa. Podemos checar otras categorías de esta manera. Calibrar estas probabilidades puede ser más difícil, pero podemos construir regiones conformes con garantías de cobertura como mostramos abajo:" }, { "objectID": "10-clasificacion-calibracion.html#regiones-conformes-para-clasificación", "href": "10-clasificacion-calibracion.html#regiones-conformes-para-clasificación", - "title": "10  Incertidumbre en clasificación", + "title": "10  Calibración de probabilidades", "section": "10.4 Regiones conformes para clasificación", "text": "10.4 Regiones conformes para clasificación\nPodemos construir conjuntos de predicción con la técnica de predicción conforme con muestra de prueba, siguiendo ideas de (Angelopoulos y Bates 2021), ver aquí también.\nEn este caso, no es necesario tener probabilidades calibradas, pero los conjuntos de predicción que obtendremos tendrán garantía de cobertura correcta promedio.\n\npreds_larga_tbl <- preds_tbl |> \n pivot_longer(`playera/top`:bota, names_to = \"articulo_prob\", values_to = \"prob\") |> \n group_by(id) |> \n arrange(id, desc(prob)) |>\n mutate(clase_verdadera = articulo == articulo_prob) |> \n mutate(acumulado = cumsum(clase_verdadera))\ne_valores <- preds_larga_tbl |> \n filter(clase_verdadera) |>\n group_by(id) |> \n summarise(e = sum(prob))\nq <- quantile(e_valores$e, prob = 0.05)\ne_valores |> ggplot(aes(x = e)) + geom_histogram() +\n geom_vline(xintercept = q, colour = \"red\")\n\n`stat_bin()` using `bins = 30`. Pick better value with `binwidth`.\n\n\n\n\n\n\nconjuntos_conf <- preds_larga_tbl |> group_by(id) |> \n filter(prob > q) |> \n select(id, articulo = articulo_prob, prob)\nconjuntos_conf\n\n# A tibble: 14,408 × 3\n# Groups: id [10,000]\n id articulo prob\n <int> <chr> <dbl>\n 1 1 bota 0.827\n 2 1 sandalia 0.117\n 3 2 suéter 0.913\n 4 3 pantalón 1.00 \n 5 4 pantalón 1.00 \n 6 5 camisa 0.565\n 7 5 playera/top 0.274\n 8 6 pantalón 0.998\n 9 7 abrigo 0.955\n10 8 camisa 0.774\n# ℹ 14,398 more rows\n\n\nY así se ve el tamaño de los conjuntos conformes. La mayoría consiste de una sola clase (con probabilidad de 95%), pero muchos tienen 2 o 3 categorías posibles, de modo que el desempeño de nuestro modelo no es excelente.\n\nconjuntos_conf |> count(id) |> \n group_by(n) |> count()\n\nStoring counts in `nn`, as `n` already present in input\nℹ Use `name = \"new_name\"` to pick a new name.\n\n\n# A tibble: 5 × 2\n# Groups: n [5]\n n nn\n <int> <int>\n1 1 6583\n2 2 2530\n3 3 788\n4 4 94\n5 5 5\n\n\nPor ejemplo:\n\nfilter(conjuntos_conf, id == 21)\n\n# A tibble: 3 × 3\n# Groups: id [1]\n id articulo prob\n <int> <chr> <dbl>\n1 21 suéter 0.644\n2 21 playera/top 0.195\n3 21 camisa 0.157\n\n\n\nlibrary(imager)\nplot(as.cimg(t(ropa_prueba$x[21,,])), axes = FALSE, main = articulos[ropa_prueba$y[21] + 1])\n\n\n\n\n\nid_1 <- 27\nejemplo_conf <- filter(conjuntos_conf |> ungroup(), id == id_1)\nejemplo_conf\n\n# A tibble: 2 × 3\n id articulo prob\n <int> <chr> <dbl>\n1 27 camisa 0.837\n2 27 abrigo 0.131\n\nplot(as.cimg(t(ropa_prueba$x[id_1,,])), axes = FALSE, main = articulos[ropa_prueba$y[id_1] + 1])" }, { "objectID": "10-clasificacion-calibracion.html#calibración-de-probabilidades-1", "href": "10-clasificacion-calibracion.html#calibración-de-probabilidades-1", - "title": "10  Incertidumbre en clasificación", + "title": "10  Calibración de probabilidades", "section": "10.5 Calibración de probabilidades", "text": "10.5 Calibración de probabilidades\nCuando la calibración no es muy buena, es posible seguir el camino de predicción conforme de clase, o podemos también intentar un proceso de calibración. La idea es construir una funcion \\({f}_cal\\) tal que si \\(p'(x) = f_{cal}(p(x))\\) , las probabilidades dadas por \\(p'(x)\\) tienen buena calibración.\nLos métodos más comunes son:\n\nAplicar regresión logística (quizá con splines, por ejemplo), usando la probabilidad/score del modelo original como variable de entrada, y la respuesta como la variable de salida.\nAplicar regresión isotónica, que es similar pero restringe a que la calibración preserve el orden de las probabilidades/scores del modelo original.\n\nExisten otros métodos ( ver por ejemplo https://www.tidymodels.org/learn/models/calibration/)\nVeamos un ejemplo donde queremos contruir un modelo para predecir que células están correctamente segmentadas y cuáles no, bajo un método que se llama High content screening. Las clases son PS (poorly segmented) y WS (well segmented):\n\ndata(cells)\ndim(cells)\n\n[1] 2019 58\n\ncells$case <- NULL\ncells |> count(class)\n\n# A tibble: 2 × 2\n class n\n <fct> <int>\n1 PS 1300\n2 WS 719\n\n\n\nlibrary(probably)\n\n\nAttaching package: 'probably'\n\n\nThe following objects are masked from 'package:base':\n\n as.factor, as.ordered\n\nlibrary(discrim)\n\n\nAttaching package: 'discrim'\n\n\nThe following object is masked from 'package:dials':\n\n smoothness\n\nset.seed(128)\nsplit <- initial_split(cells, strata = class)\ncells_tr <- training(split)\ncells_te <- testing(split)\n\ncells_rs <- vfold_cv(cells_tr, v = 10, strata = class) \ndiscrim_wflow <-\n workflow() |> \n add_formula(class ~ .) |> \n add_model(discrim_linear() |> set_mode(\"classification\")) \nmetricas <- metric_set(roc_auc, brier_class)\n\ndiscrim_res <-\n discrim_wflow |>\n fit_resamples(resamples = cells_rs, \n metrics = metricas, \n control = control_resamples(save_pred = TRUE))\n\n→ A | warning: variables are collinear\n\n\nThere were issues with some computations A: x1\n\n\nThere were issues with some computations A: x10\n\n\n\n\ncollect_metrics(discrim_res)\n\n# A tibble: 2 × 6\n .metric .estimator mean n std_err .config \n <chr> <chr> <dbl> <int> <dbl> <chr> \n1 brier_class binary 0.136 10 0.00281 Preprocessor1_Model1\n2 roc_auc binary 0.879 10 0.00411 Preprocessor1_Model1\n\n\n\ncal_plot_breaks(discrim_res, num_breaks = 15)\n\n\n\n\nCorremos ahora validación con regresión logística com ejemplo:\n\nlogit_val <- probably::cal_validate_logistic(discrim_res, \n metrics = metricas, save_pred = TRUE)\ncollect_metrics(logit_val)\n\n# A tibble: 4 × 7\n .metric .type .estimator mean n std_err .config\n <chr> <chr> <chr> <dbl> <int> <dbl> <chr> \n1 brier_class uncalibrated binary 0.136 10 0.00281 config \n2 roc_auc uncalibrated binary 0.879 10 0.00411 config \n3 brier_class calibrated binary 0.134 10 0.00296 config \n4 roc_auc calibrated binary 0.879 10 0.00411 config \n\n\nY el resultado es ahora como sigue:\n\ncollect_predictions(logit_val) |> \n filter(.type == \"calibrated\") |> \n cal_plot_breaks(truth = class, estimate = .pred_PS) \n\n\n\n\n\n\n\n\nAngelopoulos, Anastasios N., y Stephen Bates. 2021. «A Gentle Introduction to Conformal Prediction and Distribution-Free Uncertainty Quantification». https://arxiv.org/abs/2107.07511.\n\n\nKuhn, M., y K. Johnson. 2013. Applied Predictive Modeling. SpringerLink : Bücher. Springer New York. https://books.google.com.mx/books?id=xYRDAAAAQBAJ." }, @@ -480,14 +480,14 @@ "href": "81-apendice-descenso.html#implementación", "title": "Apéndice A — Apéndice 1: descenso en gradiente", "section": "A.2 Implementación", - "text": "A.2 Implementación\nEn este punto, podemos intentar una implementación simple basada en el código anterior para hacer descenso en gradiente para nuestro problema de regresión (es un buen ejercicio). En lugar de eso, mostraremos cómo usar librerías ahora estándar para hacer esto. En particular usamos keras (con tensorflow), que tienen la ventaja:\n\nEn tensorflow y keras no es necesario calcular las derivadas a mano. Utiliza diferenciación automática, que no es diferenciación numérica ni simbólica: se basa en la regla de la cadena y la codificación explícita de las derivadas de funciones elementales.\n\n\nlibrary(tidymodels)\nlibrary(keras)\nsource(\"../R/casas_traducir_geo.R\")\nset.seed(68821)\n# dividir muestra\ncasas_split <- initial_split(casas |>\n select(precio_m2_miles, area_hab_m2, calidad_gral, num_coches), \n prop = 0.75)\n# obtener muestra de entrenamiento\ncasas_entrena <- training(casas_split)\ncasas_receta <- recipe(precio_m2_miles ~ ., casas_entrena) \n\n\n# definición de estructura del modelo (regresión lineal)\nx_ent <- casas_receta |> prep() |> juice() |> select(-precio_m2_miles) |> as.matrix()\ny_ent <- casas_receta |> prep() |> juice() |> pull(precio_m2_miles)\nn_entrena <- nrow(x_ent)\ncrear_modelo <- function(lr = 0.01){\n modelo_casas <- \n keras_model_sequential() |>\n layer_dense(units = 1, #una sola respuesta,\n activation = \"linear\", # combinar variables linealmente\n kernel_initializer = initializer_constant(0), #inicializamos coeficientes en 0\n bias_initializer = initializer_constant(0)) #inicializamos ordenada en 0\n # compilar seleccionando cantidad a minimizar, optimizador y métricas\n modelo_casas |> compile(\n loss = \"mean_squared_error\", # pérdida cuadrática\n optimizer = optimizer_sgd(learning_rate = lr), # descenso en gradiente\n metrics = list(\"mean_squared_error\"))\n modelo_casas\n}\n# tasa de aprendizaje es lr, tenemos que poner una tasa chica (prueba)\nmodelo_casas <- crear_modelo(lr = 0.00001)\n# Ahora iteramos\n# Primero probamos con un número bajo de iteraciones\nhistoria <- modelo_casas |> fit(\n x_ent, # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 20, # número de iteraciones\n verbose = 0\n)\n\n\nplot(historia, metrics = \"mean_squared_error\", smooth = FALSE) +\n geom_line()\n\n\n\nhistoria$metrics$mean_squared_error |> round(4)\n\n [1] 1.7903 0.7636 0.4549 0.3621 0.3342 0.3258 0.3232 0.3224 0.3222 0.3221\n[11] 0.3220 0.3220 0.3220 0.3219 0.3219 0.3219 0.3218 0.3218 0.3218 0.3217\n\n\nProbamos con más corridas para checar convergencia:\n\n# Agregamos iteraciones: esta historia comienza en los últimos valores de\n# la corrida anterior\nhistoria <- modelo_casas |> fit(\n as.matrix(x_ent), # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 1000, # número de iteraciones\n verbose = 0\n)\n\n\nplot(historia, metrics = \"mean_squared_error\", smooth = FALSE) \n\n\n\n\nEl modelo parece todavía ir mejorando. Veamos de todas formas los coeficientes estimados hasta ahora:\n\nkeras::get_weights(modelo_casas)\n\n[[1]]\n [,1]\n[1,] 0.007331367\n[2,] 0.016437238\n[3,] 0.004633876\n\n[[2]]\n[1] 0.003028649\n\n\nLa implementación oficial de R es lm, que en general tiene buen desempeño para datos que caben en memoria:\n\nlm(precio_m2_miles ~ area_hab_m2 + calidad_gral + num_coches, \n data = casas_entrena) |> \n coef()\n\n (Intercept) area_hab_m2 calidad_gral num_coches \n 0.66869194 -0.00449751 0.16807663 0.13115749 \n\n\nDe modo que todavía requerimos más iteraciones para alcanzar convergencia. ¿Por qué la convergencia es tan lenta? En parte, la razón es que las escalas de las variables de entrada son muy diferentes, de modo que es difícil ajustar una tasa de aprendizaje constante que funcione bien. Podemos remediar esto poniendo todas las entradas en la misma escala (normalizando)" + "text": "A.2 Implementación\nEn este punto, podemos intentar una implementación simple basada en el código anterior para hacer descenso en gradiente para nuestro problema de regresión (es un buen ejercicio). En lugar de eso, mostraremos cómo usar librerías ahora estándar para hacer esto. En particular usamos keras (con tensorflow), que tienen la ventaja:\n\nEn tensorflow y keras no es necesario calcular las derivadas a mano. Utiliza diferenciación automática, que no es diferenciación numérica ni simbólica: se basa en la regla de la cadena y la codificación explícita de las derivadas de funciones elementales.\n\n\nlibrary(tidymodels)\nlibrary(keras)\nsource(\"../R/casas_traducir_geo.R\")\nset.seed(68821)\n# dividir muestra\ncasas_split <- initial_split(casas |>\n select(precio_m2_miles, area_hab_m2, calidad_gral, num_coches), \n prop = 0.75)\n# obtener muestra de entrenamiento\ncasas_entrena <- training(casas_split)\ncasas_receta <- recipe(precio_m2_miles ~ ., casas_entrena) \n\n\n# definición de estructura del modelo (regresión lineal)\nx_ent <- casas_receta |> prep() |> juice() |> select(-precio_m2_miles) |> as.matrix()\ny_ent <- casas_receta |> prep() |> juice() |> pull(precio_m2_miles)\nn_entrena <- nrow(x_ent)\ncrear_modelo <- function(lr = 0.01){\n modelo_casas <- \n keras_model_sequential() |>\n layer_dense(units = 1, #una sola respuesta,\n activation = \"linear\", # combinar variables linealmente\n kernel_initializer = initializer_constant(0), #inicializamos coeficientes en 0\n bias_initializer = initializer_constant(0)) #inicializamos ordenada en 0\n # compilar seleccionando cantidad a minimizar, optimizador y métricas\n modelo_casas |> compile(\n loss = \"mean_squared_error\", # pérdida cuadrática\n optimizer = optimizer_sgd(learning_rate = lr), # descenso en gradiente\n metrics = list(\"mean_squared_error\"))\n modelo_casas\n}\n# tasa de aprendizaje es lr, tenemos que poner una tasa chica (prueba)\nmodelo_casas <- crear_modelo(lr = 0.00001)\n# Ahora iteramos\n# Primero probamos con un número bajo de iteraciones\nhistoria <- modelo_casas |> fit(\n x_ent, # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 20, # número de iteraciones\n verbose = 0\n)\n\n\nplot(historia, metrics = \"mean_squared_error\", smooth = FALSE) +\n geom_line()\n\n\n\nhistoria$metrics$mean_squared_error |> round(4)\n\n [1] 1.7903 0.7636 0.4549 0.3621 0.3342 0.3258 0.3232 0.3224 0.3222 0.3221\n[11] 0.3220 0.3220 0.3220 0.3219 0.3219 0.3219 0.3218 0.3218 0.3218 0.3217\n\n\nProbamos con más corridas para checar convergencia:\n\n# Agregamos iteraciones: esta historia comienza en los últimos valores de\n# la corrida anterior\nhistoria <- modelo_casas |> fit(\n as.matrix(x_ent), # x entradas\n y_ent, # y salida o target\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = 1000, # número de iteraciones\n verbose = 0\n)\n\n\nplot(historia, metrics = \"mean_squared_error\", smooth = FALSE) \n\n\n\n\nEl modelo parece todavía ir mejorando. Veamos de todas formas los coeficientes estimados hasta ahora:\n\nkeras::get_weights(modelo_casas)\n\n[[1]]\n [,1]\n[1,] 0.007331367\n[2,] 0.016437240\n[3,] 0.004633876\n\n[[2]]\n[1] 0.003028649\n\n\nLa implementación oficial de R es lm, que en general tiene buen desempeño para datos que caben en memoria:\n\nlm(precio_m2_miles ~ area_hab_m2 + calidad_gral + num_coches, \n data = casas_entrena) |> \n coef()\n\n (Intercept) area_hab_m2 calidad_gral num_coches \n 0.66869194 -0.00449751 0.16807663 0.13115749 \n\n\nDe modo que todavía requerimos más iteraciones para alcanzar convergencia. ¿Por qué la convergencia es tan lenta? En parte, la razón es que las escalas de las variables de entrada son muy diferentes, de modo que es difícil ajustar una tasa de aprendizaje constante que funcione bien. Podemos remediar esto poniendo todas las entradas en la misma escala (normalizando)" }, { "objectID": "81-apendice-descenso.html#normalización-de-entradas", "href": "81-apendice-descenso.html#normalización-de-entradas", "title": "Apéndice A — Apéndice 1: descenso en gradiente", "section": "A.3 Normalización de entradas", - "text": "A.3 Normalización de entradas\nLa convergencia de descenso en gradiente (y también el desempeño numérico para otros algoritmos) puede dificultarse cuando las variables tienen escalas muy diferentes. Esto produce curvaturas altas en la función que queremos minimizar.\nEn este ejemplo simple, una variable tiene desviación estándar 10 y otra 1:\n\nx1 <- rnorm(100, 0, 5) \nx2 <- rnorm(100, 0, 1) + 0.1*x1\ny <- 0*x1 + 0*x2 + rnorm(100, 0, 0.1) \ndat <- tibble(x1, x2, y)\nrss <- function(beta) mean((as.matrix(dat[, 1:2]) %*% beta - y)^2) \ngrid_beta <- expand.grid(beta1 = seq(-1, 1, length.out = 50), \n beta2 = seq(-1, 1, length.out = 50))\nrss_1 <- apply(grid_beta, 1, rss) \ndat_x <- data.frame(grid_beta, rss_1)\nggplot(dat_x, aes(x = beta1, y = beta2, z = rss_1)) + \n geom_contour(binwidth = 0.5) +\n coord_equal() \n\n\n\n\nEn algunas direcciones el gradiente es muy grande, y en otras chico. Esto implica que la convergencia puede ser muy lenta en algunas direcciones, puede diverger en otras, y que hay que ajustar el paso \\(\\eta > 0\\) con cuidado, dependiendo de dónde comiencen las iteraciones.\nPor ejemplo, con un tamaño de paso relativamente chico, damos unos saltos grandes al principio y luego avanzamos muy lentamente:\n\ngrad_calc <- function(x_ent, y_ent){\n # calculamos directamente el gradiente\n salida_grad <- function(beta){\n n <- length(y_ent)\n f_beta <- as.matrix(cbind(1, x_ent)) %*% beta\n e <- y_ent - f_beta\n grad_out <- - as.numeric(t(cbind(1, x_ent)) %*% e) / n\n names(grad_out) <- c('Intercept', colnames(x_ent))\n grad_out\n }\n salida_grad\n}\ngrad_sin_norm <- grad_calc(dat[, 1:2, drop = FALSE], dat$y)\niteraciones <- descenso(10, c(0, -0.25, -0.75), 0.02, grad_sin_norm)\nggplot(dat_x) + \n geom_contour(aes(x = beta1, y = beta2, z = rss_1), binwidth = 0.5) +\n coord_equal() +\n geom_path(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red') +\n geom_point(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red')\n\n\n\n\nSi incrementamos el tamaño de paso observamos también convergencia lenta. En este caso particular, subir más el tamaño de paso puede producir divergencia:\n\niteraciones <- descenso(10, c(0, -0.25, -0.75), 0.07, grad_sin_norm)\nggplot(dat_x) + \n geom_contour(aes(x = beta1, y = beta2, z = rss_1), binwidth = 0.5) +\n coord_equal() +\n geom_path(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red') +\n geom_point(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red')\n\n\n\n\nUna normalización usual es con la media y desviación estándar, donde hacemos, para cada variable de entrada \\(j=1,2,\\ldots, p\\) \\[ x_j^{(i)} = \\frac{ x_j^{(i)} - \\bar{x}_j}{s_j}\\] donde \\[\\bar{x}_j = \\frac{1}{N} \\sum_{i=1}^N x_j^{(i)}\\] \\[s_j = \\sqrt{\\frac{1}{N-1}\\sum_{i=1}^N (x_j^{(i)}- \\bar{x}_j )^2}\\] es decir, centramos y normalizamos por columna. Otra opción común es restar el mínimo y dividir entre la diferencia del máximo y el mínimo, de modo que las variables resultantes toman valores en \\([0,1]\\).\nEntonces escalamos antes de ajustar:\n\nx1_s = (x1 - mean(x1))/sd(x1)\nx2_s = (x2 - mean(x2))/sd(x2)\ndat <- tibble(x1_s = x1_s, x2_s = x2_s, y = y)\nrss <- function(beta) mean((as.matrix(dat[, 1:2]) %*% beta - y)^2) \ngrid_beta <- expand.grid(beta1 = seq(-1, 1, length.out = 50), \n beta2 = seq(-1, 1, length.out = 50))\nrss_1 <- apply(grid_beta, 1, rss) \ndat_x <- data.frame(grid_beta, rss_1)\nggplot(dat_x, aes(x = beta1, y = beta2, z = rss_1)) + \n geom_contour(binwidth = 0.5) +\n coord_equal() \n\n\n\n\nNótese que los coeficientes ajustados serán diferentes a los del caso no normalizado.\nSi normalizamos, obtenemos convergencia más rápida\n\ngrad_sin_norm <- grad_calc(dat[, 1:2, drop = FALSE], dat$y)\niteraciones <- descenso(10, c(0, -0.25, -0.75), 0.5, grad_sin_norm)\nggplot(dat_x) + \n geom_contour(aes(x = beta1, y = beta2, z = rss_1), binwidth = 0.5) +\n coord_equal() +\n geom_path(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red') +\n geom_point(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red')\n\n\n\n\n\n\n\nCuando normalizamos antes de ajustar el modelo, las predicciones deben hacerse con entradas normalizadas. La normalización se hace con los mismos valores que se usaron en el entrenamiento (y no recalculando medias y desviaciones estándar con el conjunto de prueba). En cuanto a la forma funcional del predictor (f), el problema con entradas normalizadas es equivalente al de las entradas no normalizadas. Asegúrate de esto escribiendo cómo correponden los coeficientes de cada modelo normalizado con los coeficientes del modelo no normalizado.\n\n\n\nSupongamos que el modelo en las variables originales es \\[{f}_\\beta (X) = \\beta_0 + \\beta_1 X_1 + \\beta_2 X_2 + \\cdots + \\beta_p X_p,\\] Consideramos el modelo con variables estandarizadas \\[{g}_{\\beta^s} (X) = \\beta_0^s + \\beta_1^s Z_1 + \\beta_2^s Z_2 + \\cdots + \\beta_p^s Z_p,\\]\nSustituyendo \\(Z_j = (X_j - \\mu_j)/s_j,\\)\n\\[{g}_{\\beta^s} (X) = (\\beta_0^s - \\sum_{j=1}^p \\beta_j^s \\mu_j/s_j) + \\frac{\\beta_1^s}{s_j} X_1 + \\frac{\\beta_2^s}{s_2} X_2 + \\cdots + \\frac{\\beta_p^s}{s_p} X_p,\\] Y vemos que tiene la misma forma funcional de \\(f_\\beta(X)\\). Si la solución de mínimos cuadrados es única, entonces una vez que ajustemos tenemos que tener \\(\\hat{f}_\\beta(X) = \\hat{g}_{\\beta^s} (X)\\), lo que implica que \\[\\hat{\\beta}_0 = \\hat{\\beta}_0^s - \\sum_{j=1}^p \\hat{\\beta}_j^s\\mu_j/s_j\\] y \\[\\hat{\\beta}_j = \\hat{\\beta}_j^s/s_j.\\]\nNótese que para pasar del problema estandarizado al no estandarizado simplemente se requiere escalar los coeficientes por la \\(s_j\\) correspondiente.\n\nEjemplo\nRepetimos nuestro modelo, pero normalizando las entradas:\n\n# usamos recipes para este ejemplo, no necesitas usarlo\ncasas_receta <- recipe(precio_m2_miles ~ ., casas_entrena) |>\n step_normalize(all_predictors()) \ncasas_receta |> summary()\n\n# A tibble: 4 × 4\n variable type role source \n <chr> <list> <chr> <chr> \n1 area_hab_m2 <chr [2]> predictor original\n2 calidad_gral <chr [2]> predictor original\n3 num_coches <chr [2]> predictor original\n4 precio_m2_miles <chr [2]> outcome original\n\n\n\nmodelo_lineal <- linear_reg() |>\n set_engine(\"lm\")\ncasas_flujo <- workflow() |>\n add_recipe(casas_receta) |> \n add_model(modelo_lineal)\n\n\nlibrary(keras)\n# definición de estructura del modelo (regresión lineal)\nx_ent_s <- prep(casas_receta) |> juice() |> select(-precio_m2_miles) |> \n as.matrix()\najustar_casas <- function(modelo, x, y, n_epochs = 100){\n ajuste <- modelo |> fit(\n as.matrix(x), y,\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = n_epochs, # número de iteraciones\n verbose = 0) |> as_tibble()\n ajuste\n}\nmodelo_casas_ns <- crear_modelo(0.00001)\nmodelo_casas_s <- crear_modelo(0.2)\nhistoria_s <- ajustar_casas(modelo_casas_s, x_ent_s, y_ent) |>\n mutate(tipo = \"Estandarizar\")\nhistoria_ns <- ajustar_casas(modelo_casas_ns, x_ent, y_ent) |> \n mutate(tipo = \"Sin estandarizar\")\nhistoria <- bind_rows(historia_ns, historia_s) |> filter(metric == \"mean_squared_error\")\nggplot(historia, aes(x = epoch, y = value, colour = tipo)) +\n geom_line() + geom_point() +scale_x_log10() + scale_y_log10()\n\n\n\n\nObservamos que el modelo con datos estandarizados convergió:\n\nkeras::get_weights(modelo_casas_s)\n\n[[1]]\n [,1]\n[1,] -0.22045916\n[2,] 0.23149671\n[3,] 0.09673478\n\n[[2]]\n[1] 1.295027\n\ncoef(lm.fit(cbind(1,x_ent_s), y_ent))\n\n area_hab_m2 calidad_gral num_coches \n 1.29502679 -0.22045919 0.23149675 0.09673476 \n\n\nMientras que el modelo no estandarizado todavía requiere iteraciones:\n\nkeras::get_weights(modelo_casas_ns)\n\n[[1]]\n [,1]\n[1,] 0.0079817399\n[2,] 0.0019486141\n[3,] 0.0005532745\n\n[[2]]\n[1] 0.0003491882\n\ncoef(lm.fit(cbind(1, x_ent), y_ent))\n\n area_hab_m2 calidad_gral num_coches \n 0.66869194 -0.00449751 0.16807663 0.13115749" + "text": "A.3 Normalización de entradas\nLa convergencia de descenso en gradiente (y también el desempeño numérico para otros algoritmos) puede dificultarse cuando las variables tienen escalas muy diferentes. Esto produce curvaturas altas en la función que queremos minimizar.\nEn este ejemplo simple, una variable tiene desviación estándar 10 y otra 1:\n\nx1 <- rnorm(100, 0, 5) \nx2 <- rnorm(100, 0, 1) + 0.1*x1\ny <- 0*x1 + 0*x2 + rnorm(100, 0, 0.1) \ndat <- tibble(x1, x2, y)\nrss <- function(beta) mean((as.matrix(dat[, 1:2]) %*% beta - y)^2) \ngrid_beta <- expand.grid(beta1 = seq(-1, 1, length.out = 50), \n beta2 = seq(-1, 1, length.out = 50))\nrss_1 <- apply(grid_beta, 1, rss) \ndat_x <- data.frame(grid_beta, rss_1)\nggplot(dat_x, aes(x = beta1, y = beta2, z = rss_1)) + \n geom_contour(binwidth = 0.5) +\n coord_equal() \n\n\n\n\nEn algunas direcciones el gradiente es muy grande, y en otras chico. Esto implica que la convergencia puede ser muy lenta en algunas direcciones, puede diverger en otras, y que hay que ajustar el paso \\(\\eta > 0\\) con cuidado, dependiendo de dónde comiencen las iteraciones.\nPor ejemplo, con un tamaño de paso relativamente chico, damos unos saltos grandes al principio y luego avanzamos muy lentamente:\n\ngrad_calc <- function(x_ent, y_ent){\n # calculamos directamente el gradiente\n salida_grad <- function(beta){\n n <- length(y_ent)\n f_beta <- as.matrix(cbind(1, x_ent)) %*% beta\n e <- y_ent - f_beta\n grad_out <- - as.numeric(t(cbind(1, x_ent)) %*% e) / n\n names(grad_out) <- c('Intercept', colnames(x_ent))\n grad_out\n }\n salida_grad\n}\ngrad_sin_norm <- grad_calc(dat[, 1:2, drop = FALSE], dat$y)\niteraciones <- descenso(10, c(0, -0.25, -0.75), 0.02, grad_sin_norm)\nggplot(dat_x) + \n geom_contour(aes(x = beta1, y = beta2, z = rss_1), binwidth = 0.5) +\n coord_equal() +\n geom_path(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red') +\n geom_point(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red')\n\n\n\n\nSi incrementamos el tamaño de paso observamos también convergencia lenta. En este caso particular, subir más el tamaño de paso puede producir divergencia:\n\niteraciones <- descenso(10, c(0, -0.25, -0.75), 0.07, grad_sin_norm)\nggplot(dat_x) + \n geom_contour(aes(x = beta1, y = beta2, z = rss_1), binwidth = 0.5) +\n coord_equal() +\n geom_path(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red') +\n geom_point(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red')\n\n\n\n\nUna normalización usual es con la media y desviación estándar, donde hacemos, para cada variable de entrada \\(j=1,2,\\ldots, p\\) \\[ x_j^{(i)} = \\frac{ x_j^{(i)} - \\bar{x}_j}{s_j}\\] donde \\[\\bar{x}_j = \\frac{1}{N} \\sum_{i=1}^N x_j^{(i)}\\] \\[s_j = \\sqrt{\\frac{1}{N-1}\\sum_{i=1}^N (x_j^{(i)}- \\bar{x}_j )^2}\\] es decir, centramos y normalizamos por columna. Otra opción común es restar el mínimo y dividir entre la diferencia del máximo y el mínimo, de modo que las variables resultantes toman valores en \\([0,1]\\).\nEntonces escalamos antes de ajustar:\n\nx1_s = (x1 - mean(x1))/sd(x1)\nx2_s = (x2 - mean(x2))/sd(x2)\ndat <- tibble(x1_s = x1_s, x2_s = x2_s, y = y)\nrss <- function(beta) mean((as.matrix(dat[, 1:2]) %*% beta - y)^2) \ngrid_beta <- expand.grid(beta1 = seq(-1, 1, length.out = 50), \n beta2 = seq(-1, 1, length.out = 50))\nrss_1 <- apply(grid_beta, 1, rss) \ndat_x <- data.frame(grid_beta, rss_1)\nggplot(dat_x, aes(x = beta1, y = beta2, z = rss_1)) + \n geom_contour(binwidth = 0.5) +\n coord_equal() \n\n\n\n\nNótese que los coeficientes ajustados serán diferentes a los del caso no normalizado.\nSi normalizamos, obtenemos convergencia más rápida\n\ngrad_sin_norm <- grad_calc(dat[, 1:2, drop = FALSE], dat$y)\niteraciones <- descenso(10, c(0, -0.25, -0.75), 0.5, grad_sin_norm)\nggplot(dat_x) + \n geom_contour(aes(x = beta1, y = beta2, z = rss_1), binwidth = 0.5) +\n coord_equal() +\n geom_path(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red') +\n geom_point(data = data.frame(iteraciones[, 2:3]), aes(x=X1, y=X2), colour = 'red')\n\n\n\n\n\n\n\nCuando normalizamos antes de ajustar el modelo, las predicciones deben hacerse con entradas normalizadas. La normalización se hace con los mismos valores que se usaron en el entrenamiento (y no recalculando medias y desviaciones estándar con el conjunto de prueba). En cuanto a la forma funcional del predictor (f), el problema con entradas normalizadas es equivalente al de las entradas no normalizadas. Asegúrate de esto escribiendo cómo correponden los coeficientes de cada modelo normalizado con los coeficientes del modelo no normalizado.\n\n\n\nSupongamos que el modelo en las variables originales es \\[{f}_\\beta (X) = \\beta_0 + \\beta_1 X_1 + \\beta_2 X_2 + \\cdots + \\beta_p X_p,\\] Consideramos el modelo con variables estandarizadas \\[{g}_{\\beta^s} (X) = \\beta_0^s + \\beta_1^s Z_1 + \\beta_2^s Z_2 + \\cdots + \\beta_p^s Z_p,\\]\nSustituyendo \\(Z_j = (X_j - \\mu_j)/s_j,\\)\n\\[{g}_{\\beta^s} (X) = (\\beta_0^s - \\sum_{j=1}^p \\beta_j^s \\mu_j/s_j) + \\frac{\\beta_1^s}{s_j} X_1 + \\frac{\\beta_2^s}{s_2} X_2 + \\cdots + \\frac{\\beta_p^s}{s_p} X_p,\\] Y vemos que tiene la misma forma funcional de \\(f_\\beta(X)\\). Si la solución de mínimos cuadrados es única, entonces una vez que ajustemos tenemos que tener \\(\\hat{f}_\\beta(X) = \\hat{g}_{\\beta^s} (X)\\), lo que implica que \\[\\hat{\\beta}_0 = \\hat{\\beta}_0^s - \\sum_{j=1}^p \\hat{\\beta}_j^s\\mu_j/s_j\\] y \\[\\hat{\\beta}_j = \\hat{\\beta}_j^s/s_j.\\]\nNótese que para pasar del problema estandarizado al no estandarizado simplemente se requiere escalar los coeficientes por la \\(s_j\\) correspondiente.\n\nEjemplo\nRepetimos nuestro modelo, pero normalizando las entradas:\n\n# usamos recipes para este ejemplo, no necesitas usarlo\ncasas_receta <- recipe(precio_m2_miles ~ ., casas_entrena) |>\n step_normalize(all_predictors()) \ncasas_receta |> summary()\n\n# A tibble: 4 × 4\n variable type role source \n <chr> <list> <chr> <chr> \n1 area_hab_m2 <chr [2]> predictor original\n2 calidad_gral <chr [2]> predictor original\n3 num_coches <chr [2]> predictor original\n4 precio_m2_miles <chr [2]> outcome original\n\n\n\nmodelo_lineal <- linear_reg() |>\n set_engine(\"lm\")\ncasas_flujo <- workflow() |>\n add_recipe(casas_receta) |> \n add_model(modelo_lineal)\n\n\nlibrary(keras)\n# definición de estructura del modelo (regresión lineal)\nx_ent_s <- prep(casas_receta) |> juice() |> select(-precio_m2_miles) |> \n as.matrix()\najustar_casas <- function(modelo, x, y, n_epochs = 100){\n ajuste <- modelo |> fit(\n as.matrix(x), y,\n batch_size = nrow(x_ent), # para descenso en gradiente\n epochs = n_epochs, # número de iteraciones\n verbose = 0) |> as_tibble()\n ajuste\n}\nmodelo_casas_ns <- crear_modelo(0.00001)\nmodelo_casas_s <- crear_modelo(0.2)\nhistoria_s <- ajustar_casas(modelo_casas_s, x_ent_s, y_ent) |>\n mutate(tipo = \"Estandarizar\")\nhistoria_ns <- ajustar_casas(modelo_casas_ns, x_ent, y_ent) |> \n mutate(tipo = \"Sin estandarizar\")\nhistoria <- bind_rows(historia_ns, historia_s) |> filter(metric == \"mean_squared_error\")\nggplot(historia, aes(x = epoch, y = value, colour = tipo)) +\n geom_line() + geom_point() +scale_x_log10() + scale_y_log10()\n\n\n\n\nObservamos que el modelo con datos estandarizados convergió:\n\nkeras::get_weights(modelo_casas_s)\n\n[[1]]\n [,1]\n[1,] -0.22045916\n[2,] 0.23149671\n[3,] 0.09673478\n\n[[2]]\n[1] 1.295027\n\ncoef(lm.fit(cbind(1,x_ent_s), y_ent))\n\n area_hab_m2 calidad_gral num_coches \n 1.29502679 -0.22045919 0.23149675 0.09673476 \n\n\nMientras que el modelo no estandarizado todavía requiere iteraciones:\n\nkeras::get_weights(modelo_casas_ns)\n\n[[1]]\n [,1]\n[1,] 0.0079817399\n[2,] 0.0019486139\n[3,] 0.0005532746\n\n[[2]]\n[1] 0.0003491882\n\ncoef(lm.fit(cbind(1, x_ent), y_ent))\n\n area_hab_m2 calidad_gral num_coches \n 0.66869194 -0.00449751 0.16807663 0.13115749" }, { "objectID": "82-apendice-descenso-estocastico.html#algoritmo-de-descenso-estocástico", @@ -522,7 +522,7 @@ "href": "82-apendice-descenso-estocastico.html#ajuste-de-redes-con-descenso-estocástico", "title": "Apéndice B — Apéndice 2: Descenso estocástico", "section": "B.5 Ajuste de redes con descenso estocástico", - "text": "B.5 Ajuste de redes con descenso estocástico\n\nlibrary(keras)\n\n\nset.seed(21321)\nx_ent <- as.matrix(dat_ent[,c('x_1','x_2','x_3')])\nx_valid <- as.matrix(dat_valid[,c('x_1','x_2','x_3')])\ny_ent <- dat_ent$y\ny_valid <- dat_valid$y\n\nEmpezamos con regresión (sin capas ocultas), que se escribe y ajusta como sigue:\n\nmodelo <- keras_model_sequential() \nmodelo |>\n layer_dense(units = 1, \n activation = \"linear\",\n input_shape = c(3))\n\nmodelo |> compile(loss = 'mse',\n optimizer = optimizer_sgd(learning_rate = 0.1, momentum = 0,\n decay = 0))\n\nhistory <- modelo |> \n fit(x_ent, y_ent, \n epochs = 50, batch_size = 10, \n verbose = 0,\n validation_data = list(x_valid, y_valid))\n\nPodemos ver el progreso del algoritmo por época\n\naprendizaje <- as_tibble(history)\nggplot(aprendizaje, \n aes(x=epoch, y=value, colour=data, group=data)) +\n facet_wrap(~metric, ncol = 1) + geom_line() + geom_point(size = 0.5)\n\n\n\n\nVer los pesos:\n\nget_weights(modelo)\n\n[[1]]\n [,1]\n[1,] -2.46991372\n[2,] -0.07140191\n[3,] -0.04022333\n\n[[2]]\n[1] -0.351939\n\n\nY verificamos que concuerda con la salida de lm:\n\nmod_lineal <- lm(y ~ x_1 + x_2+ x_3, data = dat_ent) \ncoef(mod_lineal)\n\n(Intercept) x_1 x_2 x_3 \n-0.36904266 -2.46877687 -0.07368414 0.06632769 \n\n\n\n\n\n\nGoodfellow, Ian, Yoshua Bengio, y Aaron Courville. 2016. Deep Learning. MIT Press." + "text": "B.5 Ajuste de redes con descenso estocástico\n\nlibrary(keras)\n\n\nset.seed(21321)\nx_ent <- as.matrix(dat_ent[,c('x_1','x_2','x_3')])\nx_valid <- as.matrix(dat_valid[,c('x_1','x_2','x_3')])\ny_ent <- dat_ent$y\ny_valid <- dat_valid$y\n\nEmpezamos con regresión (sin capas ocultas), que se escribe y ajusta como sigue:\n\nmodelo <- keras_model_sequential() \nmodelo |>\n layer_dense(units = 1, \n activation = \"linear\",\n input_shape = c(3))\n\nmodelo |> compile(loss = 'mse',\n optimizer = optimizer_sgd(learning_rate = 0.1, momentum = 0,\n decay = 0))\n\nhistory <- modelo |> \n fit(x_ent, y_ent, \n epochs = 50, batch_size = 10, \n verbose = 0,\n validation_data = list(x_valid, y_valid))\n\nPodemos ver el progreso del algoritmo por época\n\naprendizaje <- as_tibble(history)\nggplot(aprendizaje, \n aes(x=epoch, y=value, colour=data, group=data)) +\n facet_wrap(~metric, ncol = 1) + geom_line() + geom_point(size = 0.5)\n\n\n\n\nVer los pesos:\n\nget_weights(modelo)\n\n[[1]]\n [,1]\n[1,] -2.56161404\n[2,] -0.08629212\n[3,] 0.19086902\n\n[[2]]\n[1] -0.482064\n\n\nY verificamos que concuerda con la salida de lm:\n\nmod_lineal <- lm(y ~ x_1 + x_2+ x_3, data = dat_ent) \ncoef(mod_lineal)\n\n(Intercept) x_1 x_2 x_3 \n-0.36904266 -2.46877687 -0.07368414 0.06632769 \n\n\n\n\n\n\nGoodfellow, Ian, Yoshua Bengio, y Aaron Courville. 2016. Deep Learning. MIT Press." }, { "objectID": "99-referencias.html",