Mes de finalización (Completion month)

1 Configuración y Carga de Datos

library(dplyr)
library(gt)
library(e1071)

col_principal <- "#0E6655"
col_barras    <- "#16A085"
col_acento    <- "#E67E22"
col_grid      <- "#D7DBDD"

setwd("C:/Users/ASUS/Desktop/Estadistica/new_york_exel")

archivo_csv <- "Oil__Gas____Other_Regulated_Wells__Beginning_1860.csv"

# Detección de separador (evita depender de un delimitador fijo)
separadores <- c(",", ";", "\t", "|")
mejor_sep <- NULL
mejor_ncol <- 1

for (s in separadores) {
  n_campos <- tryCatch(utils::count.fields(archivo_csv, sep = s)[1],
                        error = function(e) 1)
  if (!is.na(n_campos) && n_campos > mejor_ncol) {
    mejor_ncol <- n_campos
    mejor_sep  <- s
  }
}
if (is.null(mejor_sep)) mejor_sep <- ","
cat("Separador detectado:", ifelse(mejor_sep == "\t", "TAB", mejor_sep),
    "| Columnas detectadas:", mejor_ncol, "\n")

## Separador detectado: , | Columnas detectadas: 52

Datos_Brutos <- read.csv(archivo_csv, header = TRUE, sep = mejor_sep,
                          check.names = TRUE, stringsAsFactors = FALSE)

# Localización de columna de mes de finalización: soporta dos variantes del dataset
#  (A) "Completion Month" (numérica, 1-12)  (B) "Date Well Completed" (fecha completa)
col_mes <- names(Datos_Brutos)[
  grepl("completion", names(Datos_Brutos), ignore.case = TRUE) &
  grepl("month",      names(Datos_Brutos), ignore.case = TRUE)
]

col_fecha_fin <- names(Datos_Brutos)[
  grepl("complet", names(Datos_Brutos), ignore.case = TRUE) &
  grepl("date",    names(Datos_Brutos), ignore.case = TRUE)
]

if (length(col_mes) > 0) {
  modo_columna_fin <- "mes"
  nombre_col_fin   <- col_mes[1]
} else if (length(col_fecha_fin) > 0) {
  modo_columna_fin <- "fecha"
  nombre_col_fin   <- col_fecha_fin[1]
} else {
  columnas_txt <- paste(names(Datos_Brutos), collapse = " | ")
  stop("ERROR: No se encontró ninguna columna de mes/fecha de finalización ",
       "(se buscaron patrones 'Completion'+'Month' y 'Complet*'+'Date').\n",
       "Separador usado: '", mejor_sep, "'  |  N° de columnas leídas: ", ncol(Datos_Brutos), "\n",
       "COLUMNAS ENCONTRADAS EN EL ARCHIVO:\n", columnas_txt)
}

cat("Columna de finalización identificada (modo '", modo_columna_fin, "'): ",
    nombre_col_fin, "\n", sep = "")

## Columna de finalización identificada (modo 'fecha'): Date.Well.Completed

2 Extracción y Limpieza de la Variable

if (modo_columna_fin == "mes") {
  # Variante A: mes numérico directo
  Datos <- Datos_Brutos %>%
    mutate(Mes_Fin = suppressWarnings(as.integer(.data[[nombre_col_fin]])))
} else {
  # Variante B: extraer mes desde fecha MM/DD/AAAA
  Datos <- Datos_Brutos %>%
    mutate(Mes_Fin = suppressWarnings(as.integer(
      sub("^([0-9]{1,2})/.*", "\\1", .data[[nombre_col_fin]])
    )))
}

nombres_meses <- c("Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio",
                    "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")

Datos <- Datos %>%
  filter(!is.na(Mes_Fin) & Mes_Fin >= 1 & Mes_Fin <= 12) %>%
  mutate(
    Mes_Fin  = as.integer(Mes_Fin),
    Nombre_Mes = factor(nombres_meses[Mes_Fin], levels = nombres_meses)
  )

Variable_Exacta <- Datos$Mes_Fin
if (length(Variable_Exacta) == 0) stop("ERROR: No hay datos válidos.")

cat("N (pozos con mes de finalización 1-12):", length(Variable_Exacta),
    "| Meses distintos:", length(unique(Datos$Mes_Fin)), "\n")

## N (pozos con mes de finalización 1-12): 22668 | Meses distintos: 12

3 Identificación de la Variable

Mes de Finalización de la perforación es una variable cuantitativa discreta que registra el mes calendario en que el pozo alcanzó su profundidad total (Completion Month), con valores enteros de 1 (Enero) a 12 (Diciembre); no fue necesario agrupar categorías en “Otros” —a diferencia de variables nominales con muchas categorías como County—, ya que sus 12 clases naturales superan ampliamente el umbral mínimo de frecuencia (ver tabla, sección 4), tal como resume el siguiente cuadro:

ficha <- data.frame(
  Criterio = c("Nombre", "Nombre técnico", "Tipo", "Subtipo", "Dominio",
               "Rango", "Unidad", "Escala", "Fuente"),
  Clasificacion = c(
    "Mes de Finalización de la Perforación",
    nombre_col_fin,
    "Cuantitativa discreta",
    "Temporal / Calendario",
    paste0("1 - 12 (", min(Variable_Exacta), " a ", max(Variable_Exacta), ")"),
    "12 clases naturales (una por cada mes calendario)",
    "Mes calendario (Enero-Diciembre)",
    "Ordinal-numérica (intervalo cíclico)",
    "Oil, Gas & Other Regulated Wells - NY State"
  ),
  stringsAsFactors = FALSE
)

ficha %>%
  gt() %>%
  cols_label(Criterio = "Criterio", Clasificacion = "Clasificación") %>%
  cols_align(align = "left", columns = everything()) %>%
  tab_style(
    style = list(cell_text(weight = "bold")),
    locations = cells_body(columns = Criterio)
  ) %>%
  tab_style(
    style = list(cell_text(color = col_principal, weight = "bold"),
                 cell_borders(sides = "bottom", color = col_principal, weight = px(2))),
    locations = cells_column_labels()
  ) %>%
  opt_row_striping() %>%
  opt_table_font(font = google_font("Roboto")) %>%
  tab_options(
    table.font.size = px(14),
    data_row.padding = px(10),
    table.border.top.style = "hidden",
    table.border.bottom.style = "hidden",
    column_labels.border.top.style = "hidden"
  )

Criterio	Clasificación
Nombre	Mes de Finalización de la Perforación
Nombre técnico	Date.Well.Completed
Tipo	Cuantitativa discreta
Subtipo	Temporal / Calendario
Dominio	1 - 12 (1 a 12)
Rango	12 clases naturales (una por cada mes calendario)
Unidad	Mes calendario (Enero-Diciembre)
Escala	Ordinal-numérica (intervalo cíclico)
Fuente	Oil, Gas & Other Regulated Wells - NY State

4 Tabla de Distribución de Frecuencias

TDF_Raw <- Datos %>%
  group_by(Mes_Fin, Nombre_Mes) %>%
  summarise(ni = n(), .groups = "drop") %>%
  arrange(Mes_Fin)

ni <- TDF_Raw$ni
N  <- sum(ni)
hi <- (ni / N) * 100
Ni_asc  <- cumsum(ni)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_asc  <- cumsum(hi)
Hi_desc <- rev(cumsum(rev(hi)))

TDF_Meses <- data.frame(
  Mes = as.character(TDF_Raw$Nombre_Mes),
  ni = ni,
  hi = round(hi, 2),
  Ni_asc = Ni_asc,
  Ni_desc = Ni_desc,
  Hi_asc = round(Hi_asc, 2),
  Hi_desc = round(Hi_desc, 2)
)

totales <- c("TOTAL", sum(ni), round(sum(hi), 2), "-", "-", "-", "-")
TDF_Char <- TDF_Meses %>% mutate(across(everything(), as.character))
TDF_Show <- rbind(TDF_Char, totales)

modal_row <- which.max(TDF_Meses$ni)

TDF_Show %>%
  gt() %>%
  tab_header(
    title = md("**DISTRIBUCIÓN POR MES DE FINALIZACIÓN**"),
    subtitle = md(paste0("Variable: **Mes de Finalización de la perforación (",
                          nombre_col_fin, ")** · Nueva York"))
  ) %>%
  tab_spanner(label = "Frecuencias acumuladas",
              columns = c(Ni_asc, Ni_desc, Hi_asc, Hi_desc)) %>%
  cols_label(
    Mes = "Mes",
    ni = "Cant. Pozos (ni)",
    hi = "Porcentaje (hi%)",
    Ni_asc = "Ni (Asc)", Ni_desc = "Ni (Desc)",
    Hi_asc = "Hi (Asc)", Hi_desc = "Hi (Desc)"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = col_principal), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#148F77"), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#148F77"), cell_text(color = "white", weight = "bold")),
    locations = cells_column_spanners()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#FDEBD0"), cell_text(weight = "bold")),
    locations = cells_body(rows = modal_row)
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#D0ECE7"), cell_text(weight = "bold")),
    locations = cells_body(rows = Mes == "TOTAL")
  ) %>%
  opt_row_striping() %>%
  opt_table_font(font = google_font("Roboto")) %>%
  tab_options(
    table.font.size = px(13),
    heading.align = "left",
    heading.title.font.size = px(17),
    data_row.padding = px(7),
    table.border.top.color = col_principal,
    table.border.bottom.color = col_principal,
    column_labels.border.bottom.color = col_principal
  ) %>%
  tab_source_note(md("*Fuente: NYS DEC — Oil, Gas & Other Regulated Wells. Elaboración: EDUARDO.*"))

DISTRIBUCIÓN POR MES DE FINALIZACIÓN
Variable: Mes de Finalización de la perforación (Date.Well.Completed) · Nueva York
Mes	Cant. Pozos (ni)	Porcentaje (hi%)	Frecuencias acumuladas
			Ni (Asc)	Ni (Desc)	Hi (Asc)	Hi (Desc)
Enero	2640	11.65	2640	22668	11.65	100
Febrero	1367	6.03	4007	20028	17.68	88.35
Marzo	1301	5.74	5308	18661	23.42	82.32
Abril	1228	5.42	6536	17360	28.83	76.58
Mayo	1741	7.68	8277	16132	36.51	71.17
Junio	2138	9.43	10415	14391	45.95	63.49
Julio	1975	8.71	12390	12253	54.66	54.05
Agosto	2127	9.38	14517	10278	64.04	45.34
Septiembre	2123	9.37	16640	8151	73.41	35.96
Octubre	2292	10.11	18932	6028	83.52	26.59
Noviembre	1986	8.76	20918	3736	92.28	16.48
Diciembre	1750	7.72	22668	1750	100	7.72
TOTAL	22668	100	-	-	-	-
Fuente: NYS DEC — Oil, Gas & Other Regulated Wells. Elaboración: EDUARDO.

5 Representación Gráfica

5.1 Gráfica N°1 — Diagrama de Barras (Frecuencia Absoluta)

vals_x <- TDF_Meses$Mes
vals_y <- TDF_Meses$ni
ylim_max <- max(vals_y) * 1.15

par(mar = c(8, 5, 4, 2))
bp1 <- barplot(vals_y,
        main = "Gráfica N°1: Distribución del mes de finalización de perforación (NY)",
        cex.main = 0.9, ylab = "Cantidad de pozos (ni)",
        col = col_barras, border = "white", axes = FALSE,
        ylim = c(0, ylim_max), axisnames = FALSE)
axis(2, col = col_principal, col.axis = col_principal)
axis(1, at = bp1, labels = vals_x, col = col_principal, col.axis = col_principal, las = 2, cex.axis = 0.8)
text(x = bp1, y = vals_y, label = vals_y, pos = 3, cex = 0.7, col = col_principal)
title(xlab = "Mes de finalización", line = 6)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = col_principal)

5.2 Gráfica N°2 — Diagrama de Barras (Porcentaje)

vals_y_pct <- TDF_Meses$hi

par(mar = c(8, 5, 4, 2))
bp2 <- barplot(vals_y_pct,
        main = "Gráfica N°2: Distribución porcentual del mes de finalización (NY)",
        cex.main = 0.9, ylab = "% del total (hi)",
        col = col_barras, border = "white", axes = FALSE,
        ylim = c(0, max(vals_y_pct) * 1.2), axisnames = FALSE)
axis(2, col = col_principal, col.axis = col_principal)
axis(1, at = bp2, labels = vals_x, col = col_principal, col.axis = col_principal, las = 2, cex.axis = 0.8)
text(x = bp2, y = vals_y_pct, label = paste0(round(vals_y_pct, 1), "%"), pos = 3, cex = 0.7, col = col_principal)
title(xlab = "Mes de finalización", line = 6)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = col_principal)

5.3 Gráfica N°3 — Diagrama de Barras Horizontal (Distribución Porcentual)

Nota: no se usa diagrama circular (no aplica a variable cuantitativa discreta). Se usa barra horizontal para mantener el orden calendario de los meses.

par(mar = c(5, 8, 4, 3))
bp3 <- barplot(rev(vals_y_pct),
        main = "Gráfica N°3: Distribución porcentual del mes de finalización (NY)",
        cex.main = 0.9, xlab = "% del total (hi)",
        col = col_barras, border = "white", axes = FALSE,
        horiz = TRUE, xlim = c(0, max(vals_y_pct) * 1.2), names.arg = rep("", length(vals_y_pct)))
axis(1, col = col_principal, col.axis = col_principal)
axis(2, at = bp3, labels = rev(vals_x), col = col_principal, col.axis = col_principal,
     las = 1, cex.axis = 0.8)
text(x = rev(vals_y_pct), y = bp3, label = paste0(round(rev(vals_y_pct), 1), "%"),
     pos = 4, cex = 0.7, col = col_principal)
grid(nx = NULL, ny = NA, col = col_grid, lty = "dotted")
box(bty = "l", col = col_principal)

5.4 Diagrama de Caja (Mes Exacto de Finalización)

Muestra dispersión y valores atípicos del mes exacto (escala 1-12).

par(mar = c(6, 5, 4, 2))
boxplot(Variable_Exacta, horizontal = TRUE, col = col_barras,
        main = "Diagrama de caja del mes de finalización de perforación (NY)",
        cex.main = 0.9, xlab = "", outline = TRUE, outpch = 19, outcol = col_acento,
        boxwex = 0.5, frame.plot = FALSE, xaxt = "n")
eje_x <- 1:12
axis(1, at = eje_x, labels = eje_x, cex.axis = 0.8,
     col = col_principal, col.axis = col_principal)
title(xlab = "Mes exacto de finalización (1-12)", line = 4)

5.5 Ojivas (Frecuencias Acumuladas por Mes)

Muestra la frecuencia acumulada ascendente y descendente por mes.

par(mar = c(8, 5, 4, 8), xpd = TRUE)
x_vals_num <- sort(unique(Datos$Mes_Fin))
x_labels   <- TDF_Meses$Mes
y_asc  <- TDF_Meses$Ni_asc
y_desc <- TDF_Meses$Ni_desc

plot(x_vals_num, y_asc, type = "o", col = col_principal, lwd = 2, pch = 19,
     main = "Ojivas ascendente y descendente del mes de finalización (NY)",
     cex.main = 0.9, ylab = "Frecuencia acumulada", xlab = "",
     axes = FALSE, frame.plot = FALSE)
axis(1, at = x_vals_num, labels = x_labels, las = 2, cex.axis = 0.8,
     col = col_principal, col.axis = col_principal)
axis(2, col = col_principal, col.axis = col_principal)
title(xlab = "Mes de finalización", line = 6)
lines(x_vals_num, y_desc, type = "o", col = col_acento, lwd = 2, pch = 19)
legend("right", legend = c("Ascendente", "Descendente"),
       col = c(col_principal, col_acento), lty = 1, pch = 19, cex = 0.7, lwd = 2,
       inset = c(-0.15, 0), bty = "n")
grid(nx = NULL, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = col_principal)

6 Tabla de Indicadores

media_val   <- mean(Variable_Exacta)
mediana_val <- median(Variable_Exacta)

t_moda     <- table(Variable_Exacta)
freq_max   <- max(t_moda)
modas_calc <- as.numeric(names(t_moda)[t_moda == freq_max])
moda_txt   <- paste(modas_calc, collapse = ", ")

rango_txt    <- paste0("[", min(Variable_Exacta), "; ", max(Variable_Exacta), "]")
varianza_val <- var(Variable_Exacta)
sd_val       <- sd(Variable_Exacta)
cv_val       <- (sd_val / abs(media_val)) * 100
asimetria_val <- skewness(Variable_Exacta, type = 2)
curtosis_val  <- kurtosis(Variable_Exacta, type = 2)

vals_atipicos <- boxplot.stats(Variable_Exacta)$out
num_atipicos  <- length(vals_atipicos)
status_atipicos <- if (num_atipicos > 0) paste0(num_atipicos, " outliers") else "0 (Sin atípicos)"

df_indicadores <- data.frame(
  "Variable"  = "Mes de finalización (mes exacto, 1-12)",
  "Rango"     = rango_txt,
  "Media"     = media_val,
  "Mediana"   = mediana_val,
  "Moda"      = moda_txt,
  "Varianza"  = varianza_val,
  "Desv_Std"  = sd_val,
  "CV_Porc"   = cv_val,
  "Asimetria" = asimetria_val,
  "Curtosis"  = curtosis_val,
  "Atipicos"  = status_atipicos
)

df_indicadores %>%
  gt() %>%
  tab_header(
    title = md("**TABLA DE INDICADORES**"),
    subtitle = "Estadísticos descriptivos de la variable Mes de Finalización"
  ) %>%
  tab_source_note(source_note = "Autor: EDUARDO") %>%
  fmt_number(columns = c(Media, Mediana, Varianza, Desv_Std, CV_Porc, Curtosis), decimals = 2) %>%
  fmt_number(columns = c(Asimetria), decimals = 4) %>%
  cols_label(
    Variable = "Variable", Rango = "Rango [Min; Max]",
    Media = "Media (X̄)", Mediana = "Mediana (Me)", Moda = "Moda (Mo)",
    Varianza = "Varianza (S²)", Desv_Std = "Desv. Est. (S)", CV_Porc = "C.V. (%)",
    Asimetria = "Asimetría (As)", Curtosis = "Curtosis (K)", Atipicos = "Outliers"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = col_principal), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#148F77"), cell_text(color = "white", weight = "bold")),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#FDEBD0"), cell_text(weight = "bold")),
    locations = cells_body(columns = Moda)
  ) %>%
  opt_table_font(font = google_font("Roboto")) %>%
  tab_options(
    table.font.size = px(13),
    heading.align = "left",
    data_row.padding = px(9),
    table.border.top.color = col_principal,
    table.border.bottom.color = col_principal,
    column_labels.border.bottom.color = col_principal
  )

TABLA DE INDICADORES
Estadísticos descriptivos de la variable Mes de Finalización
Variable	Rango [Min; Max]	Media (X̄)	Mediana (Me)	Moda (Mo)	Varianza (S²)	Desv. Est. (S)	C.V. (%)	Asimetría (As)	Curtosis (K)	Outliers
Mes de finalización (mes exacto, 1-12)	[1; 12]	6.68	7.00	1	12.12	3.48	52.10	−0.1913	−1.15	0 (Sin atípicos)
Autor: EDUARDO

7 Conclusión

Se analizaron pozos finalizados entre Enero y Diciembre como valores extremos de la escala mensual (N = 22668 pozos). El mes de mayor actividad de finalización fue Enero (moda: Enero). CV = 52.1% (ritmo variable). Asimetría = -0.1913 (un sesgo hacia el final del año (asimetría negativa)). Sin meses atípicos.