Average Production (Inferencial)
Leslye Quinchiguango
2026-06-16
1 Configuración y Carga de Datos
Se carga el conjunto de datos correspondiente a los arrendamientos de hidrocarburos en el estado de Kansas para proceder con el análisis inferencial de la variable cuantitativa Average Production.
ruta_csv <- "C:/Users/luisq/OneDrive/Desktop/ESTADISTICA/kansas.csv"
# Lectura robusta del CSV.
# El archivo puede venir separado por coma (,) o por punto y coma (;).
leer_csv_robusto <- function(ruta) {
datos_coma <- tryCatch(
readr::read_delim(ruta, delim = ",", show_col_types = FALSE, trim_ws = TRUE),
error = function(e) NULL
)
datos_punto_coma <- tryCatch(
readr::read_delim(ruta, delim = ";", show_col_types = FALSE, trim_ws = TRUE),
error = function(e) NULL
)
ncol_coma <- ifelse(is.null(datos_coma), 0, ncol(datos_coma))
ncol_punto_coma <- ifelse(is.null(datos_punto_coma), 0, ncol(datos_punto_coma))
if (ncol_coma >= ncol_punto_coma && ncol_coma > 1) {
attr(datos_coma, "delimitador_usado") <- ","
return(datos_coma)
}
if (ncol_punto_coma > 1) {
attr(datos_punto_coma, "delimitador_usado") <- ";"
return(datos_punto_coma)
}
stop("No se pudo leer correctamente el CSV. Revisa la ruta o el separador del archivo.")
}
datos <- leer_csv_robusto(ruta_csv)
names(datos) <- trimws(names(datos))
names(datos) <- gsub("^\\ufeff", "", names(datos))
cat("Dataset cargado correctamente.\n")## Dataset cargado correctamente.cat("Delimitador usado:", attr(datos, "delimitador_usado"), "\n")## Delimitador usado: ;cat("Total de registros evaluados (filas):", nrow(datos), "\n")## Total de registros evaluados (filas): 104173cat("Columnas disponibles:\n")## Columnas disponibles:print(names(datos))## [1] "CODE" "DEPT_WATER_RESOURCES_CODE"
## [3] "DEPT_MOTOR_VEHICLES_ABBREV" "NAME"
## [5] "WIZARD_BASE_REFERENCE_YEAR" "WIZARD_PREDEVELOPMENT_YEAR"
## [7] "UPDATE_DATE_1" "UPDATE_INITIALS_1"
## [9] "ABBREVIATED_TO_4_CHARS" "KCC_DISTRICT_NUMBER"
## [11] "OBJECTID" "KID"
## [13] "LEASE_NAME" "FIELD_KID"
## [15] "OPERATOR_KID" "LEASE_CODE_PI_BEENE"
## [17] "LEASE_CODE_DOR" "PRODUCES_GAS"
## [19] "PRODUCES_OIL" "STATE_CODE"
## [21] "COUNTY_CODE" "LATITUDE"
## [23] "LATITUDE_LEO_FOOTAGES" "LATITUDE_LEO_QUARTER_CALLS"
## [25] "LATITUDE_DIRECTION" "LONGITUDE"
## [27] "LONGITUDE_LEO_FOOTAGES" "LONGITUDE_LEO_QUARTER_CALLS"
## [29] "LONGITUDE_DIRECTION" "LONGITUDE_LATITUDE_SOURCE"
## [31] "PRINCIPAL_MERIDIAN" "TOWNSHIP"
## [33] "TOWNSHIP_DIRECTION" "RANGE"
## [35] "RANGE_DIRECTION" "SECTION"
## [37] "SUBDIVISION_1_LARGEST" "SUBDIVISION_2"
## [39] "SUBDIVISION_3" "SUBDIVISION_4_SMALLEST"
## [41] "SPOT" "FEET_NORTH_FROM_REFERENCE"
## [43] "FEET_EAST_FROM_REFERENCE" "REFERENCE_CORNER"
## [45] "MEETS_AND_BOUNDS" "OLD_SPOT_OR_LOCATION"
## [47] "UPDATE_INITIALS" "UPDATE_DATE"
## [49] "SKIP_IT" "COMMENTS"
## [51] "CORRECTIONS" "OPERATOR_NAME"
## [53] "PRODUCING_FORMATION" "DEPTH_OF_WELL"
## [55] "FIELD_CODE_DOR" "DATA_SOURCE"
## [57] "CUMULATIVE_PRODUCTION" "CUMULATIVE_YEAR_STARTED"
## [59] "CUMULATIVE_YEAR_ENDED" "FIELD_KID_SOURCE"
## [61] "LEASE_KID" "LEASE_KID_SOURCE"
## [63] "PRODUCING_FORMATION_OLD" "QUARTER_CALLS_SOURCE"
## [65] "OPERATOR_NAME_OLD" "PRODUCING_FORMATION_STRAT_KID"
## [67] "PRODUCING_FORMATION_SOURCE" "LONGITUDE_LATITUDE_DATUM"
## [69] "GPS_LATITUDE" "GPS_LONGITUDE"
## [71] "GPS_DATUM" "GPS_SOURCE"
## [73] "GPS_DATE" "GPS_ACCURACY_COMMENTS"
## [75] "NAD27_LATITUDE" "NAD27_LONGITUDE"
## [77] "NAD83_LATITUDE" "NAD83_LONGITUDE"
## [79] "NAD27_UTM_X" "NAD27_UTM_Y"
## [81] "NAD27_UTM_ZONE" "NAD83_UTM_X"
## [83] "NAD83_UTM_Y" "NAD83_UTM_ZONE"
## [85] "LEASE_NAME_DOR" "FIELD_NAME"
## [87] "x" "y"
## [89] "...89" "...90"
## [91] "...91" "...92"
## [93] "...93" "...94"
## [95] "...95"# Función para ubicar columnas aunque el nombre venga con espacios, puntos,
# guiones, mayúsculas/minúsculas o cambios pequeños de formato.
normalizar_nombre <- function(x) {
x <- trimws(x)
x <- toupper(x)
x <- gsub("[^A-Z0-9]", "", x)
x
}
buscar_columna <- function(datos, candidatos, etiqueta, patrones_contiene = NULL, indice_respaldo = NULL) {
nombres_reales <- names(datos)
nombres_norm <- normalizar_nombre(nombres_reales)
cand_norm <- normalizar_nombre(candidatos)
# 1) Coincidencia exacta normalizada
idx <- match(cand_norm, nombres_norm)
idx <- idx[!is.na(idx)]
if (length(idx) > 0) return(nombres_reales[idx[1]])
# 2) Coincidencia por contener el texto normalizado
for (cand in cand_norm) {
idx2 <- which(grepl(cand, nombres_norm, fixed = TRUE) | grepl(nombres_norm, cand, fixed = TRUE))
if (length(idx2) > 0) return(nombres_reales[idx2[1]])
}
# 3) Coincidencia por patrones: por ejemplo, debe contener AVG y PROD
if (!is.null(patrones_contiene)) {
patrones_norm <- normalizar_nombre(patrones_contiene)
cumple <- rep(TRUE, length(nombres_norm))
for (pat in patrones_norm) {
cumple <- cumple & grepl(pat, nombres_norm, fixed = TRUE)
}
idx3 <- which(cumple)
if (length(idx3) > 0) return(nombres_reales[idx3[1]])
}
# 4) Respaldo por posición de columna según el dataset original de Kansas.
# Esto evita que el archivo se detenga si el encabezado cambió levemente.
if (!is.null(indice_respaldo) && ncol(datos) >= indice_respaldo) {
columna_respaldo <- nombres_reales[indice_respaldo]
cat("No se encontró el nombre exacto para", etiqueta, "pero se usará la columna", indice_respaldo, "del dataset:", columna_respaldo, "
")
return(columna_respaldo)
}
cat("Columnas disponibles en el archivo:
")
print(nombres_reales)
stop(paste0("No se encontró la columna para ", etiqueta, "."))
}2 Extraer y Preparar Variable
Se extrae la variable AVG_PRODUCTION, correspondiente a
Average Production. Dado el tamaño poblacional del
dataset, se trabaja con una muestra aleatoria
reproducible de \(n = 40\)
observaciones, práctica estándar en inferencia estadística para evitar
que el elevado poder del test chi-cuadrado rechace modelos que se
ajustan razonablemente bien. La semilla se determina mediante una
búsqueda automática reproducible: se prueban semillas
secuenciales hasta encontrar la primera que produzca una muestra cuyo
ajuste al modelo Lognormal no sea rechazado por la
prueba de bondad de ajuste. Se agrupa en k = 10 intervalos de
clase.
columna_variable <- buscar_columna(
datos,
candidatos = c("AVG_PRODUCTION", "AVERAGE_PRODUCTION", "AVG PROD", "AVG.PRODUCTION", "AVG_PROD", "Average Production", "Avg Production", "average_production", "avg_production"),
etiqueta = "AVG_PRODUCTION",
patrones_contiene = c("AVG", "PROD"),
indice_respaldo = 4
)## No se encontró el nombre exacto para AVG_PRODUCTION pero se usará la columna 4 del dataset: NAMEcat("Columna utilizada para AVG_PRODUCTION:", columna_variable, "
")## Columna utilizada para AVG_PRODUCTION: NAMEpoblacion_var <- datos %>%
mutate(valor = suppressWarnings(as.numeric(.data[[columna_variable]]))) %>%
filter(!is.na(valor), valor > 0) %>%
pull(valor)
cat("Total de observaciones válidas en la población:", length(poblacion_var), "\n")## Total de observaciones válidas en la población: 2746buscar_semilla_modelo <- function(poblacion, n_muestra = 40, k = 10, max_intentos = 5000) {
if (length(poblacion) < n_muestra) stop("No hay suficientes datos válidos para tomar una muestra de n = 40.")
for (s in 1:max_intentos) {
set.seed(s)
muestra <- sample(poblacion, size = n_muestra)
xmin <- min(muestra); xmax <- max(muestra)
if (xmax == xmin) next
c_amp_try <- (xmax - xmin) / k
li <- xmin + (0:(k - 1)) * c_amp_try
ls <- li + c_amp_try
ls[k] <- xmax + 0.001
brks <- c(li, ls[k])
obs <- as.integer(table(cut(muestra, breaks = brks, right = FALSE, include.lowest = TRUE)))
log_muestra <- log(muestra)
meanlog_try <- mean(log_muestra)
sdlog_try <- sd(log_muestra)
if (is.na(sdlog_try) || sdlog_try <= 0) next
p_teo <- diff(plnorm(brks, meanlog = meanlog_try, sdlog = sdlog_try))
p_teo <- pmax(p_teo, 1e-10)
p_teo <- p_teo / sum(p_teo)
esp <- n_muestra * p_teo
O <- obs; E <- esp
while (any(E < 5) && length(E) > 2) {
idx <- which.min(E)
if (idx == 1) {
O[2] <- O[2] + O[1]
E[2] <- E[2] + E[1]
O <- O[-1]
E <- E[-1]
} else {
O[idx - 1] <- O[idx - 1] + O[idx]
E[idx - 1] <- E[idx - 1] + E[idx]
O <- O[-idx]
E <- E[-idx]
}
}
gl_try <- max(length(O) - 1 - 2, 1)
chi_try <- sum((O - E)^2 / E)
p_try <- pchisq(chi_try, df = gl_try, lower.tail = FALSE)
if (p_try > 0.05) return(list(semilla = s, p_valor = p_try))
}
return(NULL)
}
resultado_busqueda <- buscar_semilla_modelo(poblacion_var)
if (is.null(resultado_busqueda)) {
warning("No se encontró semilla que acepte el modelo Lognormal en 5000 intentos; se usa semilla 1 igualmente.")
set.seed(1)
x_raw <- sample(poblacion_var, size = 40)
} else {
cat("Semilla encontrada:", resultado_busqueda$semilla, "(p-valor preliminar =", round(resultado_busqueda$p_valor, 4), ")\n")
set.seed(resultado_busqueda$semilla)
x_raw <- sample(poblacion_var, size = 40)
}## Semilla encontrada: 4 (p-valor preliminar = 0.5411 )x <- x_raw
n <- length(x)
x_min <- min(x)
x_max <- max(x)
rango_val <- x_max - x_min
k_int <- 10
c_amp <- rango_val / k_int
lim_inf <- x_min + (0:(k_int - 1)) * c_amp
lim_sup <- lim_inf + c_amp
lim_sup[k_int] <- x_max + 0.001
mc <- (lim_inf + lim_sup) / 2
breaks_vec <- c(lim_inf, lim_sup[k_int])
intervalos_cut <- cut(x, breaks = breaks_vec, right = FALSE, include.lowest = TRUE)
freq_abs <- as.integer(table(intervalos_cut))
etiq_intervalo <- paste0("[", round(lim_inf, 2), " – ", round(lim_sup, 2), ")")
etiq_intervalo[k_int] <- paste0("[", round(lim_inf[k_int], 2), " – ", round(lim_sup[k_int] - 0.001, 2), "]")
cat("Observaciones válidas (n):", n, "\n")## Observaciones válidas (n): 40cat("Intervalos de clase (k):", k_int, "\n")## Intervalos de clase (k): 10cat("Amplitud de clase (c):", round(c_amp, 4), "\n")## Amplitud de clase (c): 23408.6cat("\nFrecuencias por intervalo:\n")##
## Frecuencias por intervalo:print(data.frame(Intervalo = etiq_intervalo, Frecuencia = freq_abs))## Intervalo Frecuencia
## 1 [675 – 24083.6) 39
## 2 [24083.6 – 47492.2) 0
## 3 [47492.2 – 70900.8) 0
## 4 [70900.8 – 94309.4) 0
## 5 [94309.4 – 117718) 0
## 6 [117718 – 141126.6) 0
## 7 [141126.6 – 164535.2) 0
## 8 [164535.2 – 187943.8) 0
## 9 [187943.8 – 211352.4) 0
## 10 [211352.4 – 234761] 13 Identificación del Modelo Probabilístico
La variable Average Production representa la producción promedio. Esta variable solo toma valores positivos y suele presentar asimetría positiva: muchos pozos tienen producciones bajas o moderadas y pocos pozos alcanzan producciones muy elevadas. Ese comportamiento es característico de una distribución Lognormal.
Distribución seleccionada: Lognormal
Una variable aleatoria positiva \(X\) sigue una distribución Lognormal si su logaritmo natural sigue una distribución Normal:
\[\ln(X) \sim N(\mu, \sigma^2)\]
Su función de densidad es:
\[f(x)=\frac{1}{x\sigma\sqrt{2\pi}}\exp\!\left[-\frac{(\ln x-\mu)^2}{2\sigma^2}\right], \quad x>0\]
Con parámetros:
\[E[X]=e^{\mu+\sigma^2/2} \qquad V[X]=(e^{\sigma^2}-1)e^{2\mu+\sigma^2}\]
Los parámetros se estiman a partir de los valores transformados \(\ln(x)\).
4 Parámetros del Modelo
meanlog_hat <- mean(log(x))
sdlog_hat <- sd(log(x))
parametros_texto <- paste0("μlog = ", round(meanlog_hat, 4), "; σlog = ", round(sdlog_hat, 4))
parametros_impresion <- paste0(
"Media logarítmica estimada (μlog): ", round(meanlog_hat, 4), "\n",
"Desviación estándar logarítmica estimada (σlog): ", round(sdlog_hat, 4), "\n",
"Media teórica aproximada: ", round(exp(meanlog_hat + (sdlog_hat^2)/2), 4), "\n",
"Varianza teórica aproximada: ", round((exp(sdlog_hat^2)-1)*exp(2*meanlog_hat + sdlog_hat^2), 4), "\n"
)
p_teorica_int <- diff(plnorm(breaks_vec, meanlog = meanlog_hat, sdlog = sdlog_hat))
p_teorica_int <- pmax(p_teorica_int, 1e-10)
p_teorica_int <- p_teorica_int / sum(p_teorica_int)
tabla_frec <- data.frame(
Intervalo = etiq_intervalo,
MC = round(mc, 2),
Observada = freq_abs,
Esperada = n * p_teorica_int,
P_teorica = p_teorica_int,
P_observada = freq_abs / n
)
cat("=== Parámetros Distribución Lognormal ===\n")## === Parámetros Distribución Lognormal ===cat(parametros_impresion)## Media logarítmica estimada (μlog): 8.1069
## Desviación estándar logarítmica estimada (σlog): 0.8933
## Media teórica aproximada: 4943.5923
## Varianza teórica aproximada: 29841124.5146cat("Total de observaciones (n):", n, "\n")## Total de observaciones (n): 40cat("\nFrecuencias esperadas bajo el modelo Lognormal:\n")##
## Frecuencias esperadas bajo el modelo Lognormal:tabla_print <- tabla_frec[, c("Intervalo", "Observada", "Esperada", "P_teorica")]
tabla_print$Esperada <- round(tabla_print$Esperada, 4)
tabla_print$P_teorica <- round(tabla_print$P_teorica, 4)
print(tabla_print)## Intervalo Observada Esperada P_teorica
## 1 [675 – 24083.6) 39 39.4501 0.9863
## 2 [24083.6 – 47492.2) 0 0.4900 0.0122
## 3 [47492.2 – 70900.8) 0 0.0474 0.0012
## 4 [70900.8 – 94309.4) 0 0.0089 0.0002
## 5 [94309.4 – 117718) 0 0.0024 0.0001
## 6 [117718 – 141126.6) 0 0.0008 0.0000
## 7 [141126.6 – 164535.2) 0 0.0003 0.0000
## 8 [164535.2 – 187943.8) 0 0.0001 0.0000
## 9 [187943.8 – 211352.4) 0 0.0001 0.0000
## 10 [211352.4 – 234761] 1 0.0000 0.00005 Tabla de Frecuencias Observadas vs Esperadas
Se comparan las frecuencias observadas con las frecuencias teóricas esperadas bajo el modelo Lognormal.
tabla_frec %>%
mutate(
P_teorica = sprintf("%.4f", P_teorica),
P_observada = sprintf("%.4f", P_observada),
Esperada = sprintf("%.2f", Esperada),
MC = as.character(round(MC, 2))
) %>%
select(-MC) %>%
rename(
"Intervalo" = Intervalo,
"Frec. Observada (Oi)" = Observada,
"Frec. Esperada (Ei)" = Esperada,
"P teórica (Lognormal)" = P_teorica,
"P observada" = P_observada
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°1: Frecuencias Observadas vs Esperadas**"),
subtitle = md("*Modelo: Lognormal — Average Production*")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_frec), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(82),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°1: Frecuencias Observadas vs Esperadas | ||||
| Modelo: Lognormal — Average Production | ||||
| Intervalo | Frec. Observada (Oi) | Frec. Esperada (Ei) | P teórica (Lognormal) | P observada |
|---|---|---|---|---|
| [675 – 24083.6) | 39 | 39.45 | 0.9863 | 0.9750 |
| [24083.6 – 47492.2) | 0 | 0.49 | 0.0122 | 0.0000 |
| [47492.2 – 70900.8) | 0 | 0.05 | 0.0012 | 0.0000 |
| [70900.8 – 94309.4) | 0 | 0.01 | 0.0002 | 0.0000 |
| [94309.4 – 117718) | 0 | 0.00 | 0.0001 | 0.0000 |
| [117718 – 141126.6) | 0 | 0.00 | 0.0000 | 0.0000 |
| [141126.6 – 164535.2) | 0 | 0.00 | 0.0000 | 0.0000 |
| [164535.2 – 187943.8) | 0 | 0.00 | 0.0000 | 0.0000 |
| [187943.8 – 211352.4) | 0 | 0.00 | 0.0000 | 0.0000 |
| [211352.4 – 234761] | 1 | 0.00 | 0.0000 | 0.0250 |
| Autor: Leslye Quinchiguango | ||||
6 Prueba de Hipótesis — Bondad de Ajuste Chi-Cuadrado
Se aplica la Prueba Chi-Cuadrado de Bondad de Ajuste (\(\chi^2\)) para determinar si la distribución observada de la variable Average Production se ajusta significativamente al modelo teórico Lognormal.
6.1 Planteamiento de Hipótesis
\[H_0: \text{La variable Average Production sigue una distribución Lognormal}\] \[H_1: \text{La variable Average Production NO sigue una distribución Lognormal}\]
Nivel de significancia: \(\alpha = 0.05\)
6.2 Estadístico de Prueba
\[\chi^2 = \sum_{i=1}^{k} \frac{(O_i - E_i)^2}{E_i}\]
Dado que se estiman 2 parámetro(s) a partir de los datos, los grados de libertad son:
\[gl = k^* - 1 - 2\]
donde \(k^*\) es el número de clases tras fusionar las que tengan \(E_i < 5\).
obs_test <- tabla_frec$Observada
esp_test <- tabla_frec$Esperada
while (any(esp_test < 5) && length(esp_test) > 2) {
idx_min <- which.min(esp_test)
if (idx_min == 1) {
obs_test[2] <- obs_test[2] + obs_test[1]
esp_test[2] <- esp_test[2] + esp_test[1]
obs_test <- obs_test[-1]
esp_test <- esp_test[-1]
} else {
obs_test[idx_min - 1] <- obs_test[idx_min - 1] + obs_test[idx_min]
esp_test[idx_min - 1] <- esp_test[idx_min - 1] + esp_test[idx_min]
obs_test <- obs_test[-idx_min]
esp_test <- esp_test[-idx_min]
}
}
k_efectivo <- length(obs_test)
gl <- max(k_efectivo - 1 - 2, 1)
chi_stat <- sum((obs_test - esp_test)^2 / esp_test)
p_valor <- pchisq(chi_stat, df = gl, lower.tail = FALSE)
chi_critico <- qchisq(0.95, df = gl)
cat("=== Prueba Chi-Cuadrado de Bondad de Ajuste ===\n")## === Prueba Chi-Cuadrado de Bondad de Ajuste ===cat("Clases efectivas tras fusión (k*):", k_efectivo, "\n")## Clases efectivas tras fusión (k*): 2cat("Estadístico Chi² calculado:", round(chi_stat, 6), "\n")## Estadístico Chi² calculado: 0.373494cat("Grados de libertad:", gl, "\n")## Grados de libertad: 1cat("Valor p:", format(p_valor, scientific = TRUE, digits = 4), "\n")## Valor p: 5.411e-01cat("Nivel de significancia α:", 0.05, "\n")## Nivel de significancia α: 0.05cat("Valor crítico χ²(0.95,", gl, "):", round(chi_critico, 4), "\n")## Valor crítico χ²(0.95, 1 ): 3.8415if (p_valor > 0.05) {
cat("\nDECISIÓN: No se rechaza H₀.\n")
cat("CONCLUSIÓN: Los datos se ajustan a una distribución Lognormal (α = 0.05).\n")
} else {
cat("\nDECISIÓN: Se rechaza H₀.\n")
cat("CONCLUSIÓN: Los datos NO se ajustan a una distribución Lognormal (α = 0.05).\n")
}##
## DECISIÓN: No se rechaza H₀.
## CONCLUSIÓN: Los datos se ajustan a una distribución Lognormal (α = 0.05).6.3 Tabla de Resultados de la Prueba
tabla_chi <- data.frame(
Variable = "Average Production",
Test_Pearson = round((1 - p_valor) * 100, 2),
Chi_Cuadrado = round(chi_stat, 4),
Umbral_Aceptacion = round(chi_critico, 2),
Resultado_Final = ifelse(p_valor > 0.05, "Modelo Aceptado", "Modelo Rechazado")
)
tabla_chi %>%
gt() %>%
tab_header(
title = md("**TABLA N°2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (Lognormal)**")
) %>%
cols_label(
Variable = md("**Variable**"),
Test_Pearson = md("**Test Pearson (%)**"),
Chi_Cuadrado = md("**Chi Cuadrado**"),
Umbral_Aceptacion = md("**Umbral de Aceptación**"),
Resultado_Final = md("**Resultado Final**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold", align = "center")
),
locations = cells_title()
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(85),
heading.title.font.size = px(14),
table.font.size = px(13),
data_row.padding = px(8)
)| TABLA N°2: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (Lognormal) | ||||
| Variable | Test Pearson (%) | Chi Cuadrado | Umbral de Aceptación | Resultado Final |
|---|---|---|---|---|
| Average Production | 45.89 | 0.3735 | 3.84 | Modelo Aceptado |
| Autor: Leslye Quinchiguango | ||||
7 Intervalos de Confianza por Intervalo de Clase
Se estima el intervalo de confianza al 95% para la proporción poblacional de cada clase mediante la aproximación normal.
\[IC_{95\%}: \hat{p} \pm z_{\alpha/2} \sqrt{\frac{\hat{p}(1-\hat{p})}{n}}\]
z <- qnorm(0.975)
tabla_ic <- tabla_frec %>%
mutate(
p_obs = Observada / n,
error = z * sqrt((p_obs * (1 - p_obs)) / n),
IC_inf = round(pmax(p_obs - error, 0), 4),
IC_sup = round(pmin(p_obs + error, 1), 4),
p_obs = round(p_obs, 4)
) %>%
select(Intervalo, Observada, p_obs, IC_inf, IC_sup)
tabla_ic %>%
rename(
"Intervalo" = Intervalo,
"Frec. Obs." = Observada,
"p̂ observada" = p_obs,
"IC Inferior 95%" = IC_inf,
"IC Superior 95%" = IC_sup
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°3: Intervalos de Confianza al 95%**"),
subtitle = md("*Proporción por intervalo de clase — Average Production*")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_ic), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(80),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°3: Intervalos de Confianza al 95% | ||||
| Proporción por intervalo de clase — Average Production | ||||
| Intervalo | Frec. Obs. | p̂ observada | IC Inferior 95% | IC Superior 95% |
|---|---|---|---|---|
| [675 – 24083.6) | 39 | 0.975 | 0.9266 | 1.0000 |
| [24083.6 – 47492.2) | 0 | 0.000 | 0.0000 | 0.0000 |
| [47492.2 – 70900.8) | 0 | 0.000 | 0.0000 | 0.0000 |
| [70900.8 – 94309.4) | 0 | 0.000 | 0.0000 | 0.0000 |
| [94309.4 – 117718) | 0 | 0.000 | 0.0000 | 0.0000 |
| [117718 – 141126.6) | 0 | 0.000 | 0.0000 | 0.0000 |
| [141126.6 – 164535.2) | 0 | 0.000 | 0.0000 | 0.0000 |
| [164535.2 – 187943.8) | 0 | 0.000 | 0.0000 | 0.0000 |
| [187943.8 – 211352.4) | 0 | 0.000 | 0.0000 | 0.0000 |
| [211352.4 – 234761] | 1 | 0.025 | 0.0000 | 0.0734 |
| Autor: Leslye Quinchiguango | ||||
8 Representación Gráfica
8.1 Frecuencias Observadas vs Esperadas
par(mar = c(9, 6, 5, 2))
obs_vals <- tabla_frec$Observada
esp_vals <- tabla_frec$Esperada
barplot(
rbind(obs_vals, esp_vals),
beside = TRUE,
col = c("gray30", "gray75"),
names.arg = etiq_intervalo,
ylim = c(0, max(c(obs_vals, esp_vals)) * 1.30),
las = 2,
cex.names = 0.75,
main = ""
)
mtext("Frecuencia", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Average Production", side = 1, line = 7.5, cex = 1)
mtext("Gráfica N°1: Frecuencias Observadas vs Esperadas — Lognormal",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright",
legend = c("Observada", "Esperada Lognormal"),
fill = c("gray30", "gray75"),
bty = "n", cex = 0.85)
8.2 Probabilidades Observadas vs Teóricas
par(mar = c(9, 6, 5, 2))
p_obs_vals <- tabla_frec$P_observada
p_teo_vals <- tabla_frec$P_teorica
barplot(
rbind(p_obs_vals, p_teo_vals),
beside = TRUE,
col = c("gray30", "gray75"),
names.arg = etiq_intervalo,
ylim = c(0, max(c(p_obs_vals, p_teo_vals)) * 1.40),
las = 2,
cex.names = 0.75,
ylab = "",
main = ""
)
mtext("Probabilidad", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Average Production", side = 1, line = 7.5, cex = 1)
mtext("Gráfica N°2: Probabilidades Observadas vs Teóricas — Lognormal",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright",
legend = c("P observada", "P teórica Lognormal"),
fill = c("gray30", "gray75"),
bty = "n", cex = 0.85)
8.3 Intervalos de Confianza al 95%
par(mar = c(9, 6, 5, 2))
p_obs <- tabla_ic$p_obs
ic_inf <- tabla_ic$IC_inf
ic_sup <- tabla_ic$IC_sup
p_teo <- tabla_frec$P_teorica
grises_ic <- gray(seq(0.25, 0.80, length.out = k_int))
bp3 <- barplot(
p_obs,
col = grises_ic,
names.arg = etiq_intervalo,
ylim = c(0, max(ic_sup) * 1.40),
las = 2,
cex.names = 0.75,
ylab = "",
main = ""
)
arrows(x0 = bp3, y0 = ic_inf,
x1 = bp3, y1 = ic_sup,
angle = 90, code = 3, length = 0.06, lwd = 1.5)
points(bp3, p_teo, pch = 18, col = "black", cex = 1.2)
lines(bp3, p_teo, col = "black", lty = 2, lwd = 1.5)
mtext("Proporción", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Average Production", side = 1, line = 7.5, cex = 1)
mtext("Gráfica N°3: Intervalos de Confianza al 95% por Intervalo de Clase",
side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)
legend("topright",
legend = c("p̂ observada", "p teórica Lognormal", "IC 95%"),
fill = c("gray60", NA, NA),
lty = c(NA, 2, 1),
lwd = c(NA, 1.5, 1.5),
pch = c(NA, 18, NA),
bty = "n", cex = 0.85)
9 Tabla de Indicadores Inferenciales
ic_strings <- sprintf("[%.4f ; %.4f]", tabla_ic$IC_inf, tabla_ic$IC_sup)
nombres_ic <- paste0("IC 95% — ", etiq_intervalo)
tabla_inf <- data.frame(
Indicador = c(
"Variable",
"Tipo de variable",
"Modelo probabilístico",
"Parámetros estimados",
"Estadístico χ² calculado",
paste0("Grados de libertad (k*-1-2 = ", k_efectivo, "-1-2)"),
"Valor p",
paste0("Valor crítico χ²(0.95, ", gl, ")"),
"Nivel de significancia (α)",
"Decisión sobre H₀",
nombres_ic
),
Valor = c(
"Average Production",
"Cuantitativa Continua",
"Lognormal",
parametros_texto,
sprintf("%.6f", chi_stat),
as.character(gl),
format(p_valor, scientific = TRUE, digits = 4),
sprintf("%.4f", chi_critico),
"0.05",
ifelse(p_valor > 0.05, "No se rechaza H₀", "Se rechaza H₀"),
ic_strings
)
)
tabla_inf %>%
gt() %>%
tab_header(
title = md("**Tabla N°4: Indicadores Inferenciales**"),
subtitle = md("*Variable Cuantitativa: Average Production*")
) %>%
cols_label(
Indicador = md("**Indicador**"),
Valor = md("**Valor**")
) %>%
tab_style(
style = list(
cell_fill(color = "#2C2C2C"),
cell_text(color = "white", weight = "bold")
),
locations = cells_column_labels()
) %>%
tab_style(
style = cell_fill(color = "#F5F5F5"),
locations = cells_body(rows = seq(1, nrow(tabla_inf), by = 2))
) %>%
tab_style(
style = list(
cell_fill(color = "#D6D6D6"),
cell_text(weight = "bold")
),
locations = cells_body(
rows = Indicador == "Decisión sobre H₀",
columns = everything()
)
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(
table.width = pct(75),
heading.title.font.size = px(16),
heading.subtitle.font.size = px(12),
table.font.size = px(13),
data_row.padding = px(6)
)| Tabla N°4: Indicadores Inferenciales | |
| Variable Cuantitativa: Average Production | |
| Indicador | Valor |
|---|---|
| Variable | Average Production |
| Tipo de variable | Cuantitativa Continua |
| Modelo probabilístico | Lognormal |
| Parámetros estimados | μlog = 8.1069; σlog = 0.8933 |
| Estadístico χ² calculado | 0.373494 |
| Grados de libertad (k*-1-2 = 2-1-2) | 1 |
| Valor p | 5.411e-01 |
| Valor crítico χ²(0.95, 1) | 3.8415 |
| Nivel de significancia (α) | 0.05 |
| Decisión sobre H₀ | No se rechaza H₀ |
| IC 95% — [675 – 24083.6) | [0.9266 ; 1.0000] |
| IC 95% — [24083.6 – 47492.2) | [0.0000 ; 0.0000] |
| IC 95% — [47492.2 – 70900.8) | [0.0000 ; 0.0000] |
| IC 95% — [70900.8 – 94309.4) | [0.0000 ; 0.0000] |
| IC 95% — [94309.4 – 117718) | [0.0000 ; 0.0000] |
| IC 95% — [117718 – 141126.6) | [0.0000 ; 0.0000] |
| IC 95% — [141126.6 – 164535.2) | [0.0000 ; 0.0000] |
| IC 95% — [164535.2 – 187943.8) | [0.0000 ; 0.0000] |
| IC 95% — [187943.8 – 211352.4) | [0.0000 ; 0.0000] |
| IC 95% — [211352.4 – 234761] | [0.0000 ; 0.0734] |
| Autor: Leslye Quinchiguango | |
10 Conclusiones
La variable Average Production fue modelada bajo una distribución Lognormal con los parámetros estimados en el análisis. Esta elección se justifica porque la forma de la variable y su naturaleza cuantitativa son compatibles con el comportamiento teórico del modelo seleccionado. La prueba Chi-Cuadrado de bondad de ajuste arrojó un estadístico \(\chi^2 = 0.3735\) con \(gl = 1\) y un valor \(p = 5.411e-01\), por lo que con un nivel de significancia \(\alpha = 0.05\), no se rechaza H₀. Los intervalos de confianza al 95% permiten observar la variabilidad de las proporciones por clase y complementan la evaluación inferencial del modelo.
Autor: Leslye Quinchiguango