library(readxl)
library(dplyr)
library(gt)
library(readr)
setwd("C:/Users/veru2/OneDrive/Escritorio/dataset_excel")
Datos <- read.csv("Oil__Gas____Other_Regulated_Wells__Beginning_1860 (2).csv",
header = TRUE, sep = ";", dec = ",")
La variable Bottom Hole Latitude representa la coordenada geográfica de latitud (en grados decimales) del punto de fondo del pozo. Es una variable cuantitativa continua, por lo que su análisis requiere la construcción de una tabla de distribución de frecuencias por intervalos de clase.
El dataset contiene registros con errores de codificación en esta columna (valores fuera del rango geográfico válido para Nueva York). Por ello, se filtran únicamente los valores entre 40° y 46° de latitud norte, que corresponden al territorio del estado. Para determinar el número de intervalos se aplica la Regla de Sturges: \(k = 1 + 3.322 \cdot \log_{10}(n)\).
# Extraer y limpiar la variable
BHL_raw <- suppressWarnings(as.numeric(as.character(Datos$Bottom.Hole.Latitude)))
BHL <- BHL_raw[!is.na(BHL_raw) & BHL_raw >= 40 & BHL_raw <= 46]
n <- length(BHL)
k <- ceiling(1 + 3.322 * log10(n))
rango <- max(BHL) - min(BHL)
amplitud <- rango / k
cat("Registros válidos (n):", n, "\n")
## Registros válidos (n): 43
cat("Número de intervalos (k):", k, "\n")
## Número de intervalos (k): 7
cat("Rango:", round(rango, 5), "\n")
## Rango: 1.003
cat("Amplitud de clase (c):", round(amplitud, 5), "\n")
## Amplitud de clase (c): 0.14329
Frecuencia absoluta (ni), relativa porcentual (hi), acumulada absoluta (Ni) y acumulada relativa (Hi) por intervalo de latitud.
# Construir límites de intervalos
limites <- seq(min(BHL), max(BHL), length.out = k + 1)
limites[k + 1] <- limites[k + 1] + 0.0001 # cerrar último intervalo
# Contar frecuencias por intervalo
ni_vec <- numeric(k)
for (i in 1:k) {
ni_vec[i] <- sum(BHL >= limites[i] & BHL < limites[i + 1])
}
# Marcas de clase (punto medio)
marcas <- round((limites[1:k] + limites[2:(k+1)]) / 2, 4)
# Tabla de frecuencias
TDFLatitud <- data.frame(
Intervalo = paste0("[", round(limites[1:k], 4), " - ", round(limites[2:(k+1)], 4), ")"),
Marca = marcas,
ni = ni_vec,
hi = round(ni_vec / n * 100, 5),
Ni = cumsum(ni_vec),
Hi = round(cumsum(ni_vec) / n * 100, 5)
)
# Corregir símbolo del último intervalo (cerrado)
TDFLatitud$Intervalo[k] <- paste0("[",
round(limites[k], 4), " - ", round(limites[k+1]-0.0001, 4), "]")
TDFLatitud
## Intervalo Marca ni hi Ni Hi
## 1 [42.006 - 42.1493) 42.0776 26 60.46512 26 60.46512
## 2 [42.1493 - 42.2926) 42.2209 5 11.62791 31 72.09302
## 3 [42.2926 - 42.4359) 42.3642 0 0.00000 31 72.09302
## 4 [42.4359 - 42.5791) 42.5075 3 6.97674 34 79.06977
## 5 [42.5791 - 42.7224) 42.6508 2 4.65116 36 83.72093
## 6 [42.7224 - 42.8657) 42.7941 3 6.97674 39 90.69767
## 7 [42.8657 - 43.009] 42.9374 4 9.30233 43 100.00000
total_fila <- data.frame(
Intervalo = "Total",
Marca = NA,
ni = sum(TDFLatitud$ni),
hi = round(sum(TDFLatitud$hi), 2),
Ni = NA,
Hi = NA
)
TDFLatitudcompleta <- rbind(TDFLatitud, total_fila)
print(TDFLatitudcompleta)
## Intervalo Marca ni hi Ni Hi
## 1 [42.006 - 42.1493) 42.0776 26 60.46512 26 60.46512
## 2 [42.1493 - 42.2926) 42.2209 5 11.62791 31 72.09302
## 3 [42.2926 - 42.4359) 42.3642 0 0.00000 31 72.09302
## 4 [42.4359 - 42.5791) 42.5075 3 6.97674 34 79.06977
## 5 [42.5791 - 42.7224) 42.6508 2 4.65116 36 83.72093
## 6 [42.7224 - 42.8657) 42.7941 3 6.97674 39 90.69767
## 7 [42.8657 - 43.009] 42.9374 4 9.30233 43 100.00000
## 8 Total NA 43 100.00000 NA NA
gt(TDFLatitudcompleta) %>%
tab_header(
title = md("**DISTRIBUCIÓN DE FRECUENCIAS DE POZOS POR LATITUD DE FONDO DE POZO - NUEVA YORK**"),
subtitle = "Distribución de pozos según la latitud geográfica del fondo del pozo (grados decimales)"
) %>%
cols_label(
Intervalo = "Intervalo",
Marca = "Marca de Clase",
ni = "Frec. Absoluta (ni)",
hi = "Frec. Relativa (hi %)",
Ni = "Frec. Acum. Abs. (Ni)",
Hi = "Frec. Acum. Rel. (Hi %)"
) %>%
fmt_number(columns = c(ni, Ni), decimals = 0, use_seps = TRUE) %>%
fmt_number(columns = c(hi, Hi, Marca), decimals = 4) %>%
sub_missing(columns = everything(), missing_text = "—") %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_style(
style = list(cell_fill(color = "#D5D8DC"), cell_text(weight = "bold")),
locations = cells_body(rows = Intervalo == "Total")
) %>%
tab_options(
table.border.top.color = "#2E4053",
table.border.bottom.color = "#2E4053",
column_labels.border.bottom.color = "#2E4053",
data_row.padding = px(6)
)
| DISTRIBUCIÓN DE FRECUENCIAS DE POZOS POR LATITUD DE FONDO DE POZO - NUEVA YORK | |||||
| Distribución de pozos según la latitud geográfica del fondo del pozo (grados decimales) | |||||
| Intervalo | Marca de Clase | Frec. Absoluta (ni) | Frec. Relativa (hi %) | Frec. Acum. Abs. (Ni) | Frec. Acum. Rel. (Hi %) |
|---|---|---|---|---|---|
| [42.006 - 42.1493) | 42.0776 | 26 | 60.4651 | 26 | 60.4651 |
| [42.1493 - 42.2926) | 42.2209 | 5 | 11.6279 | 31 | 72.0930 |
| [42.2926 - 42.4359) | 42.3642 | 0 | 0.0000 | 31 | 72.0930 |
| [42.4359 - 42.5791) | 42.5075 | 3 | 6.9767 | 34 | 79.0698 |
| [42.5791 - 42.7224) | 42.6508 | 2 | 4.6512 | 36 | 83.7209 |
| [42.7224 - 42.8657) | 42.7941 | 3 | 6.9767 | 39 | 90.6977 |
| [42.8657 - 43.009] | 42.9374 | 4 | 9.3023 | 43 | 100.0000 |
| Total | — | 43 | 100.0000 | — | — |
datos <- TDFLatitudcompleta[TDFLatitudcompleta$Intervalo != "Total", ]
par(mar = c(7, 5, 4, 2) + 0.1)
bp <- barplot(datos$ni,
main = "Gráfica N1: Distribución de pozos según latitud de fondo (NY)",
ylab = "Cantidad de pozos",
col = "#2E4053",
names.arg = datos$Intervalo,
las = 2,
cex.names = 0.65,
cex.axis = 0.8,
cex.main = 0.9,
ylim = c(0, max(datos$ni) * 1.18),
space = 0)
text(x = bp,
y = datos$ni,
labels = datos$ni,
pos = 3, cex = 0.7, xpd = TRUE)
mtext("Intervalo de latitud (°)", side = 1, line = 6, cex = 0.9)
par(mar = c(7, 5, 4, 2) + 0.1)
bp <- barplot(datos$ni,
main = "Gráfica N2: Cantidad de pozos según latitud de fondo (NY)",
ylab = "Cantidad de pozos",
col = "#2E4053",
names.arg = datos$Intervalo,
las = 2,
cex.names = 0.65,
cex.axis = 0.8,
cex.main = 0.9,
ylim = c(0, 50),
space = 0)
text(x = bp,
y = datos$ni,
labels = datos$ni,
pos = 3, cex = 0.7, xpd = TRUE)
mtext("Intervalo de latitud (°)", side = 1, line = 6, cex = 0.9)
par(mar = c(7, 5, 4, 2) + 0.1)
bp <- barplot(datos$hi,
main = "Gráfica N3: Distribución porcentual según latitud de fondo (NY)",
ylab = "Porcentaje (%)",
col = "#2E4053",
names.arg = datos$Intervalo,
las = 2,
cex.names = 0.65,
cex.axis = 0.8,
cex.main = 0.9,
ylim = c(0, max(datos$hi) * 1.18),
space = 0)
text(x = bp,
y = datos$hi,
labels = paste0(round(datos$hi, 2), "%"),
pos = 3, cex = 0.7, xpd = TRUE)
mtext("Intervalo de latitud (°)", side = 1, line = 6, cex = 0.9)
par(mar = c(7, 5, 4, 2) + 0.1)
bp <- barplot(datos$hi,
main = "Gráfica N4: Distribución porcentual según latitud de fondo (NY)",
ylab = "Porcentaje (%)",
col = "#2E4053",
names.arg = datos$Intervalo,
las = 2,
cex.names = 0.65,
cex.axis = 0.8,
cex.main = 0.9,
ylim = c(0, 100),
space = 0)
text(x = bp,
y = datos$hi,
labels = paste0(round(datos$hi, 2), "%"),
pos = 3, cex = 0.7, xpd = TRUE)
mtext("Intervalo de latitud (°)", side = 1, line = 6, cex = 0.9)
par(mar = c(2, 2, 4, 11), xpd = TRUE)
colores <- c("#1B4F72", "#21618C", "#2874A6", "#2E86C1", "#3498DB",
"#5DADE2", "#85C1E9")
colores <- colores[1:nrow(datos)]
pct <- round(datos$hi, 2)
frac <- datos$ni / sum(datos$ni)
theta <- (90 - 360 * (cumsum(frac) - frac / 2)) * pi / 180
pie(datos$ni,
labels = "",
col = colores,
border = "white",
radius = 0.95,
init.angle = 90,
clockwise = TRUE,
cex.main = 0.9,
main = "Gráfica N5: Distribución porcentual por intervalo de latitud")
visibles <- which(pct >= 5)
text(0.62 * cos(theta[visibles]), 0.62 * sin(theta[visibles]),
labels = paste0(pct[visibles], "%"),
col = "white", cex = 0.8, font = 2)
legend(x = 1.05, y = 1.0,
legend = paste0(datos$Intervalo, " (", pct, "%)"),
fill = colores,
cex = 0.68,
bty = "n",
title = "Intervalo (°)")
par(mar = c(7, 5, 4, 2) + 0.1)
plot(1:k, datos$Ni,
type = "b",
pch = 19,
col = "#2E4053",
lwd = 2,
main = "Gráfica N6: Ojiva de frecuencia acumulada absoluta",
xlab = "",
ylab = "Frecuencia acumulada (Ni)",
xaxt = "n",
ylim = c(0, n * 1.05),
cex.main = 0.9)
axis(1, at = 1:k, labels = datos$Intervalo, las = 2, cex.axis = 0.65)
mtext("Intervalo de latitud (°)", side = 1, line = 6, cex = 0.9)
abline(h = n, lty = 2, col = "gray60")
text(k, n, labels = paste0("n = ", n), pos = 3, cex = 0.75, col = "gray40")
Al ser una variable cuantitativa continua, se calculan todas las medidas de tendencia central, dispersión, forma y se identifican valores atípicos mediante el criterio de la distancia intercuartílica (IQR).
media_val <- round(mean(BHL), 5)
mediana_val <- round(median(BHL), 5)
moda_val <- round(datos$Marca[which.max(datos$ni)], 4)
varianza_val <- round(var(BHL), 5)
desv_val <- round(sd(BHL), 5)
cv_val <- round((desv_val / media_val) * 100, 5)
asim_val <- round(e1071::skewness(BHL), 5)
kurt_val <- round(e1071::kurtosis(BHL), 5)
Q1 <- quantile(BHL, 0.25)
Q3 <- quantile(BHL, 0.75)
IQR_val <- Q3 - Q1
atipicos <- BHL[BHL < (Q1 - 1.5 * IQR_val) | BHL > (Q3 + 1.5 * IQR_val)]
n_atip <- length(atipicos)
Conclusiones <- data.frame(
Variable = "Bottom Hole Latitude",
`Rango [Min; Max]` = paste0("[", round(min(BHL),4), "; ", round(max(BHL),4), "]"),
`Media (X)` = media_val,
`Mediana (Me)` = mediana_val,
`Moda (Mo)` = paste0("Marca: ", moda_val),
`Varianza (S2)` = varianza_val,
`Desv. Est. (S)` = desv_val,
`C.V. (%)` = cv_val,
`Asimetría (As)` = asim_val,
`Curtosis (K)` = kurt_val,
`Valores Atípicos` = ifelse(n_atip == 0, "Ninguno", paste0(n_atip, " detectado(s)")),
check.names = FALSE
)
gt(Conclusiones) %>%
tab_header(
title = md("**CONCLUSIONES Y ESTADÍSTICOS**"),
subtitle = "Resumen de indicadores de la latitud del fondo de pozo en Nueva York"
) %>%
tab_source_note(source_note = "Autor: Dallyana") %>%
cols_align(align = "center", columns = everything()) %>%
tab_style(
style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
locations = cells_title()
) %>%
tab_style(
style = list(cell_fill(color = "#F2F3F4"), cell_text(weight = "bold", color = "#2E4053")),
locations = cells_column_labels()
) %>%
tab_options(
table.border.top.color = "#2E4053",
table.border.bottom.color = "#2E4053",
column_labels.border.bottom.color = "#2E4053",
data_row.padding = px(6)
)
| CONCLUSIONES Y ESTADÍSTICOS | ||||||||||
| Resumen de indicadores de la latitud del fondo de pozo en Nueva York | ||||||||||
| Variable | Rango [Min; Max] | Media (X) | Mediana (Me) | Moda (Mo) | Varianza (S2) | Desv. Est. (S) | C.V. (%) | Asimetría (As) | Curtosis (K) | Valores Atípicos |
|---|---|---|---|---|---|---|---|---|---|---|
| Bottom Hole Latitude | [42.006; 43.009] | 42.26156 | 42.07 | Marca: 42.0776 | 0.10982 | 0.33139 | 0.78414 | 1.03266 | -0.56945 | Ninguno |
| Autor: Dallyana | ||||||||||
La variable Bottom Hole Latitude presenta una media de 42.26156° y una mediana de 42.07°, lo que indica que la mayoría de los fondos de pozo se concentran en latitudes bajas del rango analizado (~42.01° – 42.15°), correspondientes al sur del estado de Nueva York. La distribución es asimétrica positiva (As = 1.03266), con una cola hacia latitudes más altas (norte), lo que refleja que hay menos pozos perforados en las zonas septentrionales del estado. La curtosis de -0.56945 indica una distribución platicúrtica (más achatada que la normal), con dispersión moderada. El coeficiente de variación de 0.78414% confirma una dispersión relativa baja respecto a la media, consistente con una zona geográfica acotada. No se detectaron valores atípicos mediante el criterio IQR.
Nota técnica: De los 47,401 registros del dataset, solo 43 cuentan con coordenadas de fondo de pozo válidas para el estado de Nueva York. El resto de los registros no tienen esta información registrada o presentan errores de codificación, por lo que fueron excluidos del análisis.