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)
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))
hist(slope_sin_outliers,
     freq = TRUE,
     main = "Gráfica Nº1. Distribución de cantidad de la Pendiente
     en los pozos de gas natural",
     xlab = "Pendiente",
     ylab = "Cantidad",
     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 <- mean(slope_sin_outliers)
media
## [1] 5.101681
lamdba <- 1 / media
lamdba
## [1] 0.1960138
par(oma = c(1, 1, 1, 1))

hist(slope_sin_outliers,
     freq = FALSE,
     main = "Gráfica Nº2. Comparación de la realidad con el modelo Exponencial
     de la pendiente de los pozos de gas natural",
     xlab = "Pendiente",
     ylab = "Densidad",
     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º3:Correlación de frecuencias con el modelo exponencial",
     xlab = "Frecuencia Observada (%)",
     ylab = "Frecuencia Esperada (%)",
     pch = 19, col = "black")
abline(a = 0, b = 1, 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**")) %>%
  cols_align(align = "center")
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

6. CÁLCULO DE PROBABILIDADES

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 
     medición de la pendiente presente un valor 
     comprendido entre 10 y 15?", cex = 1.2, font = 2, col = "#1D3557")
box(which = "outer", col = "black")

probabilidad_slope <- pexp(15, lamdba) - pexp(10, lamdba)
cat("Probabilidad calculada en porcentaje:")
## Probabilidad calculada en porcentaje:
probabilidad_slope * 100
## [1] 8.798419
# Rango para la curva
x <- seq(min(slope_sin_outliers), max(slope_sin_outliers), 0.01)

# Curva exponencial
plot(x, dexp(x, lamdba),
     col = "skyblue3", lwd = 2, type = "l",
     main = "Gráfica Nº4. Cálculo de probabilidades de la Pendiente en los
     depositos 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)

# 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)) * 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 
     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] 17.59684

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, sean normal, y por lo tanto, podemos obtener la media poblacional mediante intervalos de confianza

Donde, “x” es la media aritmética muestral y “e” es el margen de error (desviación estándar poblacional)

#Media aritmetica
x <- mean(slope_sin_outliers)
x
## [1] 5.101681
#Desviación estandar
sigma <- sd(slope_sin_outliers)
sigma
## [1] 4.527397
#Tamaño muestral
n <- length(slope_sin_outliers)
n
## [1] 10051
#P=95%
e <- sigma / sqrt(n)
e
## [1] 0.04515896
li <- x - 2 * e
li
## [1] 5.011364
ls <- x + 2 * e
ls
## [1] 5.191999
# Creación de la tabla con gt
data.frame(
  Limite_Inferior = round(li, 2),
  Variable = "Pendiente (Slope)",
  Limite_Superior = round(ls, 2),
  Desviacion_Estandar = round(e, 4)
) %>% 
  gt() %>%
  tab_header(
    title = md("**Tabla Nº3. Media Poblacional mediante Intervalos de Confianza**")
    
  ) %>%
  cols_label(
    Limite_Inferior = "Límite Inferior",
    Variable = "Variable Analizada",
    Limite_Superior = "Límite Superior",
    Desviacion_Estandar = "Desviación Estándar Poblacional (e)"
  ) %>%
  cols_align(align = "center") %>%
  tab_options(
    table.background.color = "#FBFCFC",
    heading.background.color = "#F4F6F7",
    column_labels.font.weight = "bold"
  )
Tabla Nº3. Media Poblacional mediante Intervalos de Confianza
Límite Inferior Variable Analizada Límite Superior Desviación Estándar Poblacional (e)
5.01 Pendiente (Slope) 5.19 0.0452

8. CONCLUSIÓN

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

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 8.80

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