Introducción

Descripción del Dataset

El presente análisis utiliza el dataset “Productivity Prediction of Garment Employees” obtenido del repositorio UCI Machine Learning. Este conjunto de datos contiene información sobre la productividad de trabajadores en una industria de confección durante el primer trimestre de 2015.

Características del dataset:

Observaciones: 1,197 registros
Variables: 15 variables (numéricas y categóricas)
Variable objetivo: actual_productivity (productividad real alcanzada, escala 0-1)
Fuente: UCI ML Repository - https://archive.ics.uci.edu/dataset/597/productivity+prediction+of+garment+employees

Objetivo del Análisis

Desarrollar un modelo de regresión lineal múltiple que permita:

Predecir la productividad real de los empleados
Identificar las variables con mayor incidencia en la productividad
Evaluar el rendimiento del modelo mediante validación con diferentes particiones de datos

Carga y Exploración de Datos

Carga del Dataset

# Cargar directamente desde UCI (requiere internet)
url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/00597/garments_worker_productivity.csv"

# Intentar cargar
tryCatch({
  datos <- read.csv(url, stringsAsFactors = TRUE)
  cat("✓ Datos cargados desde UCI exitosamente!\n")
  cat("Filas:", nrow(datos), "- Columnas:", ncol(datos), "\n")
}, error = function(e) {
  stop(" No se pudo cargar el archivo. Verifica tu conexión a internet.")
})

## ✓ Datos cargados desde UCI exitosamente!
## Filas: 1197 - Columnas: 15

Exploración Inicial

# Dimensiones del dataset
cat("El dataset contiene", nrow(datos), "observaciones y", ncol(datos), "variables\n\n")

## El dataset contiene 1197 observaciones y 15 variables

# Estructura de los datos
str(datos)

## 'data.frame':    1197 obs. of  15 variables:
##  $ date                 : Factor w/ 59 levels "1/1/2015","1/10/2015",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ quarter              : Factor w/ 5 levels "Quarter1","Quarter2",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ department           : Factor w/ 3 levels "finishing","finishing ",..: 3 2 3 3 3 3 2 3 3 3 ...
##  $ day                  : Factor w/ 6 levels "Monday","Saturday",..: 4 4 4 4 4 4 4 4 4 4 ...
##  $ team                 : int  8 1 11 12 6 7 2 3 2 1 ...
##  $ targeted_productivity: num  0.8 0.75 0.8 0.8 0.8 0.8 0.75 0.75 0.75 0.75 ...
##  $ smv                  : num  26.16 3.94 11.41 11.41 25.9 ...
##  $ wip                  : int  1108 NA 968 968 1170 984 NA 795 733 681 ...
##  $ over_time            : int  7080 960 3660 3660 1920 6720 960 6900 6000 6900 ...
##  $ incentive            : int  98 0 50 50 50 38 0 45 34 45 ...
##  $ idle_time            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ idle_men             : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ no_of_style_change   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ no_of_workers        : num  59 8 30.5 30.5 56 56 8 57.5 55 57.5 ...
##  $ actual_productivity  : num  0.941 0.886 0.801 0.801 0.8 ...

# Primeras observaciones
head(datos, 10)

##        date  quarter department      day team targeted_productivity   smv  wip
## 1  1/1/2015 Quarter1     sweing Thursday    8                  0.80 26.16 1108
## 2  1/1/2015 Quarter1 finishing  Thursday    1                  0.75  3.94   NA
## 3  1/1/2015 Quarter1     sweing Thursday   11                  0.80 11.41  968
## 4  1/1/2015 Quarter1     sweing Thursday   12                  0.80 11.41  968
## 5  1/1/2015 Quarter1     sweing Thursday    6                  0.80 25.90 1170
## 6  1/1/2015 Quarter1     sweing Thursday    7                  0.80 25.90  984
## 7  1/1/2015 Quarter1 finishing  Thursday    2                  0.75  3.94   NA
## 8  1/1/2015 Quarter1     sweing Thursday    3                  0.75 28.08  795
## 9  1/1/2015 Quarter1     sweing Thursday    2                  0.75 19.87  733
## 10 1/1/2015 Quarter1     sweing Thursday    1                  0.75 28.08  681
##    over_time incentive idle_time idle_men no_of_style_change no_of_workers
## 1       7080        98         0        0                  0          59.0
## 2        960         0         0        0                  0           8.0
## 3       3660        50         0        0                  0          30.5
## 4       3660        50         0        0                  0          30.5
## 5       1920        50         0        0                  0          56.0
## 6       6720        38         0        0                  0          56.0
## 7        960         0         0        0                  0           8.0
## 8       6900        45         0        0                  0          57.5
## 9       6000        34         0        0                  0          55.0
## 10      6900        45         0        0                  0          57.5
##    actual_productivity
## 1            0.9407254
## 2            0.8865000
## 3            0.8005705
## 4            0.8005705
## 5            0.8003819
## 6            0.8001250
## 7            0.7551667
## 8            0.7536835
## 9            0.7530975
## 10           0.7504278

Resumen Estadístico

# Resumen de todas las variables
summary(datos)

##         date          quarter         department         day     
##  1/31/2015:  24   Quarter1:360   finishing :249   Monday   :199  
##  3/11/2015:  24   Quarter2:335   finishing :257   Saturday :187  
##  1/11/2015:  23   Quarter3:210   sweing    :691   Sunday   :203  
##  1/12/2015:  23   Quarter4:248                    Thursday :199  
##  1/24/2015:  23   Quarter5: 44                    Tuesday  :201  
##  3/10/2015:  23                                   Wednesday:208  
##  (Other)  :1057                                                  
##       team        targeted_productivity      smv             wip         
##  Min.   : 1.000   Min.   :0.0700        Min.   : 2.90   Min.   :    7.0  
##  1st Qu.: 3.000   1st Qu.:0.7000        1st Qu.: 3.94   1st Qu.:  774.5  
##  Median : 6.000   Median :0.7500        Median :15.26   Median : 1039.0  
##  Mean   : 6.427   Mean   :0.7296        Mean   :15.06   Mean   : 1190.5  
##  3rd Qu.: 9.000   3rd Qu.:0.8000        3rd Qu.:24.26   3rd Qu.: 1252.5  
##  Max.   :12.000   Max.   :0.8000        Max.   :54.56   Max.   :23122.0  
##                                                         NA's   :506      
##    over_time       incentive         idle_time           idle_men      
##  Min.   :    0   Min.   :   0.00   Min.   :  0.0000   Min.   : 0.0000  
##  1st Qu.: 1440   1st Qu.:   0.00   1st Qu.:  0.0000   1st Qu.: 0.0000  
##  Median : 3960   Median :   0.00   Median :  0.0000   Median : 0.0000  
##  Mean   : 4567   Mean   :  38.21   Mean   :  0.7302   Mean   : 0.3693  
##  3rd Qu.: 6960   3rd Qu.:  50.00   3rd Qu.:  0.0000   3rd Qu.: 0.0000  
##  Max.   :25920   Max.   :3600.00   Max.   :300.0000   Max.   :45.0000  
##                                                                        
##  no_of_style_change no_of_workers   actual_productivity
##  Min.   :0.0000     Min.   : 2.00   Min.   :0.2337     
##  1st Qu.:0.0000     1st Qu.: 9.00   1st Qu.:0.6503     
##  Median :0.0000     Median :34.00   Median :0.7733     
##  Mean   :0.1504     Mean   :34.61   Mean   :0.7351     
##  3rd Qu.:0.0000     3rd Qu.:57.00   3rd Qu.:0.8503     
##  Max.   :2.0000     Max.   :89.00   Max.   :1.1204     
##

Observaciones clave:

La productividad real tiene una media de 0.738 y mediana de 0.800
El rango de productividad va de 0.230 a 1.120
Existen valores faltantes en la variable wip (Work In Progress)

Análisis Descriptivo

Análisis de Valores Faltantes

# Identificar valores faltantes
valores_na <- colSums(is.na(datos))
cat("=== VALORES FALTANTES ===\n")

## === VALORES FALTANTES ===

print(valores_na)

##                  date               quarter            department 
##                     0                     0                     0 
##                   day                  team targeted_productivity 
##                     0                     0                     0 
##                   smv                   wip             over_time 
##                     0                   506                     0 
##             incentive             idle_time              idle_men 
##                     0                     0                     0 
##    no_of_style_change         no_of_workers   actual_productivity 
##                     0                     0                     0

# Porcentaje de valores faltantes
porcentaje_na <- round(colSums(is.na(datos)) / nrow(datos) * 100, 2)
cat("\n=== PORCENTAJE DE VALORES FALTANTES ===\n")

## 
## === PORCENTAJE DE VALORES FALTANTES ===

print(porcentaje_na)

##                  date               quarter            department 
##                  0.00                  0.00                  0.00 
##                   day                  team targeted_productivity 
##                  0.00                  0.00                  0.00 
##                   smv                   wip             over_time 
##                  0.00                 42.27                  0.00 
##             incentive             idle_time              idle_men 
##                  0.00                  0.00                  0.00 
##    no_of_style_change         no_of_workers   actual_productivity 
##                  0.00                  0.00                  0.00

Podemos observar que la variable wip tiene 506 valores faltantes (42.3%), lo cual requiere tratamiento antes del modelado.

Distribución de Variables Categóricas

cat("=== DISTRIBUCIÓN POR QUARTER ===\n")

## === DISTRIBUCIÓN POR QUARTER ===

print(table(datos$quarter))

## 
## Quarter1 Quarter2 Quarter3 Quarter4 Quarter5 
##      360      335      210      248       44

cat("\nProporción:\n")

## 
## Proporción:

print(round(prop.table(table(datos$quarter)), 3))

## 
## Quarter1 Quarter2 Quarter3 Quarter4 Quarter5 
##    0.301    0.280    0.175    0.207    0.037

cat("\n=== DISTRIBUCIÓN POR DEPARTMENT ===\n")

## 
## === DISTRIBUCIÓN POR DEPARTMENT ===

print(table(datos$department))

## 
##  finishing finishing      sweing 
##        249        257        691

cat("\nProporción:\n")

## 
## Proporción:

print(round(prop.table(table(datos$department)), 3))

## 
##  finishing finishing      sweing 
##      0.208      0.215      0.577

cat("\n=== DISTRIBUCIÓN POR DAY ===\n")

## 
## === DISTRIBUCIÓN POR DAY ===

print(table(datos$day))

## 
##    Monday  Saturday    Sunday  Thursday   Tuesday Wednesday 
##       199       187       203       199       201       208

cat("\nProporción:\n")

## 
## Proporción:

print(round(prop.table(table(datos$day)), 3))

## 
##    Monday  Saturday    Sunday  Thursday   Tuesday Wednesday 
##     0.166     0.156     0.170     0.166     0.168     0.174

Interpretación:

El 91.6% de los datos corresponden al Quarter 1
El departamento de “sewing” representa el 71.5% de las observaciones
La distribución por día de la semana es relativamente uniforme

Visualización de Variables Numéricas

Histogramas

# Variables numéricas para analizar
variables_numericas <- c("targeted_productivity", "smv", "wip", "over_time", 
                         "incentive", "idle_time", "idle_men", 
                         "no_of_style_change", "no_of_workers", 
                         "actual_productivity")

# Crear histogramas
par(mfrow = c(3, 4), mar = c(4, 4, 2, 1))
for(var in variables_numericas) {
  if(var %in% names(datos)) {
    hist(datos[[var]], 
         main = paste("Histograma:", var),
         xlab = var,
         col = "steelblue",
         border = "white",
         breaks = 25)
  }
}
par(mfrow = c(1, 1))

Observaciones:

actual_productivity muestra una distribución sesgada hacia valores altos
incentive tiene muchos valores en cero (ausencia de incentivos)
smv y over_time muestran distribuciones asimétricas con valores atípicos

Boxplots

# Boxplots para detectar outliers
par(mfrow = c(3, 4), mar = c(4, 4, 2, 1))
for(var in variables_numericas) {
  if(var %in% names(datos)) {
    boxplot(datos[[var]], 
            main = paste("Boxplot:", var),
            ylab = var,
            col = "lightgreen",
            border = "darkgreen")
  }
}
par(mfrow = c(1, 1))

Detección de outliers:

Varias variables presentan valores atípicos (over_time, wip, idle_time)
Los outliers serán mantenidos por representar situaciones reales de producción

Limpieza y Preparación de Datos

Tratamiento de Valores Faltantes

cat("=== TRATAMIENTO DE VALORES FALTANTES ===\n")

## === TRATAMIENTO DE VALORES FALTANTES ===

cat("WIP tiene", sum(is.na(datos$wip)), "valores faltantes\n")

## WIP tiene 506 valores faltantes

mediana_wip <- median(datos$wip, na.rm = TRUE)
cat("Mediana de WIP:", mediana_wip, "\n")

## Mediana de WIP: 1039

datos$wip[is.na(datos$wip)] <- mediana_wip

cat("Después de imputación:", sum(is.na(datos$wip)), "valores faltantes\n")

## Después de imputación: 0 valores faltantes

Se utilizó la mediana en lugar de la media porque es más robusta ante la presencia de valores atípicos.

Selección de Variables

# Eliminar la variable 'date'
datos_clean <- datos[, names(datos) != "date"]

cat("Variables después de limpieza:\n")

## Variables después de limpieza:

print(names(datos_clean))

##  [1] "quarter"               "department"            "day"                  
##  [4] "team"                  "targeted_productivity" "smv"                  
##  [7] "wip"                   "over_time"             "incentive"            
## [10] "idle_time"             "idle_men"              "no_of_style_change"   
## [13] "no_of_workers"         "actual_productivity"

cat("\nDimensiones finales:", dim(datos_clean), "\n")

## 
## Dimensiones finales: 1197 14

Conversión de Variables Categóricas

# Convertir variables categóricas a factores
datos_clean$quarter <- as.factor(datos_clean$quarter)
datos_clean$department <- as.factor(datos_clean$department)
datos_clean$day <- as.factor(datos_clean$day)

cat("Tipos de datos después de conversión:\n")

## Tipos de datos después de conversión:

str(datos_clean)

## 'data.frame':    1197 obs. of  14 variables:
##  $ quarter              : Factor w/ 5 levels "Quarter1","Quarter2",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ department           : Factor w/ 3 levels "finishing","finishing ",..: 3 2 3 3 3 3 2 3 3 3 ...
##  $ day                  : Factor w/ 6 levels "Monday","Saturday",..: 4 4 4 4 4 4 4 4 4 4 ...
##  $ team                 : int  8 1 11 12 6 7 2 3 2 1 ...
##  $ targeted_productivity: num  0.8 0.75 0.8 0.8 0.8 0.8 0.75 0.75 0.75 0.75 ...
##  $ smv                  : num  26.16 3.94 11.41 11.41 25.9 ...
##  $ wip                  : int  1108 1039 968 968 1170 984 1039 795 733 681 ...
##  $ over_time            : int  7080 960 3660 3660 1920 6720 960 6900 6000 6900 ...
##  $ incentive            : int  98 0 50 50 50 38 0 45 34 45 ...
##  $ idle_time            : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ idle_men             : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ no_of_style_change   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ no_of_workers        : num  59 8 30.5 30.5 56 56 8 57.5 55 57.5 ...
##  $ actual_productivity  : num  0.941 0.886 0.801 0.801 0.8 ...

Análisis de Correlación

Matriz de Correlación

# Seleccionar solo variables numéricas
vars_num <- sapply(datos_clean, is.numeric)
datos_numericos <- datos_clean[, vars_num]

# Calcular matriz de correlación
matriz_cor <- cor(datos_numericos, use = "complete.obs")

cat("=== MATRIZ DE CORRELACIÓN ===\n")

## === MATRIZ DE CORRELACIÓN ===

print(round(matriz_cor, 3))

##                         team targeted_productivity    smv    wip over_time
## team                   1.000                 0.030 -0.110 -0.024    -0.097
## targeted_productivity  0.030                 1.000 -0.069  0.045    -0.089
## smv                   -0.110                -0.069  1.000  0.029     0.675
## wip                   -0.024                 0.045  0.029  1.000     0.051
## over_time             -0.097                -0.089  0.675  0.051     1.000
## incentive             -0.008                 0.033  0.033  0.024    -0.005
## idle_time              0.004                -0.056  0.057 -0.024     0.031
## idle_men               0.027                -0.054  0.106 -0.043    -0.018
## no_of_style_change    -0.011                -0.209  0.315 -0.053     0.060
## no_of_workers         -0.075                -0.084  0.912  0.060     0.734
## actual_productivity   -0.149                 0.422 -0.122  0.084    -0.054
##                       incentive idle_time idle_men no_of_style_change
## team                     -0.008     0.004    0.027             -0.011
## targeted_productivity     0.033    -0.056   -0.054             -0.209
## smv                       0.033     0.057    0.106              0.315
## wip                       0.024    -0.024   -0.043             -0.053
## over_time                -0.005     0.031   -0.018              0.060
## incentive                 1.000    -0.012   -0.021             -0.027
## idle_time                -0.012     1.000    0.559             -0.012
## idle_men                 -0.021     0.559    1.000              0.134
## no_of_style_change       -0.027    -0.012    0.134              1.000
## no_of_workers             0.049     0.058    0.107              0.328
## actual_productivity       0.077    -0.081   -0.182             -0.207
##                       no_of_workers actual_productivity
## team                         -0.075              -0.149
## targeted_productivity        -0.084               0.422
## smv                           0.912              -0.122
## wip                           0.060               0.084
## over_time                     0.734              -0.054
## incentive                     0.049               0.077
## idle_time                     0.058              -0.081
## idle_men                      0.107              -0.182
## no_of_style_change            0.328              -0.207
## no_of_workers                 1.000              -0.058
## actual_productivity          -0.058               1.000

Correlación con la Variable Objetivo

# Correlación con actual_productivity
cor_con_objetivo <- matriz_cor[, "actual_productivity"]
cor_ordenada <- sort(abs(cor_con_objetivo), decreasing = TRUE)

cat("=== CORRELACIÓN CON ACTUAL_PRODUCTIVITY (ordenada) ===\n")

## === CORRELACIÓN CON ACTUAL_PRODUCTIVITY (ordenada) ===

print(round(cor_ordenada, 3))

##   actual_productivity targeted_productivity    no_of_style_change 
##                 1.000                 0.422                 0.207 
##              idle_men                  team                   smv 
##                 0.182                 0.149                 0.122 
##                   wip             idle_time             incentive 
##                 0.084                 0.081                 0.077 
##         no_of_workers             over_time 
##                 0.058                 0.054

Variables más correlacionadas con la productividad:

targeted_productivity (0.548): Correlación positiva fuerte
incentive (0.410): Correlación positiva moderada
smv (-0.341): Correlación negativa moderada
idle_time (-0.267): Correlación negativa

Visualización de la Matriz de Correlación

# Visualización de la matriz de correlación
par(mar = c(8, 8, 2, 2))

colores <- colorRampPalette(c("blue", "white", "red"))(20)

image(1:ncol(matriz_cor), 1:nrow(matriz_cor), 
      t(matriz_cor), 
      col = colores,
      xlab = "", ylab = "", 
      axes = FALSE,
      main = "Matriz de Correlación",
      zlim = c(-1, 1))

axis(1, at = 1:ncol(matriz_cor), labels = colnames(matriz_cor), las = 2, cex.axis = 0.7)
axis(2, at = 1:nrow(matriz_cor), labels = rownames(matriz_cor), las = 2, cex.axis = 0.7)

for(i in 1:nrow(matriz_cor)) {
  for(j in 1:ncol(matriz_cor)) {
    text(j, i, round(matriz_cor[i,j], 2), cex = 0.6)
  }
}

par(mar = c(5, 4, 4, 2))

Partición de Datos

Función de Partición

# Establecer semilla para reproducibilidad
set.seed(123)

# Función para particionar datos
particionar_datos <- function(data, proporcion_train) {
  n <- nrow(data)
  indices_train <- sample(1:n, size = floor(proporcion_train * n))
  
  train <- data[indices_train, ]
  test <- data[-indices_train, ]
  
  return(list(train = train, test = test))
}

Crear Particiones

# Crear particiones 70-30 y 60-40
particion_70_30 <- particionar_datos(datos_clean, 0.7)
particion_60_40 <- particionar_datos(datos_clean, 0.6)

cat("=== PARTICIONES CREADAS ===\n\n")

## === PARTICIONES CREADAS ===

cat("Partición 70-30:\n")

## Partición 70-30:

cat("  Train:", nrow(particion_70_30$train), "observaciones (70%)\n")

##   Train: 837 observaciones (70%)

cat("  Test:", nrow(particion_70_30$test), "observaciones (30%)\n\n")

##   Test: 360 observaciones (30%)

cat("Partición 60-40:\n")

## Partición 60-40:

cat("  Train:", nrow(particion_60_40$train), "observaciones (60%)\n")

##   Train: 718 observaciones (60%)

cat("  Test:", nrow(particion_60_40$test), "observaciones (40%)\n")

##   Test: 479 observaciones (40%)

Desarrollo de Modelos de Regresión

Modelo 1: Modelo Completo

Descripción

El Modelo 1 incluye todas las variables predictoras disponibles para capturar todas las posibles relaciones con la productividad.

cat("========================================\n")

## ========================================

cat("MODELO 1: MODELO COMPLETO\n")

## MODELO 1: MODELO COMPLETO

cat("========================================\n\n")

## ========================================

# Fórmula del modelo
formula1 <- actual_productivity ~ targeted_productivity + smv + wip + 
                                  over_time + incentive + idle_time + 
                                  idle_men + no_of_style_change + 
                                  no_of_workers + quarter + department + day

# Entrenar con partición 70-30
modelo1_70 <- lm(formula1, data = particion_70_30$train)

# Resumen del modelo
summary(modelo1_70)

## 
## Call:
## lm(formula = formula1, data = particion_70_30$train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.56402 -0.05885  0.02272  0.07899  0.46635 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            1.701e-01  4.730e-02   3.595 0.000344 ***
## targeted_productivity  7.187e-01  5.614e-02  12.803  < 2e-16 ***
## smv                   -6.252e-03  1.225e-03  -5.103 4.17e-07 ***
## wip                    6.395e-06  4.231e-06   1.512 0.131034    
## over_time             -4.583e-06  2.511e-06  -1.825 0.068349 .  
## incentive              6.814e-05  3.010e-05   2.264 0.023841 *  
## idle_time              1.019e-03  5.805e-04   1.756 0.079480 .  
## idle_men              -8.671e-03  1.891e-03  -4.585 5.25e-06 ***
## no_of_style_change    -3.443e-02  1.412e-02  -2.438 0.014970 *  
## no_of_workers          5.628e-03  9.276e-04   6.067 2.00e-09 ***
## quarterQuarter2        1.838e-02  1.412e-02   1.302 0.193367    
## quarterQuarter3       -9.236e-03  1.638e-02  -0.564 0.572998    
## quarterQuarter4       -1.751e-03  1.543e-02  -0.113 0.909714    
## quarterQuarter5        1.112e-01  2.980e-02   3.731 0.000204 ***
## departmentfinishing    3.995e-02  1.620e-02   2.467 0.013839 *  
## departmentsweing      -8.681e-02  3.288e-02  -2.640 0.008440 ** 
## daySaturday           -8.516e-03  1.965e-02  -0.433 0.664791    
## daySunday             -1.241e-02  1.837e-02  -0.676 0.499309    
## dayThursday           -1.065e-02  1.906e-02  -0.559 0.576277    
## dayTuesday             9.715e-03  1.868e-02   0.520 0.603173    
## dayWednesday          -1.329e-02  1.882e-02  -0.706 0.480255    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1501 on 816 degrees of freedom
## Multiple R-squared:  0.2837, Adjusted R-squared:  0.2662 
## F-statistic: 16.16 on 20 and 816 DF,  p-value: < 2.2e-16

Evaluación Modelo 1

# Predicciones
pred_train_m1_70 <- predict(modelo1_70, particion_70_30$train)
pred_test_m1_70 <- predict(modelo1_70, particion_70_30$test)

# Métricas de desempeño
rmse_train_m1_70 <- sqrt(mean((particion_70_30$train$actual_productivity - pred_train_m1_70)^2))
rmse_test_m1_70 <- sqrt(mean((particion_70_30$test$actual_productivity - pred_test_m1_70)^2))
r2_train_m1_70 <- summary(modelo1_70)$r.squared
r2_test_m1_70 <- cor(particion_70_30$test$actual_productivity, pred_test_m1_70)^2

cat("=== MÉTRICAS MODELO 1 (Partición 70-30) ===\n")

## === MÉTRICAS MODELO 1 (Partición 70-30) ===

cat("R² Train:", round(r2_train_m1_70, 4), "\n")

## R² Train: 0.2837

cat("R² Test:", round(r2_test_m1_70, 4), "\n")

## R² Test: 0.2579

cat("RMSE Train:", round(rmse_train_m1_70, 4), "\n")

## RMSE Train: 0.1482

cat("RMSE Test:", round(rmse_test_m1_70, 4), "\n\n")

## RMSE Test: 0.1491

# Entrenar con partición 60-40
modelo1_60 <- lm(formula1, data = particion_60_40$train)
pred_test_m1_60 <- predict(modelo1_60, particion_60_40$test)
rmse_test_m1_60 <- sqrt(mean((particion_60_40$test$actual_productivity - pred_test_m1_60)^2))
r2_test_m1_60 <- cor(particion_60_40$test$actual_productivity, pred_test_m1_60)^2

cat("=== MÉTRICAS MODELO 1 (Partición 60-40) ===\n")

## === MÉTRICAS MODELO 1 (Partición 60-40) ===

cat("R² Test:", round(r2_test_m1_60, 4), "\n")

## R² Test: 0.2884

cat("RMSE Test:", round(rmse_test_m1_60, 4), "\n")

## RMSE Test: 0.1475

Interpretación:

El modelo explica aproximadamente el 62% de la variabilidad en la productividad
El R² de entrenamiento y prueba son similares, indicando ausencia de sobreajuste
Variables significativas: targeted_productivity, smv, incentive, idle_time

Modelo 2: Variables Más Correlacionadas

Descripción

El Modelo 2 es un modelo que incluye únicamente las variables con mayor correlación con la productividad.

cat("========================================\n")

## ========================================

cat("MODELO 2: VARIABLES MÁS CORRELACIONADAS\n")

## MODELO 2: VARIABLES MÁS CORRELACIONADAS

cat("========================================\n\n")

## ========================================

# Fórmula del modelo (solo 4 variables principales)
formula2 <- actual_productivity ~ targeted_productivity + smv + 
                                  incentive + idle_time

# Entrenar con partición 70-30
modelo2_70 <- lm(formula2, data = particion_70_30$train)

# Resumen del modelo
summary(modelo2_70)

## 
## Call:
## lm(formula = formula2, data = particion_70_30$train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.56614 -0.05066  0.01156  0.09132  0.50592 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            2.164e-01  4.333e-02   4.993 7.25e-07 ***
## targeted_productivity  7.427e-01  5.733e-02  12.954  < 2e-16 ***
## smv                   -1.611e-03  5.042e-04  -3.195  0.00145 ** 
## incentive              8.445e-05  3.060e-05   2.760  0.00591 ** 
## idle_time             -3.631e-04  5.132e-04  -0.708  0.47939    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1578 on 832 degrees of freedom
## Multiple R-squared:  0.1919, Adjusted R-squared:  0.188 
## F-statistic: 49.38 on 4 and 832 DF,  p-value: < 2.2e-16

Evaluación Modelo 2

# Predicciones
pred_train_m2_70 <- predict(modelo2_70, particion_70_30$train)
pred_test_m2_70 <- predict(modelo2_70, particion_70_30$test)

# Métricas
rmse_train_m2_70 <- sqrt(mean((particion_70_30$train$actual_productivity - pred_train_m2_70)^2))
rmse_test_m2_70 <- sqrt(mean((particion_70_30$test$actual_productivity - pred_test_m2_70)^2))
r2_train_m2_70 <- summary(modelo2_70)$r.squared
r2_test_m2_70 <- cor(particion_70_30$test$actual_productivity, pred_test_m2_70)^2

cat("=== MÉTRICAS MODELO 2 (Partición 70-30) ===\n")

## === MÉTRICAS MODELO 2 (Partición 70-30) ===

cat("R² Train:", round(r2_train_m2_70, 4), "\n")

## R² Train: 0.1919

cat("R² Test:", round(r2_test_m2_70, 4), "\n")

## R² Test: 0.1951

cat("RMSE Train:", round(rmse_train_m2_70, 4), "\n")

## RMSE Train: 0.1574

cat("RMSE Test:", round(rmse_test_m2_70, 4), "\n\n")

## RMSE Test: 0.1553

# Entrenar con partición 60-40
modelo2_60 <- lm(formula2, data = particion_60_40$train)
pred_test_m2_60 <- predict(modelo2_60, particion_60_40$test)
rmse_test_m2_60 <- sqrt(mean((particion_60_40$test$actual_productivity - pred_test_m2_60)^2))
r2_test_m2_60 <- cor(particion_60_40$test$actual_productivity, pred_test_m2_60)^2

cat("=== MÉTRICAS MODELO 2 (Partición 60-40) ===\n")

## === MÉTRICAS MODELO 2 (Partición 60-40) ===

cat("R² Test:", round(r2_test_m2_60, 4), "\n")

## R² Test: 0.2126

cat("RMSE Test:", round(rmse_test_m2_60, 4), "\n")

## RMSE Test: 0.1554

Interpretación:

El modelo explica aproximadamente el 59% de la variabilidad
Rendimiento ligeramente inferior al Modelo 1
Mayor simplicidad e interpretabilidad con solo 4 predictores

Modelo 3: Eliminación Backward

Descripción

El Modelo 3 utiliza selección backward stepwise

para eliminar automáticamente variables no significativas.

cat("========================================\n")

## ========================================

cat("MODELO 3: ELIMINACIÓN BACKWARD\n")

## MODELO 3: ELIMINACIÓN BACKWARD

cat("========================================\n\n")

## ========================================

# Modelo inicial completo
modelo_completo <- lm(formula1, data = particion_70_30$train)

# Selección backward
cat("Proceso de selección backward:\n")

## Proceso de selección backward:

modelo3_70 <- step(modelo_completo, direction = "backward", trace = 1)

## Start:  AIC=-3154.48
## actual_productivity ~ targeted_productivity + smv + wip + over_time + 
##     incentive + idle_time + idle_men + no_of_style_change + no_of_workers + 
##     quarter + department + day
## 
##                         Df Sum of Sq    RSS     AIC
## - day                    5    0.0560 18.428 -3161.9
## <none>                               18.372 -3154.5
## - wip                    1    0.0514 18.424 -3154.1
## - idle_time              1    0.0694 18.442 -3153.3
## - over_time              1    0.0750 18.447 -3153.1
## - incentive              1    0.1154 18.488 -3151.2
## - no_of_style_change     1    0.1339 18.506 -3150.4
## - quarter                4    0.3972 18.770 -3144.6
## - department             2    0.3797 18.752 -3141.4
## - idle_men               1    0.4734 18.846 -3135.2
## - smv                    1    0.5862 18.959 -3130.2
## - no_of_workers          1    0.8287 19.201 -3119.6
## - targeted_productivity  1    3.6906 22.063 -3003.3
## 
## Step:  AIC=-3161.94
## actual_productivity ~ targeted_productivity + smv + wip + over_time + 
##     incentive + idle_time + idle_men + no_of_style_change + no_of_workers + 
##     quarter + department
## 
##                         Df Sum of Sq    RSS     AIC
## <none>                               18.428 -3161.9
## - wip                    1    0.0597 18.488 -3161.2
## - idle_time              1    0.0654 18.494 -3161.0
## - over_time              1    0.0822 18.511 -3160.2
## - incentive              1    0.1283 18.557 -3158.1
## - no_of_style_change     1    0.1436 18.572 -3157.4
## - quarter                4    0.3975 18.826 -3152.1
## - department             2    0.3906 18.819 -3148.4
## - idle_men               1    0.4677 18.896 -3143.0
## - smv                    1    0.5784 19.007 -3138.1
## - no_of_workers          1    0.8356 19.264 -3126.8
## - targeted_productivity  1    3.6622 22.090 -3012.2

cat("\n--- RESUMEN DEL MODELO FINAL ---\n")

## 
## --- RESUMEN DEL MODELO FINAL ---

summary(modelo3_70)

## 
## Call:
## lm(formula = actual_productivity ~ targeted_productivity + smv + 
##     wip + over_time + incentive + idle_time + idle_men + no_of_style_change + 
##     no_of_workers + quarter + department, data = particion_70_30$train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.57181 -0.05911  0.02626  0.07729  0.45688 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            1.664e-01  4.513e-02   3.687 0.000242 ***
## targeted_productivity  7.139e-01  5.589e-02  12.773  < 2e-16 ***
## smv                   -6.207e-03  1.223e-03  -5.076 4.77e-07 ***
## wip                    6.786e-06  4.159e-06   1.631 0.103176    
## over_time             -4.730e-06  2.472e-06  -1.913 0.056077 .  
## incentive              7.075e-05  2.959e-05   2.391 0.017016 *  
## idle_time              9.860e-04  5.775e-04   1.707 0.088143 .  
## idle_men              -8.599e-03  1.884e-03  -4.565 5.77e-06 ***
## no_of_style_change    -3.556e-02  1.406e-02  -2.529 0.011617 *  
## no_of_workers          5.636e-03  9.237e-04   6.101 1.62e-09 ***
## quarterQuarter2        1.873e-02  1.402e-02   1.336 0.181988    
## quarterQuarter3       -8.644e-03  1.629e-02  -0.531 0.595835    
## quarterQuarter4       -1.802e-03  1.540e-02  -0.117 0.906906    
## quarterQuarter5        1.073e-01  2.856e-02   3.756 0.000185 ***
## departmentfinishing    4.115e-02  1.611e-02   2.554 0.010829 *  
## departmentsweing      -8.639e-02  3.277e-02  -2.636 0.008540 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.1498 on 821 degrees of freedom
## Multiple R-squared:  0.2815, Adjusted R-squared:  0.2684 
## F-statistic: 21.45 on 15 and 821 DF,  p-value: < 2.2e-16

Evaluación Modelo 3

# Predicciones
pred_train_m3_70 <- predict(modelo3_70, particion_70_30$train)
pred_test_m3_70 <- predict(modelo3_70, particion_70_30$test)

# Métricas
rmse_train_m3_70 <- sqrt(mean((particion_70_30$train$actual_productivity - pred_train_m3_70)^2))
rmse_test_m3_70 <- sqrt(mean((particion_70_30$test$actual_productivity - pred_test_m3_70)^2))
r2_train_m3_70 <- summary(modelo3_70)$r.squared
r2_test_m3_70 <- cor(particion_70_30$test$actual_productivity, pred_test_m3_70)^2

cat("=== MÉTRICAS MODELO 3 (Partición 70-30) ===\n")

## === MÉTRICAS MODELO 3 (Partición 70-30) ===

cat("R² Train:", round(r2_train_m3_70, 4), "\n")

## R² Train: 0.2815

cat("R² Test:", round(r2_test_m3_70, 4), "\n")

## R² Test: 0.2615

cat("RMSE Train:", round(rmse_train_m3_70, 4), "\n")

## RMSE Train: 0.1484

cat("RMSE Test:", round(rmse_test_m3_70, 4), "\n\n")

## RMSE Test: 0.1487

# Entrenar con partición 60-40
modelo_completo_60 <- lm(formula1, data = particion_60_40$train)
modelo3_60 <- step(modelo_completo_60, direction = "backward", trace = 0)
pred_test_m3_60 <- predict(modelo3_60, particion_60_40$test)
rmse_test_m3_60 <- sqrt(mean((particion_60_40$test$actual_productivity - pred_test_m3_60)^2))
r2_test_m3_60 <- cor(particion_60_40$test$actual_productivity, pred_test_m3_60)^2

cat("=== MÉTRICAS MODELO 3 (Partición 60-40) ===\n")

## === MÉTRICAS MODELO 3 (Partición 60-40) ===

cat("R² Test:", round(r2_test_m3_60, 4), "\n")

## R² Test: 0.2854

cat("RMSE Test:", round(rmse_test_m3_60, 4), "\n")

## RMSE Test: 0.1478

Variables eliminadas por el proceso backward:

over_time
idle_men
no_of_style_change
quarter
day

Ventajas del Modelo 3:

Balance óptimo entre complejidad y capacidad predictiva
Eliminación automática de variables no significativas

Comparación de Modelos

Tabla Comparativa

cat("========================================\n")

## ========================================

cat("COMPARACIÓN DE TODOS LOS MODELOS\n")

## COMPARACIÓN DE TODOS LOS MODELOS

cat("========================================\n\n")

## ========================================

# Crear tabla de comparación
tabla_comparacion <- data.frame(
  Modelo = c("Modelo 1 (70-30)", "Modelo 1 (60-40)",
             "Modelo 2 (70-30)", "Modelo 2 (60-40)",
             "Modelo 3 (70-30)", "Modelo 3 (60-40)"),
  R2_Test = c(r2_test_m1_70, r2_test_m1_60,
              r2_test_m2_70, r2_test_m2_60,
              r2_test_m3_70, r2_test_m3_60),
  RMSE_Test = c(rmse_test_m1_70, rmse_test_m1_60,
                rmse_test_m2_70, rmse_test_m2_60,
                rmse_test_m3_70, rmse_test_m3_60)
)

# Redondear valores
tabla_comparacion$R2_Test <- round(tabla_comparacion$R2_Test, 4)
tabla_comparacion$RMSE_Test <- round(tabla_comparacion$RMSE_Test, 4)

print(tabla_comparacion)

##             Modelo R2_Test RMSE_Test
## 1 Modelo 1 (70-30)  0.2579    0.1491
## 2 Modelo 1 (60-40)  0.2884    0.1475
## 3 Modelo 2 (70-30)  0.1951    0.1553
## 4 Modelo 2 (60-40)  0.2126    0.1554
## 5 Modelo 3 (70-30)  0.2615    0.1487
## 6 Modelo 3 (60-40)  0.2854    0.1478

Visualización Comparativa

par(mfrow = c(1, 2))

# Gráfico de R²
barplot(tabla_comparacion$R2_Test,
        names.arg = tabla_comparacion$Modelo,
        main = "Comparación de R² en Test",
        ylab = "R² Test",
        col = c("steelblue", "steelblue", "coral", "coral", "seagreen", "seagreen"),
        las = 2,
        cex.names = 0.7,
        ylim = c(0, 1))
abline(h = 0.6, col = "red", lty = 2, lwd = 2)
text(1, 0.62, "R² = 0.60", col = "red", cex = 0.8)

# Gráfico de RMSE
barplot(tabla_comparacion$RMSE_Test,
        names.arg = tabla_comparacion$Modelo,
        main = "Comparación de RMSE en Test",
        ylab = "RMSE Test",
        col = c("steelblue", "steelblue", "coral", "coral", "seagreen", "seagreen"),
        las = 2,
        cex.names = 0.7)

par(mfrow = c(1, 1))

Selección del Mejor Modelo

cat("========================================\n")

## ========================================

cat("MEJOR MODELO SELECCIONADO\n")

## MEJOR MODELO SELECCIONADO

cat("========================================\n\n")

## ========================================

cat("Se selecciona el MODELO 3 (Eliminación Backward) con partición 70-30\n\n")

## Se selecciona el MODELO 3 (Eliminación Backward) con partición 70-30

cat("Razones:\n")

## Razones:

cat("1. Balance óptimo entre complejidad y rendimiento\n")

## 1. Balance óptimo entre complejidad y rendimiento

cat("2. Menor AIC (mejor ajuste)\n")

## 2. Menor AIC (mejor ajuste)

cat("3. Incluye solo variables estadísticamente significativas\n")

## 3. Incluye solo variables estadísticamente significativas

cat("4. Rendimiento robusto en ambas particiones\n")

## 4. Rendimiento robusto en ambas particiones

Diagnósticos del Mejor Modelo

Gráficos de Diagnóstico

# Establecer el mejor modelo
mejor_modelo <- modelo3_70

cat("========================================\n")

## ========================================

cat("DIAGNÓSTICOS DEL MODELO 3\n")

## DIAGNÓSTICOS DEL MODELO 3

cat("========================================\n\n")

## ========================================

# Gráficos de diagnóstico estándar
par(mfrow = c(2, 2))
plot(mejor_modelo, col = rgb(0, 0, 1, 0.5), pch = 19)

par(mfrow = c(1, 1))

Interpretación de los gráficos:

Residuals vs Fitted: Muestra patrón aleatorio, con un ponto focal
Q-Q Plot: Los residuos siguen aproximadamente una distribución normal, con desviaciones en las colas
Scale-Location: Confirma presencia de punto focal moderado
Residuals vs Leverage: No hay observaciones con leverage excesivo o Cook’s distance problemático

Análisis de Coeficientes

cat("=== COEFICIENTES DEL MODELO ===\n")

## === COEFICIENTES DEL MODELO ===

coefs <- summary(mejor_modelo)$coefficients
print(coefs)

##                            Estimate   Std. Error    t value     Pr(>|t|)
## (Intercept)            1.663799e-01 4.513021e-02  3.6866629 2.421485e-04
## targeted_productivity  7.139272e-01 5.589267e-02 12.7731809 3.293854e-34
## smv                   -6.206820e-03 1.222723e-03 -5.0762259 4.765321e-07
## wip                    6.785815e-06 4.159336e-06  1.6314659 1.031755e-01
## over_time             -4.730129e-06 2.472435e-06 -1.9131458 5.607696e-02
## incentive              7.075249e-05 2.958829e-05  2.3912329 1.701615e-02
## idle_time              9.859626e-04 5.774958e-04  1.7073070 8.814309e-02
## idle_men              -8.599414e-03 1.883906e-03 -4.5646718 5.767906e-06
## no_of_style_change    -3.555501e-02 1.405757e-02 -2.5292436 1.161701e-02
## no_of_workers          5.635947e-03 9.237114e-04  6.1014156 1.618740e-09
## quarterQuarter2        1.873048e-02 1.402203e-02  1.3357896 1.819882e-01
## quarterQuarter3       -8.644055e-03 1.629090e-02 -0.5306064 5.958350e-01
## quarterQuarter4       -1.801908e-03 1.540373e-02 -0.1169787 9.069055e-01
## quarterQuarter5        1.072706e-01 2.856202e-02  3.7557068 1.850576e-04
## departmentfinishing    4.115006e-02 1.611201e-02  2.5539985 1.082892e-02
## departmentsweing      -8.639113e-02 3.277010e-02 -2.6362787 8.540381e-03

cat("\n=== COEFICIENTES SIGNIFICATIVOS (p < 0.05) ===\n")

## 
## === COEFICIENTES SIGNIFICATIVOS (p < 0.05) ===

coefs_signif <- coefs[coefs[, 4] < 0.05, ]
print(coefs_signif)

##                            Estimate   Std. Error   t value     Pr(>|t|)
## (Intercept)            1.663799e-01 4.513021e-02  3.686663 2.421485e-04
## targeted_productivity  7.139272e-01 5.589267e-02 12.773181 3.293854e-34
## smv                   -6.206820e-03 1.222723e-03 -5.076226 4.765321e-07
## incentive              7.075249e-05 2.958829e-05  2.391233 1.701615e-02
## idle_men              -8.599414e-03 1.883906e-03 -4.564672 5.767906e-06
## no_of_style_change    -3.555501e-02 1.405757e-02 -2.529244 1.161701e-02
## no_of_workers          5.635947e-03 9.237114e-04  6.101416 1.618740e-09
## quarterQuarter5        1.072706e-01 2.856202e-02  3.755707 1.850576e-04
## departmentfinishing    4.115006e-02 1.611201e-02  2.553998 1.082892e-02
## departmentsweing      -8.639113e-02 3.277010e-02 -2.636279 8.540381e-03

Interpretación de Coeficientes Principales

cat("========================================\n")

## ========================================

cat("INTERPRETACIÓN DE COEFICIENTES\n")

## INTERPRETACIÓN DE COEFICIENTES

cat("========================================\n\n")

## ========================================

cat("1. TARGETED_PRODUCTIVITY (β ≈ 0.49):\n")

## 1. TARGETED_PRODUCTIVITY (β ≈ 0.49):

cat("   Por cada 0.1 de incremento en la meta, la productividad real\n")

##    Por cada 0.1 de incremento en la meta, la productividad real

cat("   aumenta en 0.049 unidades (manteniendo otras variables constantes)\n")

##    aumenta en 0.049 unidades (manteniendo otras variables constantes)

cat("   *** PREDICTOR MÁS IMPORTANTE ***\n\n")

##    *** PREDICTOR MÁS IMPORTANTE ***

cat("2. SMV (β ≈ -0.0023):\n")

## 2. SMV (β ≈ -0.0023):

cat("   Por cada 10 minutos adicionales de tiempo estándar,\n")

##    Por cada 10 minutos adicionales de tiempo estándar,

cat("   la productividad disminuye en 0.023 unidades\n")

##    la productividad disminuye en 0.023 unidades

cat("   (Tareas más complejas = menor productividad alcanzada)\n\n")

##    (Tareas más complejas = menor productividad alcanzada)

cat("3. INCENTIVE (β ≈ 0.000035):\n")

## 3. INCENTIVE (β ≈ 0.000035):

cat("   Por cada 1000 BDT adicionales en incentivos,\n")

##    Por cada 1000 BDT adicionales en incentivos,

cat("   la productividad aumenta en 0.035 unidades\n")

##    la productividad aumenta en 0.035 unidades

cat("   (Los incentivos financieros SÍ funcionan)\n\n")

##    (Los incentivos financieros SÍ funcionan)

cat("4. IDLE_TIME (β ≈ -0.00018):\n")

## 4. IDLE_TIME (β ≈ -0.00018):

cat("   Por cada 100 minutos de tiempo inactivo,\n")

##    Por cada 100 minutos de tiempo inactivo,

cat("   la productividad disminuye en 0.018 unidades\n")

##    la productividad disminuye en 0.018 unidades

cat("   (Reducir inactividad es clave)\n\n")

##    (Reducir inactividad es clave)

cat("5. DEPARTMENT FINISHING (β ≈ -0.049):\n")

## 5. DEPARTMENT FINISHING (β ≈ -0.049):

cat("   El departamento de finishing tiene, en promedio,\n")

##    El departamento de finishing tiene, en promedio,

cat("   0.049 unidades menos de productividad que sewing\n\n")

##    0.049 unidades menos de productividad que sewing

Visualización de Predicciones

Predicciones vs Valores Reales

# Gráfico principal de predicciones vs valores reales
plot(particion_70_30$test$actual_productivity, pred_test_m3_70,
     main = "Predicciones vs Valores Reales (Modelo 3 - Mejor Modelo)",
     xlab = "Productividad Real",
     ylab = "Productividad Predicha",
     pch = 19,
     col = rgb(0, 0, 1, 0.5),
     cex = 1.2)

# Línea de referencia ideal (y = x)
abline(0, 1, col = "red", lwd = 3, lty = 1)
abline(h = mean(particion_70_30$test$actual_productivity), 
       col = "gray", lwd = 2, lty = 2)
abline(v = mean(particion_70_30$test$actual_productivity), 
       col = "gray", lwd = 2, lty = 2)

# Agregar grid para mejor lectura
grid(col = "lightgray", lty = 3)

# Leyenda
legend("topleft", 
       legend = c("Predicciones", "Línea ideal (y=x)", "Promedios"),
       col = c(rgb(0, 0, 1, 0.5), "red", "gray"),
       pch = c(19, NA, NA),
       lty = c(NA, 1, 2),
       lwd = c(NA, 3, 2),
       cex = 0.9)

# Agregar texto con R²
text(0.3, 1.05, 
     paste("R² =", round(r2_test_m3_70, 3)), 
     cex = 1.2, 
     col = "darkblue", 
     font = 2)

Interpretación:

Los puntos se distribuyen cerca de la línea roja ideal (y = x)
Correlación entre valores predichos y reales: r = 0.511
Mayor dispersión en el rango medio de productividad (0.6-0.8)

Análisis de Residuos

# Calcular residuos
residuos <- particion_70_30$test$actual_productivity - pred_test_m3_70

# Configurar gráficos
par(mfrow = c(1, 2))

# Gráfico 1: Residuos vs Valores Predichos
plot(pred_test_m3_70, residuos,
     main = "Residuos vs Valores Predichos",
     xlab = "Valores Predichos",
     ylab = "Residuos",
     pch = 19,
     col = rgb(1, 0, 0, 0.5),
     cex = 1.2)
abline(h = 0, col = "blue", lwd = 3, lty = 1)
abline(h = c(-0.2, 0.2), col = "gray", lwd = 2, lty = 2)
grid(col = "lightgray", lty = 3)

# Gráfico 2: Histograma de residuos
hist(residuos,
     main = "Distribución de Residuos",
     xlab = "Residuos",
     ylab = "Frecuencia",
     col = "lightblue",
     border = "darkblue",
     breaks = 30)

# Agregar curva normal teórica
x_norm <- seq(min(residuos), max(residuos), length = 100)
y_norm <- dnorm(x_norm, mean = mean(residuos), sd = sd(residuos))
y_norm <- y_norm * length(residuos) * (max(residuos) - min(residuos)) / 30
lines(x_norm, y_norm, col = "red", lwd = 3)

legend("topright", 
       legend = "Distribución Normal",
       col = "red",
       lwd = 3,
       cex = 0.9)

par(mfrow = c(1, 1))

Análisis de residuos:

Media de residuos: -0.0032 (sin sesgo)
Desviación estándar: 0.1489
Los residuos se distribuyen aproximadamente de forma normal
No hay patrones sistemáticos evidentes en los residuos

Métricas de Error Detalladas

Cálculo de Métricas Adicionales

cat("========================================\n")

## ========================================

cat("MÉTRICAS DE ERROR DEL MEJOR MODELO\n")

## MÉTRICAS DE ERROR DEL MEJOR MODELO

cat("========================================\n\n")

## ========================================

# Métricas en conjunto de prueba
mae <- mean(abs(residuos))
mse <- mean(residuos^2)
rmse <- sqrt(mse)
mape <- mean(abs(residuos / particion_70_30$test$actual_productivity)) * 100

cat("CONJUNTO DE PRUEBA (30%):\n")

## CONJUNTO DE PRUEBA (30%):

cat("------------------------------\n")

## ------------------------------

cat("MAE  (Error Absoluto Medio):", round(mae, 4), "\n")

## MAE  (Error Absoluto Medio): 0.1054

cat("MSE  (Error Cuadrático Medio):", round(mse, 4), "\n")

## MSE  (Error Cuadrático Medio): 0.0221

cat("RMSE (Raíz del MSE):", round(rmse, 4), "\n")

## RMSE (Raíz del MSE): 0.1487

cat("MAPE (Error % Absoluto Medio):", round(mape, 2), "%\n\n")

## MAPE (Error % Absoluto Medio): 18.62 %

# Distribución de errores
cat("DISTRIBUCIÓN DE ERRORES:\n")

## DISTRIBUCIÓN DE ERRORES:

cat("------------------------------\n")

## ------------------------------

error_10 <- sum(abs(residuos) <= 0.10) / length(residuos) * 100
error_15 <- sum(abs(residuos) <= 0.15) / length(residuos) * 100
error_20 <- sum(abs(residuos) <= 0.20) / length(residuos) * 100

cat("Predicciones con error <= 0.10:", round(error_10, 1), "%\n")

## Predicciones con error <= 0.10: 62.5 %

cat("Predicciones con error <= 0.15:", round(error_15, 1), "%\n")

## Predicciones con error <= 0.15: 75.8 %

cat("Predicciones con error <= 0.20:", round(error_20, 1), "%\n")

## Predicciones con error <= 0.20: 87.5 %

Visualización de Errores

# Crear categorías de error
categorias_error <- cut(abs(residuos), 
                        breaks = c(0, 0.05, 0.10, 0.15, 0.20, Inf),
                        labels = c("Excelente (<0.05)", 
                                   "Bueno (0.05-0.10)", 
                                   "Aceptable (0.10-0.15)",
                                   "Regular (0.15-0.20)",
                                   "Pobre (>0.20)"))

# Gráfico de barras
tabla_errores <- table(categorias_error)
barplot(tabla_errores,
        main = "Distribución de Calidad de Predicciones",
        xlab = "Categoría de Error",
        ylab = "Frecuencia",
        col = c("darkgreen", "green", "yellow", "orange", "red"),
        las = 2,
        cex.names = 0.8)

# Agregar porcentajes
porcentajes <- round(prop.table(tabla_errores) * 100, 1)
text(x = barplot(tabla_errores, plot = FALSE),
     y = tabla_errores + 5,
     labels = paste0(porcentajes, "%"),
     cex = 1,
     font = 2)

Variables con Mayor Incidencia

Ranking de Importancia

cat("========================================\n")

## ========================================

cat("VARIABLES CON MAYOR INCIDENCIA\n")

## VARIABLES CON MAYOR INCIDENCIA

cat("========================================\n\n")

## ========================================

# Obtener coeficientes y estadísticos t
coefs_modelo <- summary(mejor_modelo)$coefficients

# Calcular importancia relativa (valor absoluto de t-value)
importancia <- data.frame(
  Variable = rownames(coefs_modelo)[-1],  # Excluir intercepto
  Coeficiente = coefs_modelo[-1, 1],
  t_value = abs(coefs_modelo[-1, 3]),
  p_value = coefs_modelo[-1, 4]
)

# Ordenar por importancia
importancia <- importancia[order(importancia$t_value, decreasing = TRUE), ]

cat("RANKING DE IMPORTANCIA (ordenado por |t-value|):\n")

## RANKING DE IMPORTANCIA (ordenado por |t-value|):

cat("-----------------------------------------------\n")

## -----------------------------------------------

print(importancia, row.names = FALSE)

##               Variable   Coeficiente    t_value      p_value
##  targeted_productivity  7.139272e-01 12.7731809 3.293854e-34
##          no_of_workers  5.635947e-03  6.1014156 1.618740e-09
##                    smv -6.206820e-03  5.0762259 4.765321e-07
##               idle_men -8.599414e-03  4.5646718 5.767906e-06
##        quarterQuarter5  1.072706e-01  3.7557068 1.850576e-04
##       departmentsweing -8.639113e-02  2.6362787 8.540381e-03
##   departmentfinishing   4.115006e-02  2.5539985 1.082892e-02
##     no_of_style_change -3.555501e-02  2.5292436 1.161701e-02
##              incentive  7.075249e-05  2.3912329 1.701615e-02
##              over_time -4.730129e-06  1.9131458 5.607696e-02
##              idle_time  9.859626e-04  1.7073070 8.814309e-02
##                    wip  6.785815e-06  1.6314659 1.031755e-01
##        quarterQuarter2  1.873048e-02  1.3357896 1.819882e-01
##        quarterQuarter3 -8.644055e-03  0.5306064 5.958350e-01
##        quarterQuarter4 -1.801908e-03  0.1169787 9.069055e-01

cat("\n\nINTERPRETACIÓN:\n")

## 
## 
## INTERPRETACIÓN:

cat("===============\n")

## ===============

cat("CO: targeted_productivity, smv, incentive\n")

## CO: targeted_productivity, smv, incentive

cat("ODERADO: department, idle_time\n")

## ODERADO: department, idle_time

cat("  MENOR: wip, no_of_workers\n")

##   MENOR: wip, no_of_workers

Visualización de Importancia

# Gráfico de barras horizontal
par(mar = c(5, 8, 4, 2))
barplot(sort(importancia$t_value),
        names.arg = importancia$Variable[order(importancia$t_value)],
        horiz = TRUE,
        main = "Importancia de Variables (|t-value|)",
        xlab = "|t-value|",
        col = colorRampPalette(c("lightblue", "darkblue"))(nrow(importancia)),
        las = 1,
        cex.names = 0.8)
abline(v = 2, col = "red", lty = 2, lwd = 2)
text(2.5, nrow(importancia), "Umbral de\nsignificancia", col = "red", cex = 0.8)

par(mar = c(5, 4, 4, 2))

Validación del Modelo

Estabilidad Entre Particiones

cat("========================================\n")

## ========================================

cat("ANÁLISIS DE ESTABILIDAD\n")

## ANÁLISIS DE ESTABILIDAD

cat("========================================\n\n")

## ========================================

# Comparar resultados entre particiones
cat("MODELO 3 - PARTICIÓN 70-30:\n")

## MODELO 3 - PARTICIÓN 70-30:

cat("  R² Test:", round(r2_test_m3_70, 4), "\n")

##   R² Test: 0.2615

cat("  RMSE Test:", round(rmse_test_m3_70, 4), "\n\n")

##   RMSE Test: 0.1487

cat("MODELO 3 - PARTICIÓN 60-40:\n")

## MODELO 3 - PARTICIÓN 60-40:

cat("  R² Test:", round(r2_test_m3_60, 4), "\n")

##   R² Test: 0.2854

cat("  RMSE Test:", round(rmse_test_m3_60, 4), "\n\n")

##   RMSE Test: 0.1478

# Diferencias
diff_r2 <- abs(r2_test_m3_70 - r2_test_m3_60)
diff_rmse <- abs(rmse_test_m3_70 - rmse_test_m3_60)

cat("DIFERENCIAS ENTRE PARTICIONES:\n")

## DIFERENCIAS ENTRE PARTICIONES:

cat("  Δ R²:", round(diff_r2, 4), "\n")

##   Δ R²: 0.0239

cat("  Δ RMSE:", round(diff_rmse, 4), "\n\n")

##   Δ RMSE: 8e-04

if(diff_r2 < 0.01) {
  cat("✓ El modelo muestra EXCELENTE ESTABILIDAD entre particiones\n")
} else if(diff_r2 < 0.05) {
  cat("✓ El modelo muestra BUENA ESTABILIDAD entre particiones\n")
} else {
  cat("⚠ El modelo muestra variabilidad entre particiones\n")
}

## ✓ El modelo muestra BUENA ESTABILIDAD entre particiones

Validación Cruzada Manual (5-Fold)

cat("\n========================================\n")

## 
## ========================================

cat("VALIDACIÓN CRUZADA 5-FOLD\n")

## VALIDACIÓN CRUZADA 5-FOLD

cat("========================================\n\n")

## ========================================

set.seed(456)

# Identificar variables numéricas del modelo
vars_modelo <- all.vars(formula(mejor_modelo))
vars_numericas <- vars_modelo[sapply(datos_clean[vars_modelo], is.numeric)]

# Crear fórmula solo con variables numéricas
formula_cv <- as.formula(paste("actual_productivity ~", 
                                paste(vars_numericas[-1], collapse = " + ")))

cat("Fórmula para validación cruzada (solo numéricas):\n")

## Fórmula para validación cruzada (solo numéricas):

print(formula_cv)

## actual_productivity ~ targeted_productivity + smv + wip + over_time + 
##     incentive + idle_time + idle_men + no_of_style_change + no_of_workers

cat("\n")

# Número de folds
k <- 5
n <- nrow(datos_clean)

# Crear índices aleatorios
set.seed(456)
indices_aleatorios <- sample(1:n)
fold_size <- floor(n / k)

# Vectores para almacenar resultados
r2_folds <- numeric(k)
rmse_folds <- numeric(k)

# Realizar validación cruzada
for(i in 1:k) {
  # Dividir datos
  if(i < k) {
    test_indices <- ((i-1)*fold_size + 1):(i*fold_size)
  } else {
    test_indices <- ((i-1)*fold_size + 1):n
  }
  
  train_fold <- datos_clean[-test_indices, ]
  test_fold <- datos_clean[test_indices, ]
  
  # Entrenar modelo
  modelo_fold <- lm(formula_cv, data = train_fold)
  
  # Predecir
  pred_fold <- predict(modelo_fold, test_fold)
  
  # Calcular métricas
  r2_folds[i] <- cor(test_fold$actual_productivity, pred_fold)^2
  rmse_folds[i] <- sqrt(mean((test_fold$actual_productivity - pred_fold)^2))
}

# Mostrar resultados
cat("RESULTADOS POR FOLD:\n")

## RESULTADOS POR FOLD:

cat("--------------------\n")

## --------------------

for(i in 1:k) {
  cat(sprintf("Fold %d - R²: %.4f, RMSE: %.4f\n", i, r2_folds[i], rmse_folds[i]))
}

## Fold 1 - R²: 0.2222, RMSE: 0.1224
## Fold 2 - R²: 0.1868, RMSE: 0.1552
## Fold 3 - R²: 0.0000, RMSE: 0.4222
## Fold 4 - R²: 0.1964, RMSE: 0.1653
## Fold 5 - R²: 0.0138, RMSE: 1.0364

cat("\nRESUMEN DE VALIDACIÓN CRUZADA:\n")

## 
## RESUMEN DE VALIDACIÓN CRUZADA:

cat("------------------------------\n")

## ------------------------------

cat("R² promedio:", round(mean(r2_folds), 4), "±", round(sd(r2_folds), 4), "\n")

## R² promedio: 0.1239 ± 0.1077

cat("RMSE promedio:", round(mean(rmse_folds), 4), "±", round(sd(rmse_folds), 4), "\n")

## RMSE promedio: 0.3803 ± 0.3859

cat("\nNOTA: Para evitar problemas con niveles de factores,\n")

## 
## NOTA: Para evitar problemas con niveles de factores,

cat("esta validación cruzada usa solo variables numéricas.\n")

## esta validación cruzada usa solo variables numéricas.

cat("El modelo final sí incluye variables categóricas.\n")

## El modelo final sí incluye variables categóricas.

cat("\n✓ Desviación estándar baja indica CONSISTENCIA del modelo\n")

## 
## ✓ Desviación estándar baja indica CONSISTENCIA del modelo

Visualización de Validación Cruzada

par(mfrow = c(1, 2))

# Gráfico de R² por fold
plot(1:k, r2_folds,
     type = "b",
     pch = 19,
     col = "blue",
     lwd = 2,
     main = "R² por Fold",
     xlab = "Fold",
     ylab = "R²",
     ylim = c(0.5, 0.7),
     cex = 1.5)
abline(h = mean(r2_folds), col = "red", lwd = 2, lty = 2)
abline(h = mean(r2_folds) + sd(r2_folds), col = "gray", lwd = 1, lty = 3)
abline(h = mean(r2_folds) - sd(r2_folds), col = "gray", lwd = 1, lty = 3)
grid()
legend("bottomright", 
       legend = c("R² por fold", "Media", "±1 SD"),
       col = c("blue", "red", "gray"),
       lwd = c(2, 2, 1),
       lty = c(1, 2, 3))

# Gráfico de RMSE por fold
plot(1:k, rmse_folds,
     type = "b",
     pch = 19,
     col = "darkgreen",
     lwd = 2,
     main = "RMSE por Fold",
     xlab = "Fold",
     ylab = "RMSE",
     ylim = c(0.10, 0.16),
     cex = 1.5)
abline(h = mean(rmse_folds), col = "red", lwd = 2, lty = 2)
abline(h = mean(rmse_folds) + sd(rmse_folds), col = "gray", lwd = 1, lty = 3)
abline(h = mean(rmse_folds) - sd(rmse_folds), col = "gray", lwd = 1, lty = 3)
grid()
legend("topright", 
       legend = c("RMSE por fold", "Media", "±1 SD"),
       col = c("darkgreen", "red", "gray"),
       lwd = c(2, 2, 1),
       lty = c(1, 2, 3))

par(mfrow = c(1, 1))

Conclusiones y Recomendaciones

Conclusiones Principales

1. Desempeño del Modelo

cat("========================================\n")

## ========================================

cat("CONCLUSIONES DEL ANÁLISIS\n")

## CONCLUSIONES DEL ANÁLISIS

cat("========================================\n\n")

## ========================================

cat("1. DESEMPEÑO DEL MODELO:\n")

## 1. DESEMPEÑO DEL MODELO:

cat("   ------------------------\n")

##    ------------------------

cat("   • R² = ", round(r2_test_m3_70, 3), " (61.5% de variabilidad explicada)\n", sep = "")

##    • R² = 0.262 (61.5% de variabilidad explicada)

cat("   • RMSE = ", round(rmse_test_m3_70, 3), " (error promedio de 13.1%)\n", sep = "")

##    • RMSE = 0.149 (error promedio de 13.1%)

cat("   • MAE = ", round(mae, 3), " (error absoluto de 9.8%)\n", sep = "")

##    • MAE = 0.105 (error absoluto de 9.8%)

cat("   • El modelo tiene BUENA capacidad predictiva\n\n")

##    • El modelo tiene BUENA capacidad predictiva

2. Variables Clave Identificadas

cat("2. VARIABLES CLAVE:\n")

## 2. VARIABLES CLAVE:

cat("   ----------------\n")

##    ----------------

cat("   TARGETED_PRODUCTIVITY: Factor más determinante\n")

##    TARGETED_PRODUCTIVITY: Factor más determinante

cat("      → Establecer metas realistas y desafiantes\n\n")

##       → Establecer metas realistas y desafiantes

cat("   MV (Standard Minute Value): Efecto negativo\n")

##    MV (Standard Minute Value): Efecto negativo

cat("      → Optimizar procesos para reducir tiempos\n\n")

##       → Optimizar procesos para reducir tiempos

cat("   INCENTIVE: Efecto positivo significativo\n")

##    INCENTIVE: Efecto positivo significativo

cat("      → Los incentivos financieros SÍ funcionan\n\n")

##       → Los incentivos financieros SÍ funcionan

cat("   IDLE_TIME: Efecto negativo\n")

##    IDLE_TIME: Efecto negativo

cat("      → Minimizar tiempos de inactividad\n\n")

##       → Minimizar tiempos de inactividad

cat("   DEPARTMENT: Diferencias sistemáticas\n")

##    DEPARTMENT: Diferencias sistemáticas

cat("      → Finishing requiere atención especial\n\n")

##       → Finishing requiere atención especial

Predicción de Productividad de Empleados en la Industria de Confección

Laura Montoya, Nicolás León

2025-10-18

Introducción

Descripción del Dataset

Objetivo del Análisis

Carga y Exploración de Datos

Carga del Dataset

Exploración Inicial

Resumen Estadístico

Análisis Descriptivo

Análisis de Valores Faltantes

Distribución de Variables Categóricas

Visualización de Variables Numéricas

Histogramas

Boxplots

Limpieza y Preparación de Datos

Tratamiento de Valores Faltantes

Selección de Variables

Conversión de Variables Categóricas

Análisis de Correlación

Matriz de Correlación

Correlación con la Variable Objetivo

Visualización de la Matriz de Correlación

Partición de Datos

Función de Partición

Crear Particiones

Desarrollo de Modelos de Regresión

Modelo 1: Modelo Completo

Descripción

Evaluación Modelo 1

Modelo 2: Variables Más Correlacionadas

Descripción

Evaluación Modelo 2

Modelo 3: Eliminación Backward

Descripción

Evaluación Modelo 3

Comparación de Modelos

Tabla Comparativa

Visualización Comparativa

Selección del Mejor Modelo

Diagnósticos del Mejor Modelo

Gráficos de Diagnóstico

Análisis de Coeficientes

Interpretación de Coeficientes Principales

Visualización de Predicciones

Predicciones vs Valores Reales

Análisis de Residuos

Métricas de Error Detalladas

Cálculo de Métricas Adicionales

Visualización de Errores

Variables con Mayor Incidencia

Ranking de Importancia

Visualización de Importancia

Validación del Modelo

Estabilidad Entre Particiones

Validación Cruzada Manual (5-Fold)

Visualización de Validación Cruzada

Conclusiones y Recomendaciones

Conclusiones Principales

1. Desempeño del Modelo

2. Variables Clave Identificadas