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 Profundidad de forma robusta (el nombre
# puede llegar alterado por R como "Depth.Fee" al leer "Depth Fee")
col_prof <- grep("Depth.Fee", names(Datos), value = TRUE)[1]

if (is.na(col_prof)) stop("ERROR: No se encontró la columna de Tarifa de Profundidad 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 Profundidad tras la limpieza.")

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

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 profundidad (Depth Fee)", "Cuantitativa continua", "Dólares (USD)",
            "Pozos de petróleo y gas de Nueva York con tarifa de profundidad 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 profundidad (Depth 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 profundidad registrada
Tamaño de muestra (N) 11696
Valor mínimo 90
Valor máximo 10900
Rango 10810
N° de clases (Sturges) 14
Amplitud de clase 772.1

La tarifa de profundidad (Depth Fee) es la tasa pagada en función de la profundidad del pozo, medida 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 PROFUNDIDAD**"),
    subtitle = md("Variable: **Tarifa de profundidad 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 PROFUNDIDAD
Variable: Tarifa de profundidad 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)
90 862.1 476.1 6445 55.1 6445 11696 55.1 100
862.1 1634.3 1248.2 4184 35.77 10629 5251 90.88 44.9
1634.3 2406.4 2020.4 684 5.85 11313 1067 96.73 9.12
2406.4 3178.6 2792.5 158 1.35 11471 383 98.08 3.27
3178.6 3950.7 3564.6 78 0.67 11549 225 98.74 1.92
3950.7 4722.9 4336.8 79 0.68 11628 147 99.42 1.26
4722.9 5495 5108.9 55 0.47 11683 68 99.89 0.58
5495 6267.1 5881.1 10 0.09 11693 13 99.97 0.11
6267.1 7039.3 6653.2 2 0.02 11695 3 99.99 0.03
7039.3 7811.4 7425.4 0 0 11695 1 99.99 0.01
7811.4 8583.6 8197.5 0 0 11695 1 99.99 0.01
8583.6 9355.7 8969.6 0 0 11695 1 99.99 0.01
9355.7 10127.9 9741.8 0 0 11695 1 99.99 0.01
10127.9 10900 10513.9 1 0.01 11696 1 100 0.01
TOTAL - - 11696 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 profundidad de los pozos (NY)",
     xlab = "Tarifa de profundidad (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 profundidad",
     xlab = "Tarifa de profundidad (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 profundidad",
        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 profundidad (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 profundidad",
     xlab = "Tarifa de profundidad (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 profundidad (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 profundidad 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 profundidad 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 profundidad (USD) [90 ; 10900] 931.02 760.00 476.1 438,310.80 662.05 71.11 3.4586 18.9085 576 [2000 ; 10900]
Autor: JENNY

7. Conclusiones

La variable Tarifa de profundidad fluctúa entre 90 y 10900 dólares, y sus valores se concentran alrededor de 931 USD (mediana ≈ 760 USD). Presenta una desviación estándar de 662.1 USD, siendo una variable heterogénea (C.V. = 71.11%).

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

De un total de 47407 pozos registrados en la base original, 11696 pozos presentan un dato de tarifa de profundidad válido (> 0), lo cual permite caracterizar el costo asociado a la profundidad de perforación de los pozos en Nueva York.