1 Configuración y Carga de Datos

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 = ",")

2 Tabla de distribución de frecuencias

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

3 Cálculo de frecuencias por intervalo

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

4 Construcción del cuadro con totales

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

5 Presentación tabular

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

6 Gráficas

6.1 Histograma de frecuencia absoluta local

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)

6.2 Histograma de frecuencia absoluta global

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)

6.3 Histograma de frecuencia relativa local

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)

6.4 Histograma de frecuencia relativa global

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)

6.5 Diagrama circular

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 (°)")

6.6 Ojiva (frecuencia acumulada)

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")

7 Resumen estadístico

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

7.1 Conclusión

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.