#==============================ENCABEZADO================================
# TEMA: MODELOS PROBABILISTICOS- PRODUCCION TOTAL DE GAS
# 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 = ";")
options(scipen = 999) #permmite trabajar sin notacion cientifica
produccion_gas <- as.numeric(datos$Total.gas.production.by.2023)
produccion_gas <- na.omit(produccion_gas)
produccion_gas <- produccion_gas[produccion_gas > 0]
caja <- boxplot(produccion_gas, plot = FALSE)
limite_sup <- caja$stats[5]
limite_inf <- caja$stats[1]
gas_outliers <- produccion_gas[produccion_gas < limite_inf | produccion_gas > limite_sup]
gas_sin_outliers <- produccion_gas[produccion_gas >= limite_inf & produccion_gas <= limite_sup]
cat("Cantidad con outliers:", length(produccion_gas), "\n")
## Cantidad con outliers: 12561
cat("Cantidad sin outliers:", length(gas_sin_outliers), "\n")
## Cantidad sin outliers: 11480
histograma_gas <- hist(gas_sin_outliers, plot = FALSE)
ni_gas <- histograma_gas$counts
hi_gas <- ni_gas / sum(ni_gas) * 100
intervalos_gas <- paste0("[", round(histograma_gas$breaks[-length(histograma_gas$breaks)], 2),
", ", round(histograma_gas$breaks[-1], 2), ")")
tabla_base <- data.frame(Intervalo = intervalos_gas, ni = ni_gas, hi = round(hi_gas, 2))
fila_total <- data.frame(Intervalo = "TOTAL", ni = sum(tabla_base$ni), hi = round(sum(tabla_base$hi)))
tabla_final_c <- rbind(tabla_base, fila_total)
| Tabla N°1. Distribución de frecuencias de producción de gas en los pozos de gas natural en Nuevo Mexico | ||
| Intervalo | ni | hi (%) |
|---|---|---|
| [0, 200000) | 1031 | 8.98 |
| [200000, 400000) | 1445 | 12.59 |
| [400000, 600000) | 1349 | 11.75 |
| [600000, 800000) | 1280 | 11.15 |
| [800000, 1000000) | 1163 | 10.13 |
| [1000000, 1200000) | 986 | 8.59 |
| [1200000, 1400000) | 805 | 7.01 |
| [1400000, 1600000) | 595 | 5.18 |
| [1600000, 1800000) | 491 | 4.28 |
| [1800000, 2000000) | 396 | 3.45 |
| [2000000, 2200000) | 334 | 2.91 |
| [2200000, 2400000) | 263 | 2.29 |
| [2400000, 2600000) | 260 | 2.26 |
| [2600000, 2800000) | 234 | 2.04 |
| [2800000, 3000000) | 159 | 1.39 |
| [3000000, 3200000) | 168 | 1.46 |
| [3200000, 3400000) | 139 | 1.21 |
| [3400000, 3600000) | 122 | 1.06 |
| [3600000, 3800000) | 106 | 0.92 |
| [3800000, 4000000) | 107 | 0.93 |
| [4000000, 4200000) | 47 | 0.41 |
| TOTAL | 11480 | 100.00 |
| Las unidades de Produccion de Gas se expresan en: pies cúbicos | ||
hist(gas_sin_outliers, freq = TRUE,
main = "Grafica 1. Distribucion de cantidad de la produccion
de gas en pozos de gas natural en Nuevo Mexico",
xlab = "Produccion de Gas", ylab = "Cantidad", col = "indianred1")
par(oma = c(1, 1, 1, 1))
histograma <- hist(gas_sin_outliers, freq = FALSE,
main = "Grafica Nº2. Comparacion de la realidad con el modelo\nde la produccion de gas de los pozos de gas natural de\nNuevo Mexico",
xlab = "Produccion de Gas", ylab = "Densidad de probabilidad", col = "indianred1")
box(which = "outer", col = "black")
#MEDIA
medialog <- mean(log(gas_sin_outliers))
medialog
## [1] 13.59292
#SIGMA
sd_log <- sd(log(gas_sin_outliers))
sd_log
## [1] 0.9454061
x_seq <- seq(min(gas_sin_outliers), max(gas_sin_outliers), length.out = 1000)
curve(dlnorm(x, meanlog = medialog, sdlog = sd_log), add = TRUE, col = "black", lwd = 3)
n <- length(gas_sin_outliers)
Fo <- histograma$counts
P <- c(0)
for (i in 1:length(Fo)) {
P[i] <- plnorm(histograma$breaks[i+1], medialog, sd_log) - plnorm(histograma$breaks[i], medialog, sd_log)
}
Fe <- P * n
Fo_perc <- (Fo / n) * 100
Fo_perc
## [1] 8.9808362 12.5871080 11.7508711 11.1498258 10.1306620 8.5888502
## [7] 7.0121951 5.1829268 4.2770035 3.4494774 2.9094077 2.2909408
## [13] 2.2648084 2.0383275 1.3850174 1.4634146 1.2108014 1.0627178
## [19] 0.9233449 0.9320557 0.4094077
Fe_perc <- (Fe / n) * 100
Fe_perc
## [1] 7.1196800 16.0350251 14.8680880 11.9537686 9.3301459 7.2713574
## [7] 5.7074415 4.5239597 3.6230166 2.9306712 2.3930438 1.9711757
## [13] 1.6368053 1.3692698 1.1533143 0.9775596 0.8334296 0.7143957
## [19] 0.6154405 0.5326726 0.4630483
# Correlacionar Fo y Fe
plot(Fo_perc, Fe_perc, main="Gráfica Nº3: Correlación de frecuencias \nen el modelo log-normal de la produccion de gas",
xlab="Frecuencia Observada(%)",
ylab="Frecuencia esperada(%)",
col="blue3")
abline(a = 0, b = 1, col="red", lwd=2)
box(which = "outer", col = "black")
TEST DE PEARSON
Correlacion <- cor(Fo_perc, Fe_perc) * 100
Correlacion
## [1] 97.20808
TEST DE CHI-CUADRADO
Fe_perc[Fe_perc == 0] <- 1e-9
x2 <- sum((Fe_perc - Fo_perc)^2 / Fe_perc)
x2
## [1] 4.666674
UMBRAL DE ACEPTACION
grados_libertad <- length(Fo) - 1 - 2
umbral_aceptacion <- qchisq(0.95, grados_libertad)
umbral_aceptacion
## [1] 28.8693
x2 < umbral_aceptacion
## [1] TRUE
# Creación de la tabla resumen
tabla_resumen <- data.frame(Variable = "Produccion Total Gas",
Pearson = round(Correlacion, 2),
Chi = round(x2, 2),
Umbral = round(umbral_aceptacion, 2))
| Tabla N°2. Resumen de test de bondad al modelo de probabilidad | |||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptacion |
|---|---|---|---|
| Produccion Total Gas | 97.21 | 4.67 | 28.87 |
##PREGUNTA DE PROBABILIDAD
par(oma = c(1, 1, 1, 1))
plot.new()
plot.window(xlim = c(0, 100), ylim = c(0, 100))
text(50, 55, " ¿Cuál es la probabilidad de que la produccion total
de gas se encuentre entre 0 y 1,000,000
de unidades?", cex = 1.25, font = 2)
rect(0, 25, 103, 85, border = "#2A9D8F", lwd = 3)
# PROBABILIDAD ENTRE 0 y 1000000
probabilidad_Gas <- plnorm(1000000, meanlog = medialog, sdlog = sd_log) -
plnorm(0, meanlog = medialog, sdlog = sd_log)
# En porcentaje
probabilidad_Gas * 100
## [1] 59.30671
# Rango para la curva
x <- seq(min(gas_sin_outliers), max(gas_sin_outliers), length.out = 1000)
# Curva log-normal
plot(x, dlnorm(x, meanlog = medialog, sdlog = sd_log),
col = "skyblue3",
lwd = 2,
type = "l",
main = "Grafica Nº4: Calculo de probabilidades de la
produccion total de gas en los pozos de gas natural
de Nuevo Mexico",
ylab = "Densidad de probabilidad",
xlab = "Produccion de Gas")
box(which = "outer", col = "black")
# Rango del área de probabilidad
x_area <- seq(0, 1000000, length.out = 500)
y_area <- dlnorm(x_area, meanlog = medialog, sdlog = sd_log)
# 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 = "black")
# Leyenda
legend("topright",
legend = c("Modelo Log-normal", "Area de Probabilidad"),
col = c("skyblue3", "red"),
lwd = 2,
pch = c(NA, 15),
cex = 0.5)
# TEXTO DE LA PROBABILIDAD EN LA GRÁFICA
texto_prob <- paste0("Probabilidad: ",
round(probabilidad_Gas * 100, 2), " %")
text(x = max(gas_sin_outliers) * 0.7,
y = max(dlnorm(x, medialog, sd_log)) * 0.8,
labels = texto_prob,
col = "black",
cex = 0.7,
font = 2)
# Media aritmetica
media_original <- exp(medialog + (sd_log^2)/2)
media_original
## [1] 1251457
# Desviacion estandar
sigma_original <- sqrt((exp(sd_log^2) - 1) * exp(2 * medialog + sd_log^2))
sigma_original
## [1] 1504032
#P=95%
e <- sigma_original / sqrt(length(gas_sin_outliers))
e
## [1] 14037.38
li <- media_original - 2 * e
li
## [1] 1223382
ls <- media_original + 2 * e
ls
## [1] 1279531
tabla_media <- data.frame(Variable = "Produccion Total Gas",
li = round(li, 2),
media = round(media_original, 2),
ls = round(ls, 2))
tabla_media %>% gt() %>%
cols_label(Variable = "Variable", li = "Limite inferior", media = "Media poblacional", ls = "Limite superior") %>%
tab_header(title = md("Tabla Nº3. Intervalo de confianza para la media poblacional")) %>%
cols_align(align = "center") %>%
tab_options(table.width = pct(80), column_labels.font.weight = "bold")
| Tabla Nº3. Intervalo de confianza para la media poblacional | |||
| Variable | Limite inferior | Media poblacional | Limite superior |
|---|---|---|---|
| Produccion Total Gas | 1223382 | 1251457 | 1279531 |
La variable produccion total de gas se explica a traves del modelo log-normal siendo la media aritmetica de 1251456.72 y una desviacion estandar de 1504031.77. De esta manera logramos calcular probabilidades como por ejemplo, que al seleccionar aleatoriamente cualquier area donde la produccion se encuentre entre 0 y 1,000,000 es de 59.31 %.
Mediante el teorema de limite central, sabemos que la media aritmetica poblacional de la produccion de gas se encuentra entre 1223381.96 y 1279531.48 con un 95% de confianza.