library(dplyr)
library(gt)
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"
# Si tu archivo se llama distinto (p. ej. con sufijo "__1_"), cambia la línea de arriba
# 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 la columna de fecha de emisión del permiso
col_permiso <- names(Datos_Brutos)[
grepl("permit", names(Datos_Brutos), ignore.case = TRUE) &
grepl("issued", names(Datos_Brutos), ignore.case = TRUE) &
grepl("date", names(Datos_Brutos), ignore.case = TRUE)
]
if (length(col_permiso) == 0) {
columnas_txt <- paste(names(Datos_Brutos), collapse = " | ")
stop("ERROR: No se encontró ninguna columna de fecha de emisión del permiso ",
"(se buscó el patrón 'Permit'+'Issued'+'Date').\n",
"Separador usado: '", mejor_sep, "' | N° de columnas leídas: ", ncol(Datos_Brutos), "\n",
"COLUMNAS ENCONTRADAS EN EL ARCHIVO:\n", columnas_txt)
}
nombre_col_permiso <- col_permiso[1]
cat("Columna de fecha de emisión del permiso identificada:", nombre_col_permiso, "\n")## Columna de fecha de emisión del permiso identificada: Permit.Issued.Date
Se toma la década de la fecha de emisión del permiso como la categoría de la variable. Al ser categorías con un orden temporal natural (una década es cronológicamente anterior o posterior a otra), la variable se trata como cualitativa ordinal, igual que se hizo con Estado del Pozo y Fecha de Estado.
# La fecha viene en formato MM/DD/AAAA; se extrae el año con expresión regular
Datos <- Datos_Brutos %>%
mutate(Anio_Permiso = suppressWarnings(as.integer(
sub(".*/([0-9]{4}).*", "\\1", .data[[nombre_col_permiso]])
)))
# Cada década se convierte directamente en una categoría ordinal (Ej: "1900 - 1909")
Datos <- Datos %>%
filter(!is.na(Anio_Permiso) & Anio_Permiso >= 1900 & Anio_Permiso <= 2026) %>%
mutate(
Decada_Base = floor(Anio_Permiso / 10) * 10,
Categoria_Decada = paste0(Decada_Base, " - ", Decada_Base + 9)
)
niveles_orden <- Datos %>%
distinct(Decada_Base, Categoria_Decada) %>%
arrange(Decada_Base) %>%
pull(Categoria_Decada)
Datos <- Datos %>%
mutate(Categoria_Decada = factor(Categoria_Decada, levels = niveles_orden, ordered = TRUE)) %>%
select(-Decada_Base)
Variable_Ordinal <- Datos$Categoria_Decada
if (length(Variable_Ordinal) == 0) stop("ERROR: No hay datos válidos.")
n_excluidos <- nrow(Datos_Brutos) - length(Variable_Ordinal)
cat("N (pozos con fecha de emisión de permiso clasificable):", length(Variable_Ordinal), "\n")## N (pozos con fecha de emisión de permiso clasificable): 18286
cat("Registros excluidos (sin fecha de emisión o fuera de rango 1900-2026):", n_excluidos,
"(", round(100 * n_excluidos / nrow(Datos_Brutos), 1), "%)\n")## Registros excluidos (sin fecha de emisión o fuera de rango 1900-2026): 29104 ( 61.4 %)
## Variable : Fecha de Emisión del Permiso (década de emisión del permiso de perforación)
## Columna base : Permit.Issued.Date
## Tipo : Cualitativa ordinal ( 8 categorías por década)
## Niveles : 1950 - 1959 < 1960 - 1969 < 1970 - 1979 < 1980 - 1989 < 1990 - 1999 < 2000 - 2009 < 2010 - 2019 < 2020 - 2029
## N : 18286
TDF_Raw <- Datos %>%
group_by(Categoria_Decada) %>%
summarise(ni = n(), .groups = "drop") %>%
arrange(Categoria_Decada)
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_Estado <- data.frame(
Categoria = as.character(TDF_Raw$Categoria_Decada),
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_Estado %>% mutate(across(everything(), as.character))
TDF_Show <- rbind(TDF_Char, totales)
modal_row <- which.max(TDF_Estado$ni)
TDF_Show %>%
gt() %>%
tab_header(
title = md("**DISTRIBUCIÓN DE LA FECHA DE EMISIÓN DEL PERMISO POR DÉCADA**"),
subtitle = md(paste0("Variable: **Fecha de Emisión del Permiso (",
nombre_col_permiso, ")** · Nueva York"))
) %>%
tab_spanner(label = "Frecuencias acumuladas",
columns = c(Ni_asc, Ni_desc, Hi_asc, Hi_desc)) %>%
cols_label(
Categoria = "Década (orden ordinal)",
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 = Categoria == "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: Dallyanna Lozano (Grupo 1).*"))| DISTRIBUCIÓN DE LA FECHA DE EMISIÓN DEL PERMISO POR DÉCADA | ||||||
| Variable: Fecha de Emisión del Permiso (Permit.Issued.Date) · Nueva York | ||||||
| Década (orden ordinal) | Cant. Pozos (ni) | Porcentaje (hi%) |
Frecuencias acumuladas
|
|||
|---|---|---|---|---|---|---|
| Ni (Asc) | Ni (Desc) | Hi (Asc) | Hi (Desc) | |||
| 1950 - 1959 | 7 | 0.04 | 7 | 18286 | 0.04 | 100 |
| 1960 - 1969 | 566 | 3.1 | 573 | 18279 | 3.13 | 99.96 |
| 1970 - 1979 | 4057 | 22.19 | 4630 | 17713 | 25.32 | 96.87 |
| 1980 - 1989 | 6213 | 33.98 | 10843 | 13656 | 59.3 | 74.68 |
| 1990 - 1999 | 1577 | 8.62 | 12420 | 7443 | 67.92 | 40.7 |
| 2000 - 2009 | 3750 | 20.51 | 16170 | 5866 | 88.43 | 32.08 |
| 2010 - 2019 | 1691 | 9.25 | 17861 | 2116 | 97.68 | 11.57 |
| 2020 - 2029 | 425 | 2.32 | 18286 | 425 | 100 | 2.32 |
| TOTAL | 18286 | 100 | - | - | - | - |
| Fuente: NYS DEC — Oil, Gas & Other Regulated Wells. Elaboración: Dallyanna Lozano (Grupo 1). | ||||||
vals_x <- TDF_Estado$Categoria
vals_y <- TDF_Estado$ni
ylim_max <- max(vals_y) * 1.15
par(mar = c(10, 5, 4, 2))
bp1 <- barplot(vals_y,
main = "Gráfica N°1: Distribución de la fecha de emisión del permiso por década (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 = "Década de la emisión", line = 8)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = col_principal)vals_y_pct <- TDF_Estado$hi
par(mar = c(10, 5, 4, 2))
bp2 <- barplot(vals_y_pct,
main = "Gráfica N°2: Distribución porcentual de la fecha de emisión del permiso (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 = "Década de la emisión", line = 8)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = col_principal)etiquetas_pct <- paste0(round(vals_y_pct, 1), "% ", vals_x)
paleta_decadas <- colorRampPalette(c("#1B4F72", "#16A085", "#F4D03F", "#E67E22", "#943126"))(length(vals_x))
par(mar = c(2, 2, 4, 9), xpd = TRUE)
pie(vals_y_pct,
labels = NA,
main = "Gráfica N°3: Distribución porcentual de la fecha de emisión del permiso por década (NY)",
cex.main = 0.9,
col = paleta_decadas, border = "white",
radius = 1,
clockwise = TRUE)
legend("right", legend = etiquetas_pct, fill = paleta_decadas, border = "white",
bty = "n", cex = 0.9, inset = c(-0.08, 0), title = "Década", y.intersp = 1.3)Al ser una variable ordinal, los únicos indicadores válidos son los de posición basados en el orden de las categorías: Moda, Mediana y Cuartiles. No se calculan media, varianza, asimetría ni curtosis por no tratarse de una escala numérica.
codigo_num <- as.integer(Variable_Ordinal) # 1 = década más antigua ... k = década más reciente
t_moda <- table(codigo_num)
moda_pos <- as.integer(names(t_moda)[which.max(t_moda)])
mediana_pos <- median(codigo_num)
q1_pos <- quantile(codigo_num, 0.25, type = 1)
q3_pos <- quantile(codigo_num, 0.75, type = 1)
df_indicadores <- data.frame(
"Variable" = "Fecha de Emisión del Permiso (ordinal por década)",
"N" = N,
"Moda" = niveles_orden[moda_pos],
"Mediana" = niveles_orden[mediana_pos],
"Cuartil_1" = niveles_orden[q1_pos],
"Cuartil_3" = niveles_orden[q3_pos],
"Rango_Intercuartilico" = paste0(niveles_orden[q1_pos], " — ", niveles_orden[q3_pos])
)
df_indicadores %>%
gt() %>%
tab_header(
title = md("**TABLA DE INDICADORES**"),
subtitle = "Estadísticos de posición de la variable Fecha de Emisión del Permiso (ordinal por década)"
) %>%
tab_source_note(source_note = "Autor: EDUARDO") %>%
cols_label(
Variable = "Variable", N = "N",
Moda = "Moda (Mo)", Mediana = "Mediana (Me)",
Cuartil_1 = "Cuartil 1 (Q1)", Cuartil_3 = "Cuartil 3 (Q3)",
Rango_Intercuartilico = "Rango Intercuartílico"
) %>%
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 de posición de la variable Fecha de Emisión del Permiso (ordinal por década) | ||||||
| Variable | N | Moda (Mo) | Mediana (Me) | Cuartil 1 (Q1) | Cuartil 3 (Q3) | Rango Intercuartílico |
|---|---|---|---|---|---|---|
| Fecha de Emisión del Permiso (ordinal por década) | 18286 | 1980 - 1989 | 1980 - 1989 | 1970 - 1979 | 2000 - 2009 | 1970 - 1979 — 2000 - 2009 |
| Autor: EDUARDO | ||||||
De un total de 18286 pozos clasificables (se excluyeron 29104 registros sin fecha de emisión de permiso válida), la variable Fecha de Emisión del Permiso se organizó en 8 categorías ordinales por década, desde 1950 - 1959 hasta 2020 - 2029. La década dominante es 1980 - 1989 con 33.98% de los casos. La moda y la mediana coinciden en 1980 - 1989, lo que confirma que más de la mitad de los pozos recibieron su permiso en esa década o en una anterior. Al tratarse de una variable ordinal, el análisis se limita a estadísticos de posición (moda, mediana, cuartiles), sin calcular media, varianza, asimetría ni curtosis.