1. Configuración y carga de datos

# Librerías necesarias
library(dplyr)
library(gt)
library(e1071)

# Paleta de colores del informe
col_principal <- "#0E6655"
col_barras    <- "#16A085"
col_acento    <- "#E67E22"
col_claro     <- "#E8F8F5"
col_grid      <- "#D7DBDD"

# --- Carga de datos ---
# El dataset está separado por ";" y usa codificación Latin-1 (según el archivo
# "Oil_Gas_Other_Regulated_Wells_Beginning_1860" descargado del NYS DEC).
# Ajusta la ruta según la ubicación del archivo en tu equipo.

ruta_csv <- "C:/Users/PATRICIA/Desktop/pr-estadistica/Oil__Gas____Other_Regulated_Wells__Beginning_1860 (3).csv"

Datos <- read.csv(ruta_csv,
                   header = TRUE,
                   sep = ";",
                   dec = ".",
                   fileEncoding = "Latin1",
                   stringsAsFactors = FALSE)

cat("Dimensiones del dataset:", nrow(Datos), "filas x", ncol(Datos), "columnas\n")
## Dimensiones del dataset: 47407 filas x 55 columnas

2. Extracción y limpieza de la variable

# Localizamos la columna de Tarifa de Permiso de forma robusta (el nombre
# puede llegar alterado por R como "Permit.Fee" al leer "Permit Fee")
col_prof <- grep("Permit.Fee", names(Datos), value = TRUE)[1]

if (is.na(col_prof)) stop("ERROR: No se encontró la columna de Tarifa de Permiso en el dataset.")

# Extracción y conversión a numérico
Variable <- suppressWarnings(as.numeric(Datos[[col_prof]]))

# Limpieza: se eliminan NA y valores 0 o sin dato registrado
Variable <- na.omit(Variable)
Variable <- Variable[Variable > 0]

if (length(Variable) == 0) stop("ERROR: No hay datos válidos de Tarifa de Permiso tras la limpieza.")

cat("Columna detectada:", col_prof, "\n")
## Columna detectada: Permit.Fee
cat("N° de pozos con tarifa de permiso válida:", length(Variable), "\n")
## N° de pozos con tarifa de permiso válida: 12959

3. Identificación de la variable

N        <- length(Variable)
min_val  <- min(Variable)
max_val  <- max(Variable)
Rango    <- max_val - min_val
K        <- floor(1 + 3.322 * log10(N))   # N° de clases (Regla de Sturges)
Amplitud <- Rango / K

ficha <- data.frame(
  Característica = c("Nombre de la variable", "Tipo de variable", "Unidad de medida",
                      "Población de referencia", "Tamaño de muestra (N)",
                      "Valor mínimo", "Valor máximo", "Rango",
                      "N° de clases (Sturges)", "Amplitud de clase"),
  Valor = c("Tarifa de permiso (Permit Fee)", "Cuantitativa continua", "Dólares (USD)",
            "Pozos de petróleo y gas de Nueva York con tarifa de permiso registrada",
            as.character(N), round(min_val, 1), round(max_val, 1),
            round(Rango, 1), as.character(K), round(Amplitud, 1))
)

ficha %>%
  gt() %>%
  tab_header(title = md("**FICHA TÉCNICA DE LA VARIABLE**")) %>%
  cols_align(align = "left", 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()) %>%
  opt_row_striping() %>%
  tab_options(table.font.size = px(13), heading.align = "left")
FICHA TÉCNICA DE LA VARIABLE
Característica Valor
Nombre de la variable Tarifa de permiso (Permit Fee)
Tipo de variable Cuantitativa continua
Unidad de medida Dólares (USD)
Población de referencia Pozos de petróleo y gas de Nueva York con tarifa de permiso registrada
Tamaño de muestra (N) 12959
Valor mínimo 0
Valor máximo 11000
Rango 11000
N° de clases (Sturges) 14
Amplitud de clase 785.7

La tarifa de permiso (Permit Fee) es el monto pagado por los derechos de permiso de perforación del pozo, medido en dólares (USD). Se excluyen del análisis los pozos con tarifa 0 o sin dato registrado.

4. Tabla de distribución de frecuencias

breaks_table <- seq(min_val, max_val, length.out = K + 1)
breaks_table[length(breaks_table)] <- max_val + 0.0001

lim_inf_table <- breaks_table[1:K]
lim_sup_table <- breaks_table[2:(K + 1)]
MC <- (lim_inf_table + lim_sup_table) / 2

ni <- numeric(K)
for (i in 1:K) {
  if (i < K) {
    ni[i] <- length(Variable[Variable >= lim_inf_table[i] & Variable < lim_sup_table[i]])
  } else {
    ni[i] <- length(Variable[Variable >= lim_inf_table[i] & Variable <= lim_sup_table[i]])
  }
}

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

TDF_Prof <- data.frame(
  Li = round(lim_inf_table, 1),
  Ls = round(lim_sup_table, 1),
  MC = round(MC, 1),
  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)
)

# Fila de totales
totales <- c("TOTAL", "-", "-", sum(ni), round(sum(hi), 2), "-", "-", "-", "-")
TDF_Char  <- TDF_Prof %>% mutate(across(everything(), as.character))
TDF_Final <- rbind(TDF_Char, totales)

modal_row <- which.max(TDF_Prof$ni)

TDF_Final %>%
  gt() %>%
  tab_header(
    title = md("**DISTRIBUCIÓN DE FRECUENCIAS — TARIFA DE PERMISO**"),
    subtitle = md("Variable: **Tarifa de permiso del pozo (USD)**")
  ) %>%
  tab_spanner(label = "Frecuencias acumuladas",
              columns = c(Ni_asc, Ni_desc, Hi_asc, Hi_desc)) %>%
  cols_label(
    Li = "Lím. Inf", Ls = "Lím. Sup", MC = "Marca de clase (Xi)",
    ni = "ni", hi = "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 = nrow(TDF_Final))) %>%
  opt_row_striping() %>%
  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: JENNY.*"))
DISTRIBUCIÓN DE FRECUENCIAS — TARIFA DE PERMISO
Variable: Tarifa de permiso del pozo (USD)
Lím. Inf Lím. Sup Marca de clase (Xi) ni hi (%)
Frecuencias acumuladas
Ni (Asc) Ni (Desc) Hi (Asc) Hi (Desc)
0 785.7 392.9 5450 42.06 5450 12959 42.06 100
785.7 1571.4 1178.6 6198 47.83 11648 7509 89.88 57.94
1571.4 2357.1 1964.3 864 6.67 12512 1311 96.55 10.12
2357.1 3142.9 2750 222 1.71 12734 447 98.26 3.45
3142.9 3928.6 3535.7 78 0.6 12812 225 98.87 1.74
3928.6 4714.3 4321.4 79 0.61 12891 147 99.48 1.13
4714.3 5500 5107.1 55 0.42 12946 68 99.9 0.52
5500 6285.7 5892.9 10 0.08 12956 13 99.98 0.1
6285.7 7071.4 6678.6 2 0.02 12958 3 99.99 0.02
7071.4 7857.1 7464.3 0 0 12958 1 99.99 0.01
7857.1 8642.9 8250 0 0 12958 1 99.99 0.01
8642.9 9428.6 9035.7 0 0 12958 1 99.99 0.01
9428.6 10214.3 9821.4 0 0 12958 1 99.99 0.01
10214.3 11000 10607.1 1 0.01 12959 1 100 0.01
TOTAL - - 12959 100 - - - -
Fuente: NYS DEC — Oil, Gas & Other Regulated Wells. Elaboración: JENNY.

5. Representación gráfica

h_base <- hist(Variable, breaks = "Sturges", plot = FALSE)

5.1 Histogramas

# Marcas "redondas" del eje Y que abarcan holgadamente la barra más alta,
# para que ninguna barra sobresalga por encima de la última línea de la grilla
y_ticks_freq <- pretty(c(0, h_base$counts), n = 6)
y_top_freq   <- max(y_ticks_freq)

# Margen izquierdo ampliado (7) para que los números del eje (p. ej. "20,000")
# no se superpongan con el título del eje Y
par(mar = c(8, 7, 5, 2))
plot(h_base,
     main = "Gráfica N°1: Distribución de la tarifa de permiso de los pozos (NY)",
     xlab = "Tarifa de permiso (USD)", ylab = "",
     col = col_barras, border = "white", axes = FALSE,
     xlim = range(h_base$breaks), xaxs = "i",
     ylim = c(0, y_top_freq), yaxs = "i")
axis(1, at = round(h_base$breaks), labels = format(round(h_base$breaks), big.mark = ","),
     las = 2, cex.axis = 0.7)
axis(2, at = y_ticks_freq, labels = format(y_ticks_freq, big.mark = ","),
     las = 1, cex.axis = 0.8)
# Título del eje Y separado de los números (line = 5) para evitar el choque
mtext("Frecuencia absoluta (n° de pozos)", side = 2, line = 5, cex = 0.9)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = "black")

5.2 Histograma porcentual

h_porc <- h_base
h_porc$counts  <- (h_porc$counts / sum(h_porc$counts)) * 100
h_porc$density <- h_porc$counts

# Se deja espacio extra arriba (además de la etiqueta "%") para que ni la
# barra ni su etiqueta de texto sobresalgan del área del gráfico
y_ticks_porc <- pretty(c(0, h_porc$counts), n = 6)
y_max        <- max(y_ticks_porc) + (y_ticks_porc[2] - y_ticks_porc[1]) * 0.4

# Margen izquierdo ampliado (7) para que los números del eje no choquen
# con el título del eje Y
par(mar = c(8, 7, 5, 2))
plot(h_porc,
     main = "Gráfica N°2: Distribución porcentual de la tarifa de permiso",
     xlab = "Tarifa de permiso (USD)", ylab = "",
     col = col_barras, border = "white", axes = FALSE,
     xlim = range(h_base$breaks), xaxs = "i",
     ylim = c(0, y_max), yaxs = "i")
axis(1, at = round(h_base$breaks), labels = format(round(h_base$breaks), big.mark = ","),
     las = 2, cex.axis = 0.7)
axis(2, at = y_ticks_porc, las = 1, cex.axis = 0.8)
mtext("Porcentaje de pozos (%)", side = 2, line = 5, cex = 0.9)
text(x = h_base$mids, y = h_porc$counts, labels = paste0(round(h_porc$counts, 1), "%"),
     pos = 3, cex = 0.6, col = col_principal)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")
box(bty = "l", col = "black")

5.3 Diagrama de caja

par(mar = c(7, 5, 4, 2))
boxplot(Variable, horizontal = TRUE, col = col_barras,
        main = "Gráfica N°3: Diagrama de caja de la tarifa de permiso",
        xlab = "", outline = TRUE, axes = FALSE,
        outcol = col_acento, boxwex = 0.5, frame.plot = FALSE)
eje_x <- pretty(Variable, n = 8)
axis(1, at = eje_x, labels = format(eje_x, scientific = FALSE, big.mark = ","),
     las = 2, cex.axis = 0.8)
mtext("Tarifa de permiso (USD)", side = 1, line = 5.5)
grid(nx = NULL, ny = NA, col = col_grid, lty = "dotted")

5.4 Diagrama de ojivas

par(mar = c(5, 5, 4, 8), xpd = TRUE)

x_ac    <- breaks_table
y_asc   <- c(0, Ni_asc)
y_des   <- c(Ni_desc, 0)
x_range <- range(x_ac)
y_range <- c(0, max(c(y_asc, y_des)))

plot(x_ac, y_asc, type = "o", col = col_principal, lwd = 2, pch = 16,
     main = "Gráfica N°4: Ojivas de la tarifa de permiso",
     xlab = "Tarifa de permiso (USD)", ylab = "Frecuencia acumulada (n° de pozos)",
     xlim = x_range, ylim = y_range, axes = FALSE, frame.plot = FALSE)
axis(1, at = round(breaks_table), labels = format(round(breaks_table), big.mark = ","),
     las = 2, cex.axis = 0.6)
axis(2, at = pretty(y_asc), labels = format(pretty(y_asc), big.mark = ","))
lines(x_ac, y_des, type = "o", col = col_acento, lwd = 2, pch = 16)
legend("right", legend = c("Ascendente (Ni↑)", "Descendente (Ni↓)"),
       col = c(col_principal, col_acento), lty = 1, pch = 16,
       inset = c(-0.18, 0), bty = "n")
grid(col = col_grid, lty = "dotted")

6. Tabla de indicadores

media_val    <- mean(Variable)
mediana_val  <- median(Variable)
freq_max     <- max(TDF_Prof$ni)
modas_calc   <- TDF_Prof$MC[TDF_Prof$ni == freq_max]
moda_txt     <- paste(round(modas_calc, 1), collapse = " ; ")
rango_txt    <- paste0("[", round(min_val, 1), " ; ", round(max_val, 1), "]")
varianza_val <- var(Variable)
sd_val       <- sd(Variable)
cv_val       <- (sd_val / abs(media_val)) * 100
asimetria_val <- skewness(Variable, type = 2)
curtosis_val  <- kurtosis(Variable, type = 2)

vals_atipicos  <- boxplot.stats(Variable)$out
num_atipicos   <- length(vals_atipicos)
status_atipicos <- if (num_atipicos > 0) {
  paste0(num_atipicos, " [", round(min(vals_atipicos), 1), " ; ", round(max(vals_atipicos), 1), "]")
} else {
  "0 (Sin atípicos)"
}

df_resumen <- data.frame(
  "Variable"  = "Tarifa de permiso (USD)",
  "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,
  check.names = FALSE
)

df_resumen %>%
  gt() %>%
  tab_header(
    title = md("**RESUMEN ESTADÍSTICO Y MEDIDAS DESCRIPTIVAS**"),
    subtitle = "Indicadores de la tarifa de permiso de los pozos (USD) — Nueva York"
  ) %>%
  tab_source_note(source_note = "Autor: JENNY") %>%
  fmt_number(columns = c(Media, Mediana, Varianza, Desv_Std, CV_Porc), decimals = 2) %>%
  fmt_number(columns = c(Asimetria, Curtosis), decimals = 4) %>%
  cols_label(
    Variable = "Variable", Rango = "Rango Total",
    Media = "Media (X)", Mediana = "Mediana (Me)", Moda = "Moda (Mo)",
    Varianza = "Varianza (S2)", Desv_Std = "Desv. Est. (S)", CV_Porc = "C.V. (%)",
    Asimetria = "Asimetría (As)", Curtosis = "Curtosis", Atipicos = "Atípicos"
  ) %>%
  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_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
  )
RESUMEN ESTADÍSTICO Y MEDIDAS DESCRIPTIVAS
Indicadores de la tarifa de permiso de los pozos (USD) — Nueva York
Variable Rango Total Media (X) Mediana (Me) Moda (Mo) Varianza (S2) Desv. Est. (S) C.V. (%) Asimetría (As) Curtosis Atípicos
Tarifa de permiso (USD) [0 ; 11000] 932.48 860.00 1178.6 485,508.99 696.78 74.72 2.8069 15.0146 813 [1875 ; 11000]
Autor: JENNY

7. Conclusiones

La variable Tarifa de permiso fluctúa entre 0 y 11000 dólares, y sus valores se concentran alrededor de 932.5 USD (mediana ≈ 860 USD). Presenta una desviación estándar de 696.8 USD, siendo una variable heterogénea (C.V. = 74.72%).

La distribución es asimétrica positiva (sesgo hacia la derecha) (As = 2.8069) y leptocúrtica (más apuntada que la normal) (Curtosis = 15.0146). Se identificaron 813 valores atípicos en el conjunto de datos.

De un total de 47407 pozos registrados en la base original, 12959 pozos presentan un dato de tarifa de permiso válido (> 0), lo cual permite caracterizar el costo económico de los permisos de perforación en Nueva York.