Aún no tienes acceso a esta clase

Crea una cuenta y continúa viendo este curso

Calculando el tamaño óptimo de la muestra

35/37
Recursos

Aportes 2

Preguntas 0

Ordenar por:

¿Quieres ver más aportes, preguntas y respuestas de la comunidad? Crea una cuenta o inicia sesión.

Esta clase fue una de las que más me gustó, dejó lo mejor para el final, lo hice en Google Colab se demoró aproximadamente 1 min haciendo los cálculos, acá el cuaderno:
https://colab.research.google.com/drive/19wDLFxyH9YswN-gNWPZI5HdNumPm4bqt?usp=sharing

# Validacion cruzada ------------------------------------------------------

library('ggplot2')
library('lattice')
library('caret')
library('parallel')

rmse_fold <- function(pliegue, form, datos, nn_size){
  pliegue_logic <- seq_len(nrow(datos)) %in% pliegue
  prueba <- subset(datos, pliegue_logic)
  entrena <- subset(datos, !pliegue_logic)
  modelo <- nnet(form, data = entrena, size = nn_size, linout = TRUE, trace = FALSE)
  response_name <- setdiff(names(datos), modelo$coefnames)
  Y_pronosticado <- predict(modelo, newdata = prueba)
  rmse <- RMSE(Y_pronosticado, prueba[[response_name]])
  rmse
}

#red neuronal

tamano_muestral <- 2000
neuronas <- 10
n_pliegues <- 10

c(
  'ECON_PERSONAS_HOGAR',
  'ECON_CUARTOS',
  'ECON_SN_LAVADORA',
  'ECON_SN_NEVERA',
  'ECON_SN_HORNO',
  'ECON_SN_DVD',
  'ECON_SN_MICROHONDAS',
  'ECON_SN_AUTOMOVIL',
  'MATEMATICAS_PUNT'
) -> variables

indices_muestra <- seq_len(nrow(SB11_20111)) %in% sample(seq_len(nrow(SB11_20111)), tamano_muestral)

muestra <- subset(SB11_20111, subset = indices_muestra, select = variables)
muestra <- na.omit(muestra)

createFolds(muestra$MATEMATICAS_PUNT, k = n_pliegues) -> pliegues

mclapply(
  pliegues,
  rmse_fold,
  MATEMATICAS_PUNT ~ .,
  muestra,
  nn_size = neuronas,
  mc.cores = 1
) -> rmse_pliegues

rmse_pliegues <- unlist(rmse_pliegues)
mean(rmse_pliegues)

plot(rmse_pliegues, ylin = c(0, 14))
abline(h = mean(rmse_pliegues), col =2, lwd = 2)








# Calculando tamño optimo de la muestra -----------------------------------

rmse_fold <- function(pliegue, form, datos, nn_size){
  pliegue_logic <- seq_len(nrow(datos)) %in% pliegue
  prueba <- subset(datos, pliegue_logic)
  entrena <- subset(datos, !pliegue_logic)
  modelo <- nnet(form, data = entrena, size = nn_size, linout = TRUE, trace = FALSE)
  response_name <- setdiff(names(datos), modelo$coefnames)
  Y_pronosticado <- predict(modelo, newdata = prueba)
  rmse <- RMSE(Y_pronosticado, prueba[[response_name]])
  rmse
}

calcula_rmse_tam <- function(tamano_muestral){
  indices_muestra <- seq_len(nrow(SB11_20111)) %in% sample(seq_len(nrow(SB11_20111)), tamano_muestral)
  
  muestra <- subset(SB11_20111, subset = indices_muestra, select = variables)
  muestra <- na.omit(muestra)
  
  createFolds(muestra$MATEMATICAS_PUNT, k = n_pliegues) -> pliegues
  
  lapply(
    pliegues,
    rmse_fold,
    MATEMATICAS_PUNT ~ .,
    muestra,
    nn_size = neuronas
  ) -> rmse_pliegues
  
  rmse_pliegues <- unlist(rmse_pliegues)
  mean(rmse_pliegues)
  
}
#red neuronal

tamano_muestral_max <- 2000
tamano_muestral <- floor(seq(500, tamano_muestral_max, length.out = iteraciones))
neuronas <- 10
n_pliegues <- 4

c(
  'ECON_PERSONAS_HOGAR',
  'ECON_CUARTOS',
  'ECON_SN_LAVADORA',
  'ECON_SN_NEVERA',
  'ECON_SN_HORNO',
  'ECON_SN_DVD',
  'ECON_SN_MICROHONDAS',
  'ECON_SN_AUTOMOVIL',
  'MATEMATICAS_PUNT'
) -> variables

mclapply(
  tamano_muestral,
  calcula_rmse_tam,
  mc.cores = 1
) ->rmse_por_tam

rmse_por_tam <- unlist(rmse_por_tam)

plot(tamano_muestral, rmse_por_tam, ylim = c(0, 14))
#abline(h = mean(rmse_pliegues), col =2, lwd = 2)