ANÁLISIS ESTADÍSTICO

1. CARGA DE LIBRERÍAS Y DATOS

                #=========================ENCABEZADO================================
                # TEMA: REGRESION LINEAL
                # AUTOR: GRUPO 3
                # FECHA: 03-2026
                #===================================================================
library(dplyr)
library(knitr)
library(gt)
setwd("C:/Users/HP/Documents/PROYECTO ESTADISTICA/RStudio")
datos <- read.csv("tablap.csv", header = TRUE, dec = ",", sep = ";")

2. TABLA PARES DE VALORES

tabla_original <- data.frame(
  acero = as.numeric(datos$Impact.steel.production..pad.),
  concreto = as.numeric(datos$Impact.concrete.production..pad.)
)
# Tomamos los primeros 20 datos sin limpiar ni ordenar
tabla_original_previa <- head(tabla_original, 20)
tabla_original_previa <- cbind(Nro = 1:nrow(tabla_original_previa), tabla_original_previa)

# Mostramos la tabla
tabla_original_previa %>% 
  gt() %>%
  cols_label(Nro = "N°", acero = "Impacto Acero", concreto = "Impacto Concreto") %>%
  tab_header(title = md("**Tabla N°1. Pares de Valores de Acero y Concreto de los pozos de gas Natural**")) %>%
  tab_style(
    style = list(cell_fill(color = "lightgray"), cell_text(weight = "bold")),
    locations = cells_title(groups = "title")
  ) %>%
  cols_align(align = "center") %>%
  tab_options(table.width = pct(80), column_labels.font.weight = "bold") %>%
  tab_source_note(
    source_note = md("**Tabla 1 de 3**")
  )
Tabla N°1. Pares de Valores de Acero y Concreto de los pozos de gas Natural
N° Impacto Acero Impacto Concreto
1 155054.0 172798.7
2 163901.7 171058.5
3 169604.8 181923.3
4 173731.2 182040.9
5 158849.7 174402.1
6 136705.8 141742.8
7 191741.2 203301.1
8 165980.6 170237.0
9 114141.3 121527.9
10 143869.5 141713.7
11 184437.2 181491.4
12 176732.6 187001.6
13 107409.3 119890.4
14 126592.2 116675.3
15 154319.3 154907.8
16 212757.3 220821.3
17 141540.7 149585.0
18 128467.0 135920.2
19 202134.8 207641.9
20 149151.1 157723.1
Tabla 1 de 3 
acero    <- as.numeric(datos$Impact.steel.production..pad.)
concreto <- as.numeric(datos$Impact.concrete.production..pad.)

# Crear Tabla de Pares de Valores y limpieza
TPV <- data.frame(acero = acero, concreto = concreto)
TPV <- na.omit(TPV)
TPV <- TPV[TPV$acero > 0 & TPV$concreto > 0, ]
TPV <- TPV[order(TPV$acero), ]
row.names(TPV) <- NULL 

# Visualizacion de 20 pares de valores
tabla_tpv_previa <- head(TPV, 20)
tabla_tpv_previa <- cbind(Nro = 1:nrow(tabla_tpv_previa), tabla_tpv_previa)

tabla_tpv_previa %>% 
  gt() %>%
  cols_label(Nro = "N°", acero = "Impacto Acero", concreto = "Impacto Concreto") %>%
  tab_header(title = md("**Tabla N°2. Pares de Valores de Acero y Concreto de los pozos de gas Natural**")) %>%
  
  tab_style(
    style = list(cell_fill(color = "lightgray"), cell_text(weight = "bold")),
    locations = cells_title(groups = "title")
  ) %>%
  cols_align(align = "center") %>%
  tab_options(table.width = pct(80), column_labels.font.weight = "bold") %>%
  # APLICACIÓN DE PIE DE PÁGINA (Nota aclaratoria y paginación del reporte)
  tab_source_note(
    source_note = md("**Tabla 2 de 3**")
  )
Tabla N°2. Pares de Valores de Acero y Concreto de los pozos de gas Natural
N° Impacto Acero Impacto Concreto
1 79121.28 97235.00
2 86303.17 109599.82
3 87371.92 107961.08
4 87650.31 99532.19
5 87995.49 99247.84
6 88151.53 99635.53
7 88237.84 97003.86
8 89312.16 104747.23
9 89415.80 98179.62
10 90606.91 101637.59
11 91389.82 110924.47
12 92150.68 103595.68
13 92173.70 100980.92
14 92984.68 100739.89
15 93365.85 106085.49
16 93466.77 111858.87
17 93726.23 111970.18
18 93822.72 107179.81
19 94049.59 104890.13
20 94736.23 96273.19
Tabla 2 de 3 
# Definición de variables
x <- TPV$acero    
y <- TPV$concreto

3. DIAGRAMA DE DISPERSION

par(oma = c(1, 1, 1, 1))

set.seed(123)
indice_visual <- sample(1:nrow(TPV), nrow(TPV) / 30)

plot(x[indice_visual], y[indice_visual],
     pch = 16, col = "blue",
     main = "Gráfica Nº1: Diagrama de dispersión entre Impacto de acero \n e Impacto de concreto",
     xlab = "Impacto de acero",
     ylab = "Impacto de concreto")
box(which = "outer", col = "black")

4. CONJETURA DE MODELO

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

Calculo de Parámetros

# Cálculo de parámetros
regresion_lineal <- lm(y ~ x)

Intercepto

a_intercepto <- coef(regresion_lineal)[1]
a_intercepto
## (Intercept) 
##   -5276.738

Pendiente

b_pendiente  <- coef(regresion_lineal)[2]
b_pendiente
##       x 
## 1.06109
par(oma = c(1, 1, 1, 1))

# Gráfica
plot(x[indice_visual], y[indice_visual],
     pch = 16, col = "blue",
     main = "Gráfica Nº2: Comparación de la realidad con el
     modelo lineal entre el Impacto de acero y el Impacto de
     concreto de los pozos de gas natural",
     xlab = "Impacto de acero",
     ylab = "Impacto de concreto")

abline(regresion_lineal, col = "red", lwd = 2)
box(which = "outer", col = "black")

# Ecuación del Modelo
eq_text_panel <- paste0(" Ecuación lineal \n Y = ax + (b) \n Y = ", 
                        round(b_pendiente, 4), "x + ", round(a_intercepto, 4))

# Crear el gráfico 
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") 
text(x = 1, y = 1,
     labels = eq_text_panel,
     cex = 2,      
     col = "black", 
     font = 2)
box(which = "outer", col = "black")

5. TEST DE APROBACION Y RESTRICCIONES

Cálculo de Indicadores

Coeficiente de Pearson

r <- cor(x, y)
r
## [1] 0.9658848

Coeficiente de Determinación

r2 <- r^2
r2
## [1] 0.9329335
tabla_tests <- data.frame(
  Indicador = c("Coeficiente de Pearson", "Coeficiente de Determinación"),
  Valor = c(paste0(round(r * 100, 2), " %"), paste0(round(r2 * 100, 2), " %"))
)


tabla_tests %>% 
  gt() %>%
  tab_header(title = md("**Tabla N°3. Tests de Aprobación del Modelo Lineal**")) %>%

  tab_style(
    style = list(cell_fill(color = "lightgray"), cell_text(weight = "bold")),
    locations = cells_title(groups = "title")
  ) %>%
  cols_align(align = "center") %>%
  tab_options(table.width = pct(60), column_labels.font.weight = "bold") %>%
  tab_source_note(
    source_note = md("**Tabla 3 de 3**")
  )
Tabla N°3. Tests de Aprobación del Modelo Lineal
Indicador Valor
Coeficiente de Pearson 96.59 %
Coeficiente de Determinación 93.29 %
Tabla 3 de 3

Cálculo matemático de las Restricciones

# Formula: 0 = b*x + a  ->  x = -a / b
x_restriccion <- -a_intercepto / b_pendiente
x_restriccion
## (Intercept) 
##    4972.939

6. CALCULO DE PRONOSTICOS

x_prueba <- 5000
pronostico <- (b_pendiente * x_prueba) + a_intercepto

7. CONCLUSION

Entre la producción de acero y la de concreto existe una relación tipo lineal representada por el modelo f(x) = 1.0611x + (-5276.7378). El impacto del acero influye en un 93.29% sobre la variabilidad del concreto. Como se demostró en el pronóstico, para un impacto de acero de 5000 pad, se espera un impacto de 28.71 pad en el concreto.

#{r fig.align='center', echo=FALSE} #cat(paste0("Entre la producción de acero y la de concreto existe una relación tipo lineal representada por el modelo f(x) = ", # round(b_pendiente, 4), "x + ", round(a_intercepto, 4), ". El impacto del acero influye en un #", # round(r2 * 100, 2), "% sobre la variabilidad del concreto. Como se demostró en el pronóstico, para un impacto de acero de ", # x_prueba, " pad, se espera un impacto de ", round(pronostico, 2), " pad en el concreto.")) #