ANÁLISIS DE POZOS DE HIDROCARBUROS EN EL ESTADO DE NUEVA YORK
Grupo 2
2025
Tema: Estadistica inferencial de variables cuantitativas continuas
Profundidad del pozo
Cargamos las librería
library(PASWR)## Loading required package: latticelibrary(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(readr)Carga los datos (Conjunto de datos)
setwd("/cloud/project")
read_csv("P_oil-gas-other-regulated-wells-beginning-1860.csv")## Rows: 42045 Columns: 52
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (19): Well Name, Company Name, Well Type, Map Symbol, Well Status, Conf...
## dbl (22): API Well Number, County Code, API Hole Number, Sidetrack, Complet...
## lgl (1): Financial Security
## dttm (10): Status Date, Permit Application Date, Permit Issued Date, Date Sp...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.## # A tibble: 42,045 × 52
## `API Well Number` `County Code` `API Hole Number` Sidetrack Completion
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 3.10e13 1 1072 0 0
## 2 3.10e13 1 1073 0 0
## 3 3.10e13 1 21007 0 0
## 4 3.10e13 1 21008 0 0
## 5 3.10e13 1 21009 0 0
## 6 3.10e13 1 21010 0 0
## 7 3.10e13 1 21011 0 0
## 8 3.10e13 1 21014 0 0
## 9 3.10e13 1 21015 0 0
## 10 3.10e13 1 21016 0 0
## # ℹ 42,035 more rows
## # ℹ 47 more variables: `Well Name` <chr>, `Company Name` <chr>,
## # `Operator Number` <dbl>, `Well Type` <chr>, `Map Symbol` <chr>,
## # `Well Status` <chr>, `Status Date` <dttm>,
## # `Permit Application Date` <dttm>, `Permit Issued Date` <dttm>,
## # `Date Spudded` <dttm>, `Date of Total Depth` <dttm>,
## # `Date Well Completed` <dttm>, `Date Well Plugged` <dttm>, …datos2<- read.csv("point_oil-gas-other-regulated-wells-beginning-1860.csv", header = T, sep = ",", dec = ".",na.strings = "-")EXTRAER LA VARIABLE CONTINUA
Profundidad_Perforacion<-datos2$Drilled.Depth.ft
Profundidad_Perforacion<-na.omit(Profundidad_Perforacion)El conjunto de datos presenta datos que solo son propuestas y a estas le han asignado a la profundidad el valor de 0 pero no es su valor real por ello filtraremos estos valores
# Filtrar valores positivos (necesario para log-normal)
Profundidad_Pos <- Profundidad_Perforacion[Profundidad_Perforacion > 0]
n<-length(Profundidad_Pos)
n## [1] 31883 hist(Profundidad_Pos,freq = FALSE,main = "Gráfica No.9.1: Modelo de probabilidad - Log-normal")
library(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## select # Ajustar modelo log-normal
logn_params <- fitdistr(Profundidad_Pos, "lognormal")
# Graficar histograma con los mismos datos del ajuste (los positivos)
Histo_prof<-hist(Profundidad_Pos, freq = FALSE,main = "Gráfica No.9.2: Modelo de probabilidad - Log-normal",
xlab = "Profundidad (ft)", ylab = "Densidad de probabilidad",col = "salmon")
Conjeturamos el modelo
h<-length(Histo_prof$counts)
Logarea<-log(Profundidad_Pos)
u<-mean(Logarea)
sigma<-sd(Logarea)
x <- seq(min(Profundidad_Pos), max(Profundidad_Pos), 0.01)
Histo_prof<-hist(Profundidad_Pos, freq = FALSE,main = "Gráfica No.9.3: Modelo de probabilidad - Log-normal",
xlab = "Profundidad (ft)", ylab = "Densidad de probabilidad",col = "salmon")
# 6. Superponer la curva log-normal
curve(dlnorm(x, u,sigma),add = TRUE, col = "darkgreen",lwd = 3)
#El modelo si se acopla, para verificar la correlacion entre la frecuencia observada y la esperada realizaremos el test de Pearson y Chi-cuadrado.
#Frecuencia observada
Fo<-Histo_prof$counts
Fo## [1] 4224 16730 4541 3370 2462 257 98 84 30 38 28 16
## [13] 2 1 1 1 # Frecuencia esperada
P<-c(0)
for (i in 1:h)
{P[i] <-(plnorm(Histo_prof$breaks[i+1],u,sigma)-
plnorm(Histo_prof$breaks[i],u,sigma))}
Fe<-P*length(Profundidad_Pos)
sum(Fe)## [1] 31880.82 n## [1] 31883Test de Pearson
Mide el grado de correlación entre la frecuencia observada y la frecuencia esperada.
plot(Fo,Fe,main="Gráfica 9.4:Correlación de frecuencias en el modelo lognormal
de la profundidad",xlab="Frecuencia Observada",ylab="Frecuencia esperada",col="blue3")
Correlación<-cor(Fo,Fe)*100
Correlación## [1] 96.3284Test de Chi-Cuadrado El test de Chi-Cuadrado utiliza dos parámetro: grados de libertad (se refiere al numero de valores libres de variar dentro de intervalos de la variable, k-1), y nivel de significancia (probabilidad de cometer un error, valores de 0.05,0.1,0.15)¨
#Grados de libertad
grados_libertad <- length(Histo_prof$counts)-1
grados_libertad## [1] 15# Nivel de significancia
nivel_significancia <- 0.05
#Frecuencia Observada porcentual
Fo<-(Histo_prof$counts/n)*100
Fo## [1] 13.248439607 52.473104789 14.242699871 10.569896183 7.721983502
## [6] 0.806072201 0.307373836 0.263463288 0.094094031 0.119185773
## [11] 0.087821096 0.050183483 0.006272935 0.003136468 0.003136468
## [16] 0.003136468sum(Fo)## [1] 100#Frecuencia esperada
Fe<-P*100
Fe## [1] 17.508139737 42.469716738 22.844084481 9.682164310 4.072883711
## [6] 1.781689772 0.817505951 0.392942913 0.197095972 0.102727490
## [11] 0.055413986 0.030826910 0.017630702 0.010338767 0.006201746
## [16] 0.003797735sum(Fe)## [1] 99.99316x2<-sum((Fe-Fo)^2/Fe)
x2## [1] 10.9788# Calcular el umbral de aceptación
umbral_aceptacion <- qchisq(1 - nivel_significancia, grados_libertad)
umbral_aceptacion## [1] 24.99579x2<umbral_aceptacion## [1] TRUERESUMEN TEST DE BONDAD
Variable<-c("Profundidad (ft)")
tabla_resumen<-data.frame(Variable,round(Correlación,2),round(x2,2),round(umbral_aceptacion,2))
colnames(tabla_resumen)<-c("Variable","Test Pearson (%)","Chi Cuadrado","Umbral de aceptación")
library(knitr)
kable(tabla_resumen, format = "markdown", caption = "Tabla 9.1:Resumen de test de bondad al modelo de probabilidad")| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de aceptación |
|---|---|---|---|
| Profundidad (ft) | 96.33 | 10.98 | 25 |
Cálculo de probabilidades
¿Cuál es la probabilidad de que al seleccionar cualquier profundiad de pozo en NY, su profundidad se encuentre entre 4000 ft y 1000 ft?
probabilidad<-plnorm(4000,u,sigma)-plnorm(1000,u,sigma)
probabilidad*100## [1] 74.99597# Crear la secuencia general para la curva
x_full <- seq(min(Profundidad_Pos), max(Profundidad_Pos), length.out = 1000)
# Graficar la curva log-normal completa
plot(x_full, dlnorm(x_full, u, sigma),type = "l",col = "skyblue3",lwd = 2,main = "Gráfica No.9.5: Cálculo de probabilidades",
ylab = "Densidad de probabilidad",xlab = "Profundidad (ft)",las=2)
# Rango de valores entre 1000 y 4000 para el área sombreada
x_sombreado <- seq(1000, 4000, length.out = 1000)
y_sombreado <- dlnorm(x_sombreado, u, sigma)
# Pintar el área bajo la curva (entre 1000 y 4000)
polygon(c(x_sombreado, rev(x_sombreado)),c(y_sombreado, rep(0, length(y_sombreado))),col = rgb(1, 0, 0, 0.4), border = NA)
legend("topright", legend = c("Modelo", "Área de Probabilidad"), col = c("skyblue3", "pink2"), lwd = 2,
pch = c(NA, 15))
# Ajustar la escala del eje x a intervalos de 1000
axis(1, at = seq(0, 15000, by = 1000), labels = seq(0, 15000, by = 1000), las = 2)
Teorema de límite central
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, ses normal, y por lo tanto, podemos obtener la media poblacional mediante intervalos de confianza
# Nuestra media aritmetica muestral es nuestro "u"
x<-mean(Profundidad_Pos)
x## [1] 2035.06sigmap<-sd(Profundidad_Pos)
sigmap## [1] 1265.592e<-sigmap/sqrt(n)
e## [1] 7.087842#P(x-2e<u<x+2e)=95%
li<-(x-2*e) #limite inferior
li## [1] 2020.885ls<-x+2*e #limite superior
ls## [1] 2049.236tabla_media<-data.frame(round(li,2),x,round(ls,2),e)
colnames(tabla_media)<-c("Limite inferior","Media poblacional","Límite superior", "Desviación estándar poblacional")
library(knitr)
kable(tabla_media, format = "markdown", caption = "Tabla 9.2: media poblacional de la profundidad de los pozos de hidrocarburos
en el estado de Nueva York")| Limite inferior | Media poblacional | Límite superior | Desviación estándar poblacional |
|---|---|---|---|
| 2020.88 | 2035.06 | 2049.24 | 7.087842 |
CONCLUSIONES: La variable profundidad (ft) sigue un modelo de probabilidad lognormal aprobando los test de Pearson y Chi-Cuadrado, de esta manera, logramos calcular probabilidades, como por ejemplo, que al seleccionar aleatoriamente una profundidad en el estado de Nueva York la probabilidad de que su profundidad de perforación este entre 1000 (ft) y 4000 (ft) es del 74.99%, y, mediante el teorema de límite central, sabemos que, su media aritmética poblacional se encuentra entre 2020.88 (ft) y 2049.24 (ft) con una confianza del 95%.
.