#==============================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 = ";")
# 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 | ||
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")
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")
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 | |||
#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
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 | 0.0405 | |
| Tabla 3 de 3 | ||
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.