Variable: Mes de Finalización de la perforación — mes calendario en que se alcanzó la profundidad total del pozo (Completion Month, según versión del dataset), valores enteros de 1 (Enero) a 12 (Diciembre). Tipo: cuantitativa discreta.
Reagrupación de clases: no fue necesaria — las 12 categorías (meses) ya son las clases naturales de la variable y todas superan ampliamente los 160 pozos (ver tabla, sección 4).
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
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
## Variable : Mes de Finalización de la perforación
## Columna base : Date.Well.Completed
## Tipo : Cuantitativa discreta (escala ordinal-numérica, 1 a 12)
## Rango : 1 - 12
## N : 22668
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. | ||||||
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)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)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)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)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")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 | ||||||||||
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.