PERMIT FEE, USD (INFERENCIAL)

Tarifa de permiso del pozo

1 CARGA DE DATOS Y LIBRERÍAS

# 1. LIBRERÍAS (silenciadas para el informe)
suppressPackageStartupMessages({
  library(tidyverse)
  library(MASS)
  library(gt)
})

# 2. CARGAR EL ARCHIVO
# 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"

if (!file.exists(ruta_csv)) {
  stop(paste0(
    "ERROR: No se encontró el archivo en la ruta indicada:\n  ", ruta_csv,
    "\nSi moviste el archivo de carpeta, actualiza la línea 'ruta_csv <- \"...\"' ",
    "de este chunk con la nueva ubicación (usa '/' en vez de '\\')."
  ))
}

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

# 3. VERIFICAR DATOS
cat("Dimensiones del dataset:", nrow(Datos), "filas x", ncol(Datos), "columnas\n")

## Dimensiones del dataset: 47407 filas x 55 columnas

2 EXTRACCIÓN DE VARIABLE ALEATORIA

La Tarifa de Permiso (Permit Fee, USD) se define como una variable cuantitativa continua, ya que representa el monto pagado por los derechos de permiso de perforación del pozo, expresado en dólares. Admite cualquier valor decimal dentro de un rango determinado, por lo que su naturaleza no se limita a saltos discretos.

# Localización robusta de la columna (p. ej. "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.")

permit_fee <- suppressWarnings(as.numeric(Datos[[col_prof]]))
permit_fee <- na.omit(permit_fee)
permit_fee <- permit_fee[permit_fee > 0]

elevation_clean <- permit_fee
n_total <- length(elevation_clean)

cat("Columna detectada:", col_prof, "\n")

## Columna detectada: Permit.Fee

cat("N° de pozos con tarifa de permiso válida (n):", n_total, "\n")

## N° de pozos con tarifa de permiso válida (n): 12959

3 TABLA DE DISTRIBUCIÓN DE FRECUENCIAS

# 1. HISTOGRAMA BASE (Sturges automático) -> define las clases oficiales
h_base <- hist(elevation_clean, breaks = "Sturges", plot = FALSE)

breaks_raw  <- h_base$breaks
K_raw       <- length(h_base$counts)
min_val     <- min(elevation_clean)
max_val     <- max(elevation_clean)

lim_inf_raw <- breaks_raw[1:K_raw]
lim_sup_raw <- breaks_raw[2:(K_raw + 1)]
MC_raw      <- (lim_inf_raw + lim_sup_raw) / 2

# 2. FRECUENCIAS SIMPLES (tomadas directamente del histograma base)
ni_raw <- h_base$counts
hi_raw <- (ni_raw / sum(ni_raw)) * 100

# 3. CONSTRUCCIÓN DEL DATAFRAME BASE
df_tabla_raw <- data.frame(
  Li = as.character(round(lim_inf_raw, 0)),
  Ls = as.character(round(lim_sup_raw, 0)),
  MC = as.character(round(MC_raw, 0)),
  ni = ni_raw,
  hi = hi_raw
)

# 4. FILA DE TOTALES
fila_total <- data.frame(Li = "TOTAL", Ls = "", MC = "", ni = sum(ni_raw), hi = sum(hi_raw))
df_final <- rbind(df_tabla_raw, fila_total)

# 5. TABLA GT
df_final %>%
  gt() %>%
  tab_header(
    title = md("**TABLA N° 1: DISTRIBUCIÓN DE FRECUENCIAS DE LA TARIFA DE PERMISO**"),
    subtitle = md(paste("Validación de datos: n =", n_total))
  ) %>%
  cols_label(Li = "Lím. Inf", Ls = "Lím. Sup", MC = "Marca Clase (Xi)", ni = "ni", hi = "hi (%)") %>%
  fmt_number(columns = ni, decimals = 0) %>%
  fmt_number(columns = hi, decimals = 2) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(style = list(cell_fill(color = "#148F77"), cell_text(color = "white", weight = "bold")),
            locations = cells_column_labels()) %>%
  tab_style(style = list(cell_text(weight = "bold"), cell_fill(color = "#D0ECE7")),
            locations = cells_body(rows = nrow(df_final))) %>%
  tab_options(table.width = pct(100), data_row.padding = px(5)) %>%
  tab_source_note(source_note = md("**Autor:** Jennifer Oyasa"))

TABLA N° 1: DISTRIBUCIÓN DE FRECUENCIAS DE LA TARIFA DE PERMISO
Validación de datos: n = 12959
Lím. Inf	Lím. Sup	Marca Clase (Xi)	ni	hi (%)
0	1000	500	8,272	63.83
1000	2000	1500	4,111	31.72
2000	3000	2500	336	2.59
3000	4000	3500	93	0.72
4000	5000	4500	90	0.69
5000	6000	5500	53	0.41
6000	7000	6500	3	0.02
7000	8000	7500	0	0.00
8000	9000	8500	0	0.00
9000	10000	9500	0	0.00
10000	11000	10500	1	0.01
TOTAL			12,959	100.00
Autor: Jennifer Oyasa

4 ANÁLISIS GRÁFICO

col_barras <- "#16A085"
col_grid   <- "#D7DBDD"

cortes_seg <- breaks_raw
n_seg      <- n_total

par(mar = c(6, 5, 4, 2))
h_prof <- h_base
h_prof$counts <- (h_prof$counts / n_seg) * 100

plot(h_prof,
     main = "Gráfica N° 1: Distribución porcentual de la Tarifa de Permiso",
     xlab = "Tarifa de Permiso (USD)",
     ylab = "Porcentaje (%)",
     col = col_barras, border = "white",
     axes = FALSE,
     ylim = c(0, max(h_prof$counts) * 1.2))

axis(2, las = 2, cex.axis = 0.7)
axis(1, at = cortes_seg, labels = format(round(cortes_seg), big.mark = ","),
     las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")

legend("topright",
       legend = "Datos Empíricos (Tarifa de Permiso)",
       fill = col_barras, border = "white", bty = "n", cex = 0.8)

5 CONJETURA DE MODELO

A partir de la forma observada en la Gráfica N° 1 —una densidad máxima en los valores más bajos que decrece de manera monótona y continua, sin formar una “joroba” central— se conjetura que la variable Tarifa de Permiso se ajusta a una Distribución Exponencial.

suppressPackageStartupMessages({
  library(MASS)
})

# Ajuste del modelo Exponencial por máxima verosimilitud
ajuste_exp <- fitdistr(elevation_clean, "exponential")

rate_e <- ajuste_exp$estimate["rate"]

cat("Exponencial: rate =", round(rate_e, 6), " (media teórica = 1/rate =",
    round(1 / rate_e, 2), ")\n")

## Exponencial: rate = 0.001072  (media teórica = 1/rate = 932.48 )

par(mar = c(6, 5, 4, 2))
h_prof2 <- h_base
h_prof2$counts <- (h_prof2$counts / n_seg) * 100

plot(h_prof2,
     main = "Gráfica N° 2: Conjetura del Modelo Exponencial sobre la Tarifa de Permiso",
     xlab = "Tarifa de Permiso (USD)", ylab = "Porcentaje (%)",
     col = col_barras, border = "white", axes = FALSE,
     ylim = c(0, max(h_prof2$counts) * 1.3))

x_curva    <- seq(min_val, max_val, length.out = 400)
y_densidad <- dexp(x_curva, rate = rate_e)

# Escalado visual de la curva teórica a la altura del histograma
max_h_obs     <- max(h_prof2$counts)
max_y_teorico <- max(y_densidad)
y_curva_hi    <- (y_densidad / max_y_teorico) * max_h_obs

lines(x_curva, y_curva_hi, col = "#C0392B", lwd = 4)

axis(2, las = 2, cex.axis = 0.7)
axis(1, at = cortes_seg, labels = format(round(cortes_seg), big.mark = ","),
     las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")

legend("topright",
       legend = c("Datos Empíricos (Tarifa de Permiso)", "Modelo Exponencial (conjeturado)"),
       fill = c(col_barras, NA), border = c("white", NA),
       col = c(NA, "#C0392B"), lwd = c(NA, 4), lty = c(NA, 1),
       bty = "n", cex = 0.8)

6 TEST DE BONDAD

Para cada clase de la Tabla N° 1 se calcula la frecuencia relativa teórica (hi esperada) a partir de la función de distribución acumulada de la Exponencial, evaluada en los mismos límites de clase, y se compara con la frecuencia relativa observada. Se trabaja sobre frecuencias relativas (porcentuales), consistente con la tabla y el histograma de las secciones anteriores.

K_val <- K_raw

# Frecuencias observadas (hi %, calculadas en la sección 3)
Fo_c <- hi_raw

# Frecuencias esperadas bajo el modelo Exponencial conjeturado
probs_exp <- diff(pexp(breaks_raw, rate = rate_e))
probs_exp <- probs_exp / sum(probs_exp)
Fe_c      <- probs_exp * 100

tabla_fo_fe <- data.frame(
  Clase = paste0(round(lim_inf_raw, 0), " - ", round(lim_sup_raw, 0)),
  hi_Observada = Fo_c,
  hi_Esperada  = Fe_c
)

tabla_fo_fe %>%
  gt() %>%
  tab_header(title = md("**Frecuencias Observadas vs. Esperadas (Modelo Exponencial)**")) %>%
  fmt_number(columns = c(hi_Observada, hi_Esperada), decimals = 2) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_options(table.width = pct(90))

Frecuencias Observadas vs. Esperadas (Modelo Exponencial)
Clase	hi_Observada	hi_Esperada
0 - 1000	63.83	65.78
1000 - 2000	31.72	22.51
2000 - 3000	2.59	7.70
3000 - 4000	0.72	2.64
4000 - 5000	0.69	0.90
5000 - 6000	0.41	0.31
6000 - 7000	0.02	0.11
7000 - 8000	0.00	0.04
8000 - 9000	0.00	0.01
9000 - 10000	0.00	0.00
10000 - 11000	0.01	0.00

6.1 TEST DE PEARSON

pearson_val <- cor(Fo_c, Fe_c) * 100

cat("Coeficiente de correlación de Pearson:", round(pearson_val, 2), "%\n")

## Coeficiente de correlación de Pearson: 98.58 %

Con un coeficiente de correlación de Pearson de 98.58%, se confirma un grado de asociación muy alto entre las frecuencias observadas y las esperadas bajo el modelo Exponencial, lo que respalda la conjetura planteada en la sección 5.

6.2 TEST CHI-CUADRADO

La prueba Chi-cuadrado de bondad de ajuste contrasta formalmente si las diferencias entre las frecuencias observadas y esperadas son atribuibles al azar (modelo aceptado) o son estadísticamente significativas (modelo rechazado), a un nivel de significancia α = 0.01.

\[\chi^2_{calc} = \sum \frac{(F_o - F_e)^2}{F_e}\]

# Grados de libertad: K clases - 1 - parámetro estimado (rate)
n_param  <- 1
df_val   <- max(1, K_val - 1 - n_param)

chi_calc <- sum((Fo_c - Fe_c)^2 / Fe_c)
chi_crit <- qchisq(0.99, df_val)

resultado_chi <- if (chi_calc < chi_crit) "APROBADO" else "RECHAZADO"

resumen_modelo <- data.frame(
  Modelo = "Exponencial",
  Pearson_Perc = pearson_val,
  Chi_Calc = chi_calc,
  Chi_Crit = chi_crit,
  Df = df_val,
  Estado = resultado_chi
)

cat("Chi-cuadrado calculado:", round(chi_calc, 4), "\n")

## Chi-cuadrado calculado: 8.839

cat("Chi-cuadrado crítico (alpha = 0.01, g.l. =", df_val, "):", round(chi_crit, 4), "\n")

## Chi-cuadrado crítico (alpha = 0.01, g.l. = 9 ): 21.666

cat("Resultado de la prueba:", resultado_chi, "\n")

## Resultado de la prueba: APROBADO

resumen_modelo %>%
  gt() %>%
  tab_header(
    title = md("**TABLA N° 2: RESUMEN DE VALIDACIÓN DEL MODELO EXPONENCIAL**"),
    subtitle = md(paste0("Variable: Tarifa de Permiso (USD) | Rate = ", round(rate_e, 6)))
  ) %>%
  cols_label(
    Modelo = md("**Modelo**"),
    Pearson_Perc = md("**Pearson (%)**"),
    Chi_Calc = md("**Chi-Cuadrado Calc.**"),
    Chi_Crit = md("**Chi-Cuadrado Crít.**"),
    Df = md("**g.l.**"),
    Estado = md("**Resultado**")
  ) %>%
  fmt_number(columns = c(Pearson_Perc, Chi_Calc, Chi_Crit), decimals = 2) %>%
  cols_align(align = "center", columns = everything()) %>%
  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 = "#D0ECE7"), cell_text(weight = "bold", color = "#0E6655")),
    locations = cells_body(rows = Estado == "APROBADO")
  ) %>%
  tab_options(table.width = pct(95), table.align = "center", data_row.padding = px(10)) %>%
  tab_source_note(source_note = md("**Autor:** Jennifer Oyasa"))

TABLA N° 2: RESUMEN DE VALIDACIÓN DEL MODELO EXPONENCIAL
Variable: Tarifa de Permiso (USD) | Rate = 0.001072
Modelo	Pearson (%)	Chi-Cuadrado Calc.	Chi-Cuadrado Crít.	g.l.	Resultado
Exponencial	98.58	8.84	21.67	9	APROBADO
Autor: Jennifer Oyasa

Dado que el estadístico Chi-calculado (8.84) se mantiene por debajo del Chi-crítico (21.67, α = 0.01), y la correlación de Pearson es de 98.58%, el modelo Exponencial queda APROBADO para representar la Tarifa de Permiso.

7 CÁLCULO DE PROBABILIDADES

Tras validar que la Tarifa de Permiso se ajusta a un modelo Exponencial (rate = 0.001072)

x_curva    <- seq(min_val, max_val, length.out = 1000)
y_densidad <- dexp(x_curva, rate = rate_e)

par(mar = c(6, 5, 5, 2))
plot(x_curva, y_densidad, type = "n",
     main = "Gráfica N° 3: Análisis de Probabilidad Operativa",
     xlab = "Tarifa de Permiso (USD)", ylab = "Densidad de Probabilidad",
     axes = FALSE, ylim = c(0, max(y_densidad) * 1.2))

# Tarifa Baja (min - 500 USD)
x_p1 <- seq(min_val, 500, length.out = 200)
y_p1 <- dexp(x_p1, rate = rate_e)
polygon(c(min_val, x_p1, 500), c(0, y_p1, 0),
        col = rgb(40, 180, 99, alpha = 160, maxColorValue = 255), border = NA)

# Tarifa Alta (> 2000 USD)
x_p2 <- seq(2000, max_val, length.out = 300)
y_p2 <- dexp(x_p2, rate = rate_e)
polygon(c(2000, x_p2, max_val), c(0, y_p2, 0),
        col = rgb(46, 134, 193, alpha = 140, maxColorValue = 255), border = NA)

lines(x_curva, y_densidad, col = "#C0392B", lwd = 4)

axis(1, at = c(round(min_val), 500, 2000, round(max_val)),
     labels = format(c(round(min_val), 500, 2000, round(max_val)), big.mark = ","))
axis(2, las = 2, cex.axis = 0.7)
grid(nx = NA, ny = NULL, col = col_grid, lty = "dotted")

legend("topright",
       legend = c("Modelo Exponencial (Validado)",
                  paste0("P1: Tarifa Baja (", round(min_val), "-500 USD)"),
                  "P2: Tarifa Alta (>2000 USD)"),
       col = c("#C0392B", NA, NA), lty = c(1, NA, NA), lwd = c(3, NA, NA),
       fill = c(NA, rgb(40, 180, 99, alpha = 160, maxColorValue = 255),
                rgb(46, 134, 193, alpha = 140, maxColorValue = 255)),
       border = c(NA, "black", "black"), bty = "n", cex = 0.75)

# Solución Pregunta 1 (Tarifa Baja: min_val a 500 USD)
prob_baja <- pexp(500, rate = rate_e) - pexp(min_val, rate = rate_e)
cat("La probabilidad de pozos en la Tarifa Baja es de:", round(prob_baja * 100, 2), "%\n")

## La probabilidad de pozos en la Tarifa Baja es de: 41.5 %

# Solución Pregunta 2 (Tarifa Alta: > 2000 USD, de un lote de 500 pozos)
prob_alta <- 1 - pexp(2000, rate = rate_e)
pozos_estimados <- 500 * prob_alta
cat("Se estima que", round(pozos_estimados, 0), "pozos (de 500) caerán en la Tarifa Alta\n")

## Se estima que 59 pozos (de 500) caerán en la Tarifa Alta

Respuesta 1: Existe una probabilidad de 41.5% de que un pozo pague una Tarifa Baja (0–500 USD), el rango más frecuente del trámite de permiso.

Respuesta 2: Se estima que 59 pozos (de un lote de 500) pagarán una Tarifa Alta (más de 2000 USD), lo que representa una fracción minoritaria del total y permite anticipar los ingresos por derechos de perforación asociados a pozos de mayor envergadura.

8 INTERVALO DE CONFIANZA

El intervalo de confianza establece que, dada una muestra suficientemente grande (n > 30), la distribución de las medias muestrales se aproxima a una Normal por el Teorema del Límite Central (TLC). Esto permite estimar la media poblacional (μ) real utilizando intervalos de confianza:

\[P(\bar{x} - E < \mu < \bar{x} + E) \approx 68\%\] \[P(\bar{x} - 2E < \mu < \bar{x} + 2E) \approx 95\%\] \[P(\bar{x} - 3E < \mu < \bar{x} + 3E) \approx 99\%\]

Donde el margen de error (E) se define como:

\[E = \frac{\sigma}{\sqrt{n}}\]

# 1. ESTADÍSTICOS ARITMÉTICOS
x_bar_e <- mean(elevation_clean)
sigma_e <- sd(elevation_clean)
n_e     <- length(elevation_clean)

# 2. ERROR ESTÁNDAR Y MARGEN AL 95%
error_est_e    <- sigma_e / sqrt(n_e)
margen_error_e <- 2 * error_est_e

# 3. INTERVALO DE CONFIANZA
lim_inf_e <- x_bar_e - margen_error_e
lim_sup_e <- x_bar_e + margen_error_e

# 4. TABLA RESUMEN
tabla_tlc_e <- data.frame(
  Parametro = "Tarifa de Permiso Promedio (USD)",
  Lim_Inferior = lim_inf_e,
  Media_Muestral = x_bar_e,
  Lim_Superior = lim_sup_e,
  Error_Estandar = paste0("+/- ", sprintf("%.4f", margen_error_e)),
  Confianza = "95% (2*E)"
)

tabla_tlc_e %>%
  gt() %>%
  tab_header(
    title = md("**ESTIMACIÓN DE LA MEDIA POBLACIONAL (TARIFA DE PERMISO)**"),
    subtitle = "Aplicación del Teorema del Límite Central"
  ) %>%
  cols_label(
    Parametro = "Parámetro", Lim_Inferior = "Límite Inferior",
    Media_Muestral = "Media Calculada", Lim_Superior = "Límite Superior",
    Error_Estandar = "Error Estimado"
  ) %>%
  fmt_number(columns = c(Lim_Inferior, Media_Muestral, Lim_Superior), decimals = 2) %>%
  tab_style(style = list(cell_fill(color = "#D0ECE7")), locations = cells_body(columns = Media_Muestral)) %>%
  tab_options(table.width = pct(90)) %>%
  tab_source_note(source_note = md("**Autor:** Jennifer Oyasa"))

ESTIMACIÓN DE LA MEDIA POBLACIONAL (TARIFA DE PERMISO)
Aplicación del Teorema del Límite Central
Parámetro	Límite Inferior	Media Calculada	Límite Superior	Error Estimado	Confianza
Tarifa de Permiso Promedio (USD)	920.24	932.48	944.73	+/- 12.2417	95% (2*E)
Autor: Jennifer Oyasa

9 CONCLUSIÓN

La variable Tarifa de Permiso (Permit Fee, USD) fue modelada mediante una Distribución Exponencial (rate = 0.001072), la cual reflejó de forma adecuada la altísima concentración de pozos con tarifas bajas y la caída rápida y continua de la probabilidad a medida que la tarifa aumenta. El modelo superó la prueba Chi-cuadrado (8.84 < 21.67, α = 0.01) y presentó una correlación de Pearson de 98.58% entre frecuencias observadas y esperadas.

Con una media muestral de 932.48 USD y aplicando el Intervalo de Confianza, se estima que la media poblacional se sitúa entre [920.24; 944.73] USD con un 95% de confianza. Estos resultados permiten anticipar los ingresos esperados por derechos de permiso y estandarizar los protocolos de estimación de costos administrativos según el comportamiento observado de la tarifa (μ = 932.48 ± 12.24 USD).