ANÁLISIS ESTADÍSTICO

1. CARGA DE LIBRERÍAS Y DATOS

                    #==============================ENCABEZADO==========================
                    # TEMA: MODELOS PROBABILISTICOS- SLOPE (PENDIENTE)
                    # 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 DE DISTRIBUCIÓN DE CANTIDAD

# LIMPIEZA DE LA VARIABLE SLOPE
slope <- as.numeric(datos$Slope)
slope <- na.omit(slope)

par(oma = c(1, 1, 1, 1)) 
boxplot(slope, 
        horizontal = TRUE, 
        col = "skyblue",
        main = "Gráfica Nº1: Distribución de cantidad de la
        Pendiente en pozos de gas natural en Nuevo México",
        xlab = "Pendiente")
box(which = "outer", col = "black")

slope_sin_outliers <- subset(slope, slope > 0) 

cat("Cantidad total de datos analizados:", length(slope_sin_outliers))
## Cantidad total de datos analizados: 10051
histograma <- hist(slope_sin_outliers, plot = FALSE)
ni <- histograma$counts
hi <- ni / sum(ni) * 100
intervalos <- paste0("[", round(histograma$breaks[-length(histograma$breaks)], 2), ", ", round(histograma$breaks[-1], 2), ")")


tabla_frecuencias <- data.frame(Intervalo = intervalos, ni = ni, hi = round(hi, 2))
totales <- data.frame(Intervalo = "TOTAL", ni = sum(ni), hi = sum(round(hi, 2)))
tabla_frecuencias_final <- rbind(tabla_frecuencias, totales)
Tabla Nº1. Distribución de Frecuencias de la Pendiente
Intervalo (Grados) ni hi (%)
[0, 2) 3330 33.13
[2, 4) 2602 25.89
[4, 6) 1497 14.89
[6, 8) 902 8.97
[8, 10) 602 5.99
[10, 12) 382 3.80
[12, 14) 242 2.41
[14, 16) 174 1.73
[16, 18) 118 1.17
[18, 20) 75 0.75
[20, 22) 47 0.47
[22, 24) 21 0.21
[24, 26) 22 0.22
[26, 28) 15 0.15
[28, 30) 11 0.11
[30, 32) 4 0.04
[32, 34) 4 0.04
[34, 36) 3 0.03
TOTAL 10051 100.00
Tabla 1 de 3

3. GRÁFICA DE DISTRIBUCIÓN DE CANTIDAD

par(oma = c(1, 1, 1, 1))
h_temp <- hist(slope_sin_outliers, plot = FALSE)

# Convertimos las frecuencias absolutas a porcentajes
h_temp$counts <- (h_temp$counts / sum(h_temp$counts)) * 100

plot(h_temp, 
     main = "Gráfica Nº2. Distribución de la Pendiente\nen los pozos de gas natural de Nuevo Mexico",
     xlab = "Pendiente",
     ylab = "Porcentaje (%)",
     col = "skyblue")

box(which = "outer", col = "black")

4. CONJETURA DEL MODELO

Debido a la similitud de las barras asociamos con el modelo de probabilidad exponencial

Media Aritmética

media <- mean(slope_sin_outliers)
media
## [1] 5.101681

Parámetro Lamdba

lamdba <- 1 / media
lamdba
## [1] 0.1960138
par(oma = c(1, 1, 1, 1))

hist(slope_sin_outliers,
     freq = FALSE,
     main = "Gráfica Nº3. Comparación de la realidad con el modelo Exponencial
     de la pendiente de los pozos de gas natural",
     xlab = "Pendiente",
     ylab = "Densidad de Probabilidad",
     col = "navajowhite",
     border = "gray30")
box(which = "outer", col = "black")
h <- length(histograma$counts)
h
## [1] 18
curve(dexp(x, rate = lamdba), from = 0, add = TRUE, col = "red", lwd = 3)

Fo <- histograma$counts
P <- sapply(1:h, function(i) pexp(histograma$breaks[i+1], rate = lamdba) - pexp(histograma$breaks[i], rate = lamdba))
Fe <- P * length(slope_sin_outliers)

n <- length(slope_sin_outliers)
n
## [1] 10051
Fo_perc <- (Fo / n) * 100
Fo_perc
##  [1] 33.13103174 25.88797135 14.89404039  8.97423142  5.98945379  3.80061685
##  [7]  2.40772062  1.73117103  1.17401254  0.74619441  0.46761516  0.20893443
## [13]  0.21888369  0.14923888  0.10944185  0.03979704  0.03979704  0.02984778
Fe_perc <- (Fe / n) * 100
Fe_perc
##  [1] 32.43145452 21.91346210 14.80660760 10.00460939  6.75996905  4.56761276
##  [7]  3.08626951  2.08534741  1.40903892  0.95206710  0.64329789  0.43466703
## [13]  0.29369819  0.19844759  0.13408815  0.09060141  0.06121806  0.04136415
# Gráfica de Correlación
plot(Fo_perc, Fe_perc,
     xlim = c(0, max(Fo_perc)),
     ylim = c(0, max(Fe_perc)),
     main = "Gráfica Nº4:Correlación de frecuencias con el modelo exponencial",
     xlab = "Frecuencia Observada (%)",
     ylab = "Frecuencia Esperada (%)",
     pch = 19, col = "black")
lines(c(0, max(Fo_perc)), c(0, max(Fo_perc)), col = "red", lwd = 3)
box(which = "outer", col = "black")

5. TESTS DE APROBACIÓN

TEST DE PEARSON

Correlación <- cor(Fo_perc, Fe_perc) * 100
Correlación
## [1] 99.5641

TEST DE CHI-CUADRADO

x2 <- sum((Fe_perc - Fo_perc)^2 / Fe_perc)
x2
## [1] 1.59246

UMBRAL DE ACEPTACION

umbral_aceptacion <- qchisq(0.95, h - 1)
umbral_aceptacion
## [1] 27.58711

COMPARACION DE CHI CUADRADO CON UMBRAL DE ACEPTACION

x2<umbral_aceptacion
## [1] TRUE
# Tabla Resumen con gt
data.frame(
  Tests = c("Correlación Pearson (%)", "Chi-cuadrado"),
  Valor = c(round(Correlación, 2), round(x2, 2)),
  Umbral = c("> 80%", round(umbral_aceptacion, 2)),
  Resultado = c(ifelse(Correlación > 80, "APROBADO", "RECHAZADO"), 
                ifelse(x2 < umbral_aceptacion, "APROBADO", "RECHAZADO"))
) %>% gt() %>%
  tab_header(title = md("**Tabla Nº2. Resumen de test de bondad al modelo de
                        probabilidad**")) %>%
  tab_style(
    style = list(cell_fill(color = "lightgray"), cell_text(weight = "bold")),
    locations = cells_title(groups = "title")
  ) %>%
  cols_align(align = "center") %>%
  tab_source_note(
    source_note = md("**Tabla 2 de 3**")
  )
Tabla Nº2. Resumen de test de bondad al modelo de probabilidad
Tests Valor Umbral Resultado
Correlación Pearson (%) 99.56 > 80% APROBADO
Chi-cuadrado 1.59 27.59 APROBADO
Tabla 2 de 3

6. CÁLCULO DE PROBABILIDADES

#Aqui ya trabajamos con todo nuestro dataset para el calculo de los parámetros
slope_completo <- as.numeric(datos$Slope)
slope_completo <- na.omit(slope_completo) 

Recalculamos Valores

# Recalculamos los parámetros reales de toda la población
n_completo      <- length(slope_completo)
n_completo
## [1] 12561

Media Aritmética

media_completa  <- mean(slope_completo)
media_completa
## [1] 4.082239

Lamdba Completo

lamdba_completo <- 1 / media_completa
lamdba_completo
## [1] 0.2449636
par(oma = c(1, 1, 1, 1))
plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 100))

# Dibujo
rect(2, 20, 98, 80, border = "#2A9D8F", col = "#F0F9F8", lwd = 3)

text(52, 55, "¿Cuál es la probabilidad de que una \n medición de la pendiente presente un valor \n comprendido entre 10 y 15?", cex = 1.2, font = 2, col = "#1D3557")
box(which = "outer", col = "black")

# USAMOS LAMDBA COMPLETO
probabilidad_slope <- pexp(15, lamdba_completo) - pexp(10, lamdba_completo)

Probabilidad:

probabilidad_slope * 100
## [1] 6.096174
# Rango para la curva usando el dataset completo
x <- seq(min(slope_completo), max(slope_completo), 0.01)

# Curva exponencial con lambda completo
plot(x, dexp(x, lamdba_completo),
     col = "skyblue3", lwd = 2, type = "l",
     main = "Gráfica Nº5. Cálculo de probabilidades de la Pendiente en los\ndepositos de gas natural",
     ylab = "Densidad de probabilidad",
     xlab = "Pendiente")
box(which = "outer", col = "black")

# Área de probabilidad
x_area <- seq(10, 15, 0.01)
y_area <- dexp(x_area, lamdba_completo)

# Línea del área
lines(x_area, y_area, col = "red", lwd = 2)

# Área sombreada
polygon(c(x_area, rev(x_area)),
        c(y_area, rep(0, length(y_area))),
        col = rgb(1, 0, 0, 0.5),
        border = NA)

# Leyenda
legend("topright",
       legend = c("Modelo exponencial", "Área de Probabilidad"),
       col = c("skyblue3", "red"),
       lwd = 2,
       cex = 0.9)


# Texto informativo en la gráfica
texto_prob <- paste0("Probabilidad = ", round(probabilidad_slope * 100, 2), " %")

# Ajuste de posicion X
text(x = max(x) * 0.7,
     y = max(dexp(x, lamdba_completo)) * 0.7,
     labels = texto_prob,
     col = "black",
     cex = 0.9,
     font = 2)

plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 100))

# Dibujo de la tarjeta (Borde y Fondo)
rect(2, 20, 98, 80, border = "#2A9D8F", col = "#F0F9F8", lwd = 3)

# Texto de la pregunta
text(52, 55, "¿De 200 nuevas mediciones cuántas tendrían \n una pendiente entre 10 y 15 grados?", cex = 1.2, font = 2, col = "#1D3557")
box(which = "outer", col = "black")

Cantidad esperada en una muestra de 200:

probabilidad_slope * 200
## [1] 12.19235

7. INTERVALOS DE CONFIANZA

El teorema de límite central nos indica que, aunque las variables individuales no sigan una distribución normal, la distribución de las medias aritméticas de n conjuntos muestrales sea normal,por lo tanto, podemos obtener la media poblacional mediante intervalos de confianza

Donde, “x” es la media aritmética muestral y “e” es el error estándar

Media Aritmética Muestral

x <- mean(slope_completo)
x
## [1] 4.082239

Desviación Estándar

sigma <- sd(slope_completo)
sigma
## [1] 4.534651

Error Estándar (Incertidumbre)

#La variabilidad de la media muestral respecto a la población.
e <- sigma / sqrt(n_completo)
e
## [1] 0.04046055

Limites del Intervalo Limite Inferior

li <- x - 2 * e
li
## [1] 4.001318

Limite Superior

ls <- x + 2 * e
ls
## [1] 4.16316
Tabla Nº3. Media Poblacional mediante Intervalos de Confianza
Variable Intervalo de Confianza (95%) Error Estándar de la Media (e)
Pendiente 4.00<μ<4.164.00 < \mu < 4.16 0.0405
Tabla 3 de 3

8. CONCLUSIÓN

La variable pendiente se explica a través del modelo exponencial siendo la media aritmética de 4 que se encuentra en un intervalo definido por una desviación estandar de 4.5.

De esta manera logramos calcular probabilidades; por ejemplo, al seleccionar aleatoriamente cualquier pozo, la probabilidad de que el valor de su pendiente se encuentre entre 10° y 15° es del 6.1 %

Mediante el teorema de limite central, sabemos que la media aritmetica poblacional de la pendiente se encuentran entre 4 y 4.16 con un 95% de confianza.