1 Carga de Datos y Librerías

# Cargar librerías
library(readxl)
library(dplyr)
library(knitr)
library(ggplot2)

# Cargar datos
datos <- read_excel("~/UNI/estadistica/PROYECTO/1. DATOS/5000 datos.xlsx")
cat("Dimensiones:", nrow(datos), "observaciones,", ncol(datos), "variables\n\n")
## Dimensiones: 4945 observaciones, 2 variables
# Extraer variables Cuantitativas

Reg_S <- datos %>%
  select(TOT_EXPER, DAYS_LOST)

# Convertir a numéricas por seguridad
Reg_S$TOT_EXPER <- as.numeric(Reg_S$TOT_EXPER)
Reg_S$DAYS_LOST <- as.numeric(Reg_S$DAYS_LOST)

2 Tabla de Pares de Valores

Debido a la extension de datos, solo mostramos las 10 primeras filas.

# TABLA DE PARES DE VALORES
TPV <- data.frame(
  exper_t = Reg_S$TOT_EXPER,
  dias_p = Reg_S$DAYS_LOST / 100  # Mantengo tu escala
)

# OMITIR NA
TPV <- na.omit(TPV)

# OMITIR VALORES NEGATIVOS Y CEROS
TPV <- TPV[TPV$exper_t > 0 & TPV$dias_p > 0, ]
head(TPV, 10)
##    exper_t dias_p
## 6     5.87   0.55
## 7    30.00   1.84
## 8     0.37   0.28
## 15   16.00   0.55
## 19   10.00   0.25
## 20   32.23   1.05
## 21    9.00   0.38
## 23    4.56   0.56
## 27    0.19   0.26
## 30   38.06   1.66

3 Diagrama de Dispersión

plot(TPV$exper_t, TPV$dias_p,
     pch = 16,
     col = adjustcolor("blue", alpha.f = 0.5),
     main = "Gráfica N°1:Diagrama de dispersión entre Experiencia Total 
     y Ausencia Laboral en Accidentes, Lesiones y Enfermedades en Operaiones Mineras",
     xlab = "Experiencia total (Años)",
     ylab = "Ausencia Laboral (Días)")

4 Conjetura del Modelo

Debido a la similitud de la nube de puntos conjeturamos a un modelo polinomial

x <- TPV$exper_t
y <- TPV$dias_p

plot(x, y,
     pch = 16,
     col = adjustcolor("blue", alpha.f = 0.5),
     main = "Gráfica N°2: Comparación de la realidad con el modelo polinómico (grado 3)
     entre Experiencia Total y Ausencia Laboral en Accidentes, Lesiones y 
     Enfermedades en Operaiones Mineras",
     xlab = "Experiencia total (Años)",
     ylab = "Días de ausencia (Días)")

# Parámetros polinómicos (MISMA estructura)
xcuad <- x^2
xcub  <- x^3

regresion_polinomica <- lm(y ~ x + xcuad + xcub)
regresion_polinomica
## 
## Call:
## lm(formula = y ~ x + xcuad + xcub)
## 
## Coefficients:
## (Intercept)            x        xcuad         xcub  
##   2.766e-01   -7.788e-03    2.416e-03   -2.631e-05
summary(regresion_polinomica)
## 
## Call:
## lm(formula = y ~ x + xcuad + xcub)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.0177 -0.1911 -0.0412  0.1431  6.2938 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.766e-01  2.355e-02  11.745  < 2e-16 ***
## x           -7.788e-03  6.002e-03  -1.297    0.195    
## xcuad        2.416e-03  3.688e-04   6.552 8.36e-11 ***
## xcub        -2.631e-05  6.160e-06  -4.270 2.10e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3657 on 1214 degrees of freedom
## Multiple R-squared:  0.675,  Adjusted R-squared:  0.6742 
## F-statistic: 840.4 on 3 and 1214 DF,  p-value: < 2.2e-16
beta0 <- regresion_polinomica$coefficients[1]
beta1 <- regresion_polinomica$coefficients[2]
beta2 <- regresion_polinomica$coefficients[3]
beta3 <- regresion_polinomica$coefficients[4]

a <- beta0
b <- beta1
c <- beta2
d <- beta3

# AGREGAR LA CURVA
plot(x, y, 
     pch = 16,
     col = adjustcolor("blue", alpha.f = 0.5),
     main = "Gráfica N°3: Ajuste polinómico (grado 3) entre Experiencia Total y 
     Ausencia Laboral en Accidentes, Lesiones y Enfermedades en Operaiones Mineras",
     xlab = "Experiencia total (Años)",
     ylab = "Ausencia Laboral (Días)")

curve(a + b*x + c*x^2 + d*x^3,
      from = min(x), to = max(x),
      add = TRUE, col = "red", lwd = 2)

4.1 Ecuación del Modelo

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")  # <-- era lot(), corregido

eq <- paste0(
  "Ecuación polinómica (grado 3)\n",
  "Y = a + bX + cX^2 + dX^3\n\n",
  "Y = ", round(a, 6),
  " + ", round(b, 6), "X",
  " + ", round(c, 6), "X^2",
  " + ", round(d, 6), "X^3\n\n",
  "Donde:\nX = TOT_EXPER\nY = DAYS_LOST / 100"
)

text(1, 1, labels = eq, cex = 1.2, col = "blue", font = 2)

5 Test de Aprobación y Restricciones

# TEST DE PEARSON (corregido: x_reg/y_reg no existen)
r <- cor(x, y, method = "pearson")
r * 100
## [1] 79.92719
# Coeficiente de determinación (del Pearson)
r2 <- r^2
r2 * 100
## [1] 63.88356

El modelo polinómico de tercer grado es válido únicamente dentro del rango observado de experiencia total

6 Cálculo de Pronósticos

¿Cuántos días de ausencia laboral se esperan cuando un trabajador presenta una Experiencia Total de 20 años?

# Valor de experiencia total a pronosticar
x0 <- 20   # TOT_EXPER = 20

# Pronóstico con el modelo polinómico de grado 3
y_esp <- a + b*x0 + c*x0^2 + d*x0^3
y_esp
## (Intercept) 
##   0.8769637
# Convertir a días reales de ausencia (porque y = DAYS_LOST / 100)
DAYS_LOST_real <- y_esp * 100
DAYS_LOST_real
## (Intercept) 
##    87.69637
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")

text(
  x = 1, y = 1,
  labels = paste0(
    "¿Cuántos días de ausencia laboral se esperan\n",
    "cuando un trabajador presenta una\n",
    "experiencia total de 20 años?\n\n",
    "Resultado:\n",
    round(DAYS_LOST_real, 4), " días"
  ),
  cex = 1.2,
  col = "blue",
  font = 2
)

7 Conclusiones

Entre la experiencia laboral total (TOT_EXPER) y los días de ausencia laboral (DAYS_LOST) se observa una relación de tipo polinómica de tercer grado, representada por el modelo:

Y = a + bX + cX² + dX³

donde X corresponde a la experiencia total del trabajador (TOT_EXPER) y Y a los días de ausencia laboral expresados como DAYS_LOST/100. Este modelo describe adecuadamente el comportamiento no lineal observado en los datos y es válido únicamente dentro del rango de experiencia total analizado, por lo que no debe extrapolarse fuera de dicho dominio.

Ejemplo. Cuando la experiencia total de un trabajador es de 20 años, al sustituir este valor en la ecuación ajustada, el modelo predice aproximadamente DAYS_LOST_real días de ausencia laboral, lo que representa el número esperado de días perdidos según el patrón observado en el conjunto de datos que es aproximadamente 87 días.