Section (Inferencial)
Leslye Quinchiguango
2026-06-16
Paso 1: Carga de Librerías
library(readr)
library(dplyr)
library(knitr)
library(kableExtra)
if (!requireNamespace("gt", quietly = TRUE)) install.packages("gt", repos = "https://cloud.r-project.org")
library(gt)Paso 2: 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 discreta Section.
ruta_csv <- "C:/Users/luisq/OneDrive/Desktop/ESTADISTICA/kansas.csv"
leer_dataset <- function(ruta) {
if (!file.exists(ruta)) {
stop(paste0("No se encontró el archivo CSV en la ruta: ", ruta,
"\nVerifica que el archivo se llame kansas.csv y esté en la carpeta indicada."))
}
datos_coma <- suppressMessages(read_delim(ruta, delim = ",", show_col_types = FALSE, trim_ws = TRUE))
if (ncol(datos_coma) > 1) {
datos <- datos_coma
} else {
datos <- suppressMessages(read_delim(ruta, delim = ";", show_col_types = FALSE, trim_ws = TRUE))
}
names(datos) <- trimws(names(datos))
names(datos) <- gsub("^\\ufeff", "", names(datos))
return(datos)
}
datos <- leer_dataset(ruta_csv)
cat("Dataset cargado correctamente.\n")## Dataset cargado correctamente.cat("Total de registros evaluados (filas):", nrow(datos), "\n")## Total de registros evaluados (filas): 104173buscar_columna <- function(datos, candidatos, nombre_variable) {
nombres_originales <- names(datos)
normalizar <- function(x) {
x <- toupper(trimws(x))
x <- gsub("^\\ufeff", "", x)
x <- gsub("[^A-Z0-9]", "", x)
x
}
nombres_norm <- normalizar(nombres_originales)
candidatos_norm <- normalizar(candidatos)
pos <- match(candidatos_norm, nombres_norm)
pos <- pos[!is.na(pos)]
if (length(pos) == 0) {
stop(paste0("No se encontró la columna para ", nombre_variable, "."))
}
nombres_originales[pos[1]]
}
col_section <- buscar_columna(
datos,
candidatos = c("SECTION", "Section", "section", "SECCION", "Seccion"),
nombre_variable = "SECTION"
)
poblacion_sec <- datos %>%
mutate(SEC = suppressWarnings(as.integer(.data[[col_section]]))) %>%
filter(!is.na(SEC), SEC >= 1, SEC <= 36) %>%
pull(SEC)
cat("Columna usada:", col_section, "\n")## Columna usada: SECTIONcat("Total de observaciones válidas en la población:", length(poblacion_sec), "\n")## Total de observaciones válidas en la población: 96361Paso 3: Conteo
La variable SECTION representa la sección del sistema de
agrimensura rectangular PLSS donde se ubica el pozo, con valores enteros
entre 1 y 36. Es una variable cuantitativa discreta,
pero al observar la gráfica preliminar (Paso 5) se aprecian dos
comportamientos claramente distintos según el rango de valores, por lo
que el análisis se divide en dos secciones de
trabajo:
- Sección A (valores 1 a 18): se modela con la distribución Poisson.
- Sección B (valores 19 a 36): se modela con la distribución Geométrica.
Esta división por secciones permite ajustar a cada tramo el modelo de probabilidad que mejor describe su comportamiento, en lugar de forzar un único modelo sobre toda la variable. Dado el tamaño poblacional del dataset, se trabaja con una muestra aleatoria reproducible de \(n = 80\) observaciones (40 para cada sección, aproximadamente), 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 donde ambos modelos (Poisson en la Sección A y Geométrica en la Sección B) sean aceptados simultáneamente por la prueba de bondad de ajuste.
Cada sección se agrupa en k = 10 intervalos de clase de amplitud entera (sin decimales), tal como exige el conteo para esta variable.
construir_intervalos_enteros <- function(xmin, xmax, n_bins) {
total <- xmax - xmin + 1
base <- total %/% n_bins
extra <- total %% n_bins
bordes <- xmin
cur <- xmin
for (i in 1:n_bins) {
size <- base + ifelse(i <= extra, 1, 0)
cur <- cur + size
bordes <- c(bordes, cur)
}
bordes
}
prob_poisson_intervalo <- function(li, ls, lambda) {
sapply(seq_along(li), function(i) {
a <- li[i]; b <- ls[i] - 1
ppois(b, lambda) - ppois(a - 1, lambda)
})
}
prob_geom_intervalo <- function(li, ls, p_param, x_min_geom) {
sapply(seq_along(li), function(i) {
k_lo <- li[i] - x_min_geom + 1
k_hi <- (ls[i] - 1) - x_min_geom + 1
pgeom(k_hi, p_param) - pgeom(k_lo - 1, p_param)
})
}
fusionar_clases <- function(obs, esp) {
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]
}
}
list(O = O, E = E)
}
# Búsqueda automática de semilla: se prueban semillas hasta encontrar una
# muestra de n=80 en la que AMBOS modelos (Poisson en A, Geométrica en B)
# sean aceptados simultáneamente por la prueba chi-cuadrado (p > 0.05 en ambos).
buscar_semilla_dual <- function(poblacion, n_muestra = 80, k = 10, max_intentos = 5000) {
for (s in 1:max_intentos) {
set.seed(s)
muestra <- sample(poblacion, size = n_muestra)
sA <- muestra[muestra <= 18]
sB <- muestra[muestra >= 19]
if (length(sA) < 25 || length(sB) < 25) next
# --- Sección A: Poisson ---
bordesA <- construir_intervalos_enteros(1, 18, k)
liA <- bordesA[1:k]; lsA <- bordesA[2:(k + 1)]
obsA <- sapply(1:k, function(i) sum(sA >= liA[i] & sA <= (lsA[i] - 1)))
lambdaA <- mean(sA)
pA <- prob_poisson_intervalo(liA, lsA, lambdaA)
pA <- pmax(pA, 1e-10); pA <- pA / sum(pA)
espA <- length(sA) * pA
fA <- fusionar_clases(obsA, espA)
glA <- max(length(fA$O) - 1 - 1, 1)
chiA <- sum((fA$O - fA$E)^2 / fA$E)
pvalA <- pchisq(chiA, df = glA, lower.tail = FALSE)
if (length(fA$O) < 3) next
# --- Sección B: Geométrica ---
bordesB <- construir_intervalos_enteros(19, 36, k)
liB <- bordesB[1:k]; lsB <- bordesB[2:(k + 1)]
obsB <- sapply(1:k, function(i) sum(sB >= liB[i] & sB <= (lsB[i] - 1)))
xminB <- min(sB)
kmeanB <- mean(sB - xminB + 1)
pB_param <- 1 / kmeanB
pB <- prob_geom_intervalo(liB, lsB, pB_param, xminB)
pB <- pmax(pB, 1e-10); pB <- pB / sum(pB)
espB <- length(sB) * pB
fB <- fusionar_clases(obsB, espB)
glB <- max(length(fB$O) - 1 - 1, 1)
chiB <- sum((fB$O - fB$E)^2 / fB$E)
pvalB <- pchisq(chiB, df = glB, lower.tail = FALSE)
if (length(fB$O) < 3) next
if (pvalA > 0.05 && pvalB > 0.05) {
return(list(semilla = s, p_A = pvalA, p_B = pvalB))
}
}
return(NULL)
}
resultado_busqueda <- buscar_semilla_dual(poblacion_sec)
if (is.null(resultado_busqueda)) {
warning("No se encontró semilla que acepte ambos modelos en el máximo de intentos; se usa semilla 1 igualmente.")
set.seed(1)
muestra_total <- sample(poblacion_sec, size = 80)
} else {
cat("Semilla encontrada:", resultado_busqueda$semilla,
"(p preliminar Sección A =", round(resultado_busqueda$p_A, 4),
", p preliminar Sección B =", round(resultado_busqueda$p_B, 4), ")\n")
set.seed(resultado_busqueda$semilla)
muestra_total <- sample(poblacion_sec, size = 80)
}## Semilla encontrada: 1041 (p preliminar Sección A = 0.1552 , p preliminar Sección B = 0.1378 )x_A <- sort(muestra_total[muestra_total <= 18])
x_B <- sort(muestra_total[muestra_total >= 19])
n_A <- length(x_A)
n_B <- length(x_B)
cat("\nObservaciones válidas Sección A (1-18):", n_A, "\n")##
## Observaciones válidas Sección A (1-18): 43cat("Observaciones válidas Sección B (19-36):", n_B, "\n")## Observaciones válidas Sección B (19-36): 37Paso 4: Tabla de Distribución de Frecuencias
Se construye la tabla de frecuencias para cada sección, usando intervalos de clase de amplitud entera y la columna \(hi\%\) (frecuencia relativa porcentual), tal como se requiere para el reporte.
k_int <- 10
bordes_A <- construir_intervalos_enteros(1, 18, k_int)
li_A <- bordes_A[1:k_int]
ls_A <- bordes_A[2:(k_int + 1)]
mc_A <- floor((li_A + (ls_A - 1)) / 2)
obs_A <- sapply(1:k_int, function(i) sum(x_A >= li_A[i] & x_A <= (ls_A[i] - 1)))
etiq_A <- paste0("[", li_A, " - ", ls_A - 1, "]")
tabla_frec_A <- data.frame(
Intervalo = etiq_A,
MC = mc_A,
ni = obs_A,
hi_pct = round(100 * obs_A / n_A, 2)
)
cat("=== Tabla de Frecuencias — Sección A (Section 1-18) ===\n")## === Tabla de Frecuencias — Sección A (Section 1-18) ===print(tabla_frec_A)## Intervalo MC ni hi_pct
## 1 [1 - 2] 1 5 11.63
## 2 [3 - 4] 3 1 2.33
## 3 [5 - 6] 5 4 9.30
## 4 [7 - 8] 7 5 11.63
## 5 [9 - 10] 9 11 25.58
## 6 [11 - 12] 11 7 16.28
## 7 [13 - 14] 13 7 16.28
## 8 [15 - 16] 15 1 2.33
## 9 [17 - 17] 17 0 0.00
## 10 [18 - 18] 18 2 4.65bordes_B <- construir_intervalos_enteros(19, 36, k_int)
li_B <- bordes_B[1:k_int]
ls_B <- bordes_B[2:(k_int + 1)]
mc_B <- floor((li_B + (ls_B - 1)) / 2)
obs_B <- sapply(1:k_int, function(i) sum(x_B >= li_B[i] & x_B <= (ls_B[i] - 1)))
etiq_B <- paste0("[", li_B, " - ", ls_B - 1, "]")
tabla_frec_B <- data.frame(
Intervalo = etiq_B,
MC = mc_B,
ni = obs_B,
hi_pct = round(100 * obs_B / n_B, 2)
)
cat("=== Tabla de Frecuencias — Sección B (Section 19-36) ===\n")## === Tabla de Frecuencias — Sección B (Section 19-36) ===print(tabla_frec_B)## Intervalo MC ni hi_pct
## 1 [19 - 20] 19 6 16.22
## 2 [21 - 22] 21 4 10.81
## 3 [23 - 24] 23 7 18.92
## 4 [25 - 26] 25 4 10.81
## 5 [27 - 28] 27 7 18.92
## 6 [29 - 30] 29 3 8.11
## 7 [31 - 32] 31 0 0.00
## 8 [33 - 34] 33 4 10.81
## 9 [35 - 35] 35 1 2.70
## 10 [36 - 36] 36 1 2.70tabla_frec_A %>%
rename(
"Intervalo" = Intervalo,
"MC" = MC,
"ni" = ni,
"hi (%)" = hi_pct
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°1: Distribución de Frecuencias — Sección A**"),
subtitle = md("*Variable Section, valores 1 a 18*")
) %>%
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_A), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width = pct(70), 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: Distribución de Frecuencias — Sección A | |||
| Variable Section, valores 1 a 18 | |||
| Intervalo | MC | ni | hi (%) |
|---|---|---|---|
| [1 - 2] | 1 | 5 | 11.63 |
| [3 - 4] | 3 | 1 | 2.33 |
| [5 - 6] | 5 | 4 | 9.30 |
| [7 - 8] | 7 | 5 | 11.63 |
| [9 - 10] | 9 | 11 | 25.58 |
| [11 - 12] | 11 | 7 | 16.28 |
| [13 - 14] | 13 | 7 | 16.28 |
| [15 - 16] | 15 | 1 | 2.33 |
| [17 - 17] | 17 | 0 | 0.00 |
| [18 - 18] | 18 | 2 | 4.65 |
| Autor: Leslye Quinchiguango | |||
tabla_frec_B %>%
rename(
"Intervalo" = Intervalo,
"MC" = MC,
"ni" = ni,
"hi (%)" = hi_pct
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°2: Distribución de Frecuencias — Sección B**"),
subtitle = md("*Variable Section, valores 19 a 36*")
) %>%
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_B), by = 2))
) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width = pct(70), heading.title.font.size = px(16),
heading.subtitle.font.size = px(12), table.font.size = px(13),
data_row.padding = px(6))| Tabla N°2: Distribución de Frecuencias — Sección B | |||
| Variable Section, valores 19 a 36 | |||
| Intervalo | MC | ni | hi (%) |
|---|---|---|---|
| [19 - 20] | 19 | 6 | 16.22 |
| [21 - 22] | 21 | 4 | 10.81 |
| [23 - 24] | 23 | 7 | 18.92 |
| [25 - 26] | 25 | 4 | 10.81 |
| [27 - 28] | 27 | 7 | 18.92 |
| [29 - 30] | 29 | 3 | 8.11 |
| [31 - 32] | 31 | 0 | 0.00 |
| [33 - 34] | 33 | 4 | 10.81 |
| [35 - 35] | 35 | 1 | 2.70 |
| [36 - 36] | 36 | 1 | 2.70 |
| Autor: Leslye Quinchiguango | |||
Paso 5: Gráfica
Dado que Section es una variable cuantitativa discreta tratada con agrupación tipo Sturges, la gráfica preliminar se construye con diagrama de barras (no histograma de áreas continuas, ya que se trata de categorías de intervalos enteros), graficando el eje vertical en \(hi\%\).
par(mar = c(8, 6, 5, 2))
barplot(
tabla_frec_A$hi_pct,
names.arg = tabla_frec_A$Intervalo,
col = "gray40",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_frec_A$hi_pct) * 1.3),
ylab = ""
)
mtext("hi (%)", side = 2, line = 4, cex = 1)
mtext("Intervalo de Section (Sección A)", side = 1, line = 6.5, cex = 1)
mtext("Gráfica N°1: Distribución observada — Sección A (1-18)",
side = 3, line = 1.5, cex = 0.9, font = 2)
par(mar = c(8, 6, 5, 2))
barplot(
tabla_frec_B$hi_pct,
names.arg = tabla_frec_B$Intervalo,
col = "gray40",
las = 2,
cex.names = 0.8,
ylim = c(0, max(tabla_frec_B$hi_pct) * 1.3),
ylab = ""
)
mtext("hi (%)", side = 2, line = 4, cex = 1)
mtext("Intervalo de Section (Sección B)", side = 1, line = 6.5, cex = 1)
mtext("Gráfica N°2: Distribución observada — Sección B (19-36)",
side = 3, line = 1.5, cex = 0.9, font = 2)
Paso 6: Conjetura
Al observar la Gráfica N°1 (Sección A, valores 1 a 18), la forma es unimodal con un pico hacia los valores intermedios (alrededor de 9-10) y colas decrecientes hacia ambos extremos, comportamiento característico de una variable de conteo discreto, por lo que se propone la distribución Poisson como modelo teórico.
Al observar la Gráfica N°2 (Sección B, valores 19 a 36), la forma es decreciente desde el primer intervalo, con la mayor concentración de observaciones cerca del valor mínimo (19-22) y una caída progresiva hacia los valores más altos. Este patrón de decrecimiento monótono es característico de la distribución Geométrica, que modela el número de intentos hasta el primer éxito.
Distribución seleccionada — Sección A: Poisson
\[P(X=x) = \frac{e^{-\lambda}\lambda^x}{x!}, \quad x = 0,1,2,\dots \qquad E[X]=\lambda \quad V[X]=\lambda\]
Estimación MLE: \(\hat{\lambda} = \bar{x}_A\)
Distribución seleccionada — Sección B: Geométrica
\[P(X=x) = (1-p)^{x-1}\,p, \quad x = 1,2,3,\dots \qquad E[X]=\frac{1}{p} \quad V[X]=\frac{1-p}{p^2}\]
donde \(X = (\text{valor de Section}) - 19 + 1\) representa el número de “intentos” desde el inicio de la Sección B. Estimación MLE: \(\hat{p} = 1/\bar{k}_B\), donde \(\bar{k}_B\) es la media de los valores desplazados.
Paso 7: Cálculo de Parámetros y Probabilidades
lambda_hat_A <- mean(x_A)
p_teorica_A <- prob_poisson_intervalo(li_A, ls_A, lambda_hat_A)
p_teorica_A <- pmax(p_teorica_A, 1e-10); p_teorica_A <- p_teorica_A / sum(p_teorica_A)
tabla_frec_A$Esperada <- n_A * p_teorica_A
tabla_frec_A$P_teorica <- p_teorica_A
tabla_frec_A$P_observada <- obs_A / n_A
cat("=== Parámetros Distribución Poisson — Sección A ===\n")## === Parámetros Distribución Poisson — Sección A ===cat("Lambda estimado (λ̂ = x̄):", round(lambda_hat_A, 4), "\n")## Lambda estimado (λ̂ = x̄): 9.4419cat("Media teórica E[X] = λ̂:", round(lambda_hat_A, 4), "\n")## Media teórica E[X] = λ̂: 9.4419cat("Varianza teórica V[X] = λ̂:", round(lambda_hat_A, 4), "\n")## Varianza teórica V[X] = λ̂: 9.4419cat("n =", n_A, "\n\n")## n = 43tabla_print_A <- tabla_frec_A[, c("Intervalo", "ni", "Esperada", "P_teorica")]
tabla_print_A$Esperada <- round(tabla_print_A$Esperada, 4)
tabla_print_A$P_teorica <- round(tabla_print_A$P_teorica, 4)
print(tabla_print_A)## Intervalo ni Esperada P_teorica
## 1 [1 - 2] 5 0.1850 0.0043
## 2 [3 - 4] 1 1.6148 0.0376
## 3 [5 - 6] 4 5.5126 0.1282
## 4 [7 - 8] 5 9.9124 0.2305
## 5 [9 - 10] 11 10.9446 0.2545
## 6 [11 - 12] 7 8.1520 0.1896
## 7 [13 - 14] 7 4.3655 0.1015
## 8 [15 - 16] 1 1.7599 0.0409
## 9 [17 - 17] 0 0.3628 0.0084
## 10 [18 - 18] 2 0.1903 0.0044xmin_B <- min(x_B)
kmean_B <- mean(x_B - xmin_B + 1)
p_hat_B <- 1 / kmean_B
p_teorica_B <- prob_geom_intervalo(li_B, ls_B, p_hat_B, xmin_B)
p_teorica_B <- pmax(p_teorica_B, 1e-10); p_teorica_B <- p_teorica_B / sum(p_teorica_B)
tabla_frec_B$Esperada <- n_B * p_teorica_B
tabla_frec_B$P_teorica <- p_teorica_B
tabla_frec_B$P_observada <- obs_B / n_B
cat("=== Parámetros Distribución Geométrica — Sección B ===\n")## === Parámetros Distribución Geométrica — Sección B ===cat("p estimado (p̂ = 1/k̄):", round(p_hat_B, 4), "\n")## p estimado (p̂ = 1/k̄): 0.1271cat("Media teórica E[X] = 1/p̂ (en escala k, desde min=", xmin_B, "):", round(1/p_hat_B, 4), "\n")## Media teórica E[X] = 1/p̂ (en escala k, desde min= 19 ): 7.8649cat("Varianza teórica V[X] = (1-p̂)/p̂²:", round((1 - p_hat_B) / p_hat_B^2, 4), "\n")## Varianza teórica V[X] = (1-p̂)/p̂²: 53.9912cat("n =", n_B, "\n\n")## n = 37tabla_print_B <- tabla_frec_B[, c("Intervalo", "ni", "Esperada", "P_teorica")]
tabla_print_B$Esperada <- round(tabla_print_B$Esperada, 4)
tabla_print_B$P_teorica <- round(tabla_print_B$P_teorica, 4)
print(tabla_print_B)## Intervalo ni Esperada P_teorica
## 1 [19 - 20] 6 9.6449 0.2607
## 2 [21 - 22] 4 7.3482 0.1986
## 3 [23 - 24] 7 5.5984 0.1513
## 4 [25 - 26] 4 4.2652 0.1153
## 5 [27 - 28] 7 3.2496 0.0878
## 6 [29 - 30] 3 2.4757 0.0669
## 7 [31 - 32] 0 1.8862 0.0510
## 8 [33 - 34] 4 1.4370 0.0388
## 9 [35 - 35] 1 0.5846 0.0158
## 10 [36 - 36] 1 0.5103 0.0138Tabla de Frecuencias Observadas vs Esperadas
tabla_frec_A %>%
mutate(
P_teorica = sprintf("%.4f", P_teorica),
P_observada = sprintf("%.4f", P_observada),
Esperada = sprintf("%.2f", Esperada)
) %>%
select(Intervalo, ni, Esperada, P_teorica, P_observada) %>%
rename(
"Intervalo" = Intervalo,
"Frec. Observada (Oi)" = ni,
"Frec. Esperada (Ei)" = Esperada,
"P teórica (Poisson)" = P_teorica,
"P observada" = P_observada
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°3: Frecuencias Observadas vs Esperadas — Sección A**"),
subtitle = md(paste0("*Modelo: Poisson (λ = ", round(lambda_hat_A, 4), ")*"))
) %>%
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_A), 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°3: Frecuencias Observadas vs Esperadas — Sección A | ||||
| Modelo: Poisson (λ = 9.4419) | ||||
| Intervalo | Frec. Observada (Oi) | Frec. Esperada (Ei) | P teórica (Poisson) | P observada |
|---|---|---|---|---|
| [1 - 2] | 5 | 0.19 | 0.0043 | 0.1163 |
| [3 - 4] | 1 | 1.61 | 0.0376 | 0.0233 |
| [5 - 6] | 4 | 5.51 | 0.1282 | 0.0930 |
| [7 - 8] | 5 | 9.91 | 0.2305 | 0.1163 |
| [9 - 10] | 11 | 10.94 | 0.2545 | 0.2558 |
| [11 - 12] | 7 | 8.15 | 0.1896 | 0.1628 |
| [13 - 14] | 7 | 4.37 | 0.1015 | 0.1628 |
| [15 - 16] | 1 | 1.76 | 0.0409 | 0.0233 |
| [17 - 17] | 0 | 0.36 | 0.0084 | 0.0000 |
| [18 - 18] | 2 | 0.19 | 0.0044 | 0.0465 |
| Autor: Leslye Quinchiguango | ||||
tabla_frec_B %>%
mutate(
P_teorica = sprintf("%.4f", P_teorica),
P_observada = sprintf("%.4f", P_observada),
Esperada = sprintf("%.2f", Esperada)
) %>%
select(Intervalo, ni, Esperada, P_teorica, P_observada) %>%
rename(
"Intervalo" = Intervalo,
"Frec. Observada (Oi)" = ni,
"Frec. Esperada (Ei)" = Esperada,
"P teórica (Geométrica)" = P_teorica,
"P observada" = P_observada
) %>%
gt() %>%
tab_header(
title = md("**Tabla N°4: Frecuencias Observadas vs Esperadas — Sección B**"),
subtitle = md(paste0("*Modelo: Geométrica (p = ", round(p_hat_B, 4), ")*"))
) %>%
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_B), 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°4: Frecuencias Observadas vs Esperadas — Sección B | ||||
| Modelo: Geométrica (p = 0.1271) | ||||
| Intervalo | Frec. Observada (Oi) | Frec. Esperada (Ei) | P teórica (Geométrica) | P observada |
|---|---|---|---|---|
| [19 - 20] | 6 | 9.64 | 0.2607 | 0.1622 |
| [21 - 22] | 4 | 7.35 | 0.1986 | 0.1081 |
| [23 - 24] | 7 | 5.60 | 0.1513 | 0.1892 |
| [25 - 26] | 4 | 4.27 | 0.1153 | 0.1081 |
| [27 - 28] | 7 | 3.25 | 0.0878 | 0.1892 |
| [29 - 30] | 3 | 2.48 | 0.0669 | 0.0811 |
| [31 - 32] | 0 | 1.89 | 0.0510 | 0.0000 |
| [33 - 34] | 4 | 1.44 | 0.0388 | 0.1081 |
| [35 - 35] | 1 | 0.58 | 0.0158 | 0.0270 |
| [36 - 36] | 1 | 0.51 | 0.0138 | 0.0270 |
| Autor: Leslye Quinchiguango | ||||
Pruebas de Hipótesis — Bondad de Ajuste (Test Pearson / Chi-Cuadrado)
Se aplica una prueba de bondad de ajuste independiente para cada modelo: una para la Sección A (Poisson) y otra para la Sección B (Geométrica). El “Test de Pearson” y la “Prueba Chi-Cuadrado de Bondad de Ajuste” corresponden al mismo estadístico \(\chi^2\); se reportan ambas denominaciones porque así se solicitó en la revisión.
Hipótesis Sección A: \[H_0: \text{Section (1-18) sigue una distribución Poisson}(\hat{\lambda}) \qquad H_1: \text{No la sigue}\]
Hipótesis Sección B: \[H_0: \text{Section (19-36) sigue una distribución Geométrica}(\hat{p}) \qquad H_1: \text{No la sigue}\]
Nivel de significancia: \(\alpha = 0.05\) para ambas pruebas.
res_A <- fusionar_clases(tabla_frec_A$ni, tabla_frec_A$Esperada)
k_efectivo_A <- length(res_A$O)
gl_A <- max(k_efectivo_A - 1 - 1, 1)
chi_stat_A <- sum((res_A$O - res_A$E)^2 / res_A$E)
p_valor_A <- pchisq(chi_stat_A, df = gl_A, lower.tail = FALSE)
chi_crit_A <- qchisq(0.95, df = gl_A)
cat("=== Prueba Chi-Cuadrado / Pearson — Sección A (Poisson) ===\n")## === Prueba Chi-Cuadrado / Pearson — Sección A (Poisson) ===cat("Clases efectivas (k*):", k_efectivo_A, "\n")## Clases efectivas (k*): 5cat("Chi² calculado:", round(chi_stat_A, 6), "\n")## Chi² calculado: 5.237216cat("Grados de libertad (k*-1-1):", gl_A, "\n")## Grados de libertad (k*-1-1): 3cat("Valor p:", format(p_valor_A, scientific = TRUE, digits = 4), "\n")## Valor p: 1.552e-01cat("Valor crítico χ²(0.95,", gl_A, "):", round(chi_crit_A, 4), "\n")## Valor crítico χ²(0.95, 3 ): 7.8147if (p_valor_A > 0.05) {
cat("DECISIÓN: No se rechaza H₀ — el modelo Poisson es aceptado para la Sección A.\n")
} else {
cat("DECISIÓN: Se rechaza H₀ — el modelo Poisson NO es aceptado para la Sección A.\n")
}## DECISIÓN: No se rechaza H₀ — el modelo Poisson es aceptado para la Sección A.res_B <- fusionar_clases(tabla_frec_B$ni, tabla_frec_B$Esperada)
k_efectivo_B <- length(res_B$O)
gl_B <- max(k_efectivo_B - 1 - 1, 1)
chi_stat_B <- sum((res_B$O - res_B$E)^2 / res_B$E)
p_valor_B <- pchisq(chi_stat_B, df = gl_B, lower.tail = FALSE)
chi_crit_B <- qchisq(0.95, df = gl_B)
cat("=== Prueba Chi-Cuadrado / Pearson — Sección B (Geométrica) ===\n")## === Prueba Chi-Cuadrado / Pearson — Sección B (Geométrica) ===cat("Clases efectivas (k*):", k_efectivo_B, "\n")## Clases efectivas (k*): 5cat("Chi² calculado:", round(chi_stat_B, 6), "\n")## Chi² calculado: 5.513818cat("Grados de libertad (k*-1-1):", gl_B, "\n")## Grados de libertad (k*-1-1): 3cat("Valor p:", format(p_valor_B, scientific = TRUE, digits = 4), "\n")## Valor p: 1.378e-01cat("Valor crítico χ²(0.95,", gl_B, "):", round(chi_crit_B, 4), "\n")## Valor crítico χ²(0.95, 3 ): 7.8147if (p_valor_B > 0.05) {
cat("DECISIÓN: No se rechaza H₀ — el modelo Geométrica es aceptado para la Sección B.\n")
} else {
cat("DECISIÓN: Se rechaza H₀ — el modelo Geométrica NO es aceptado para la Sección B.\n")
}## DECISIÓN: No se rechaza H₀ — el modelo Geométrica es aceptado para la Sección B.tabla_chi <- data.frame(
Sección = c("A (1-18)", "B (19-36)"),
Modelo = c("Poisson", "Geométrica"),
Test_Pearson = round(c((1 - p_valor_A) * 100, (1 - p_valor_B) * 100), 2),
Chi_Cuadrado = round(c(chi_stat_A, chi_stat_B), 4),
Umbral_Aceptacion = round(c(chi_crit_A, chi_crit_B), 2),
Resultado_Final = c(
ifelse(p_valor_A > 0.05, "Modelo Aceptado", "Modelo Rechazado"),
ifelse(p_valor_B > 0.05, "Modelo Aceptado", "Modelo Rechazado")
)
)
tabla_chi %>%
gt() %>%
tab_header(title = md("**Tabla N°5: Resumen del Test de Bondad de Ajuste por Sección**")) %>%
cols_label(
Sección = md("**Sección**"),
Modelo = md("**Modelo**"),
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(90), heading.title.font.size = px(14),
table.font.size = px(13), data_row.padding = px(8))| Tabla N°5: Resumen del Test de Bondad de Ajuste por Sección | |||||
| Sección | Modelo | Test Pearson (%) | Chi Cuadrado | Umbral de Aceptación | Resultado Final |
|---|---|---|---|---|---|
| A (1-18) | Poisson | 84.48 | 5.2372 | 7.81 | Modelo Aceptado |
| B (19-36) | Geométrica | 86.22 | 5.5138 | 7.81 | Modelo Aceptado |
| Autor: Leslye Quinchiguango | |||||
Intervalos de Confianza al 95% por Intervalo de Clase
\[IC_{95\%}: \hat{p} \pm z_{\alpha/2} \sqrt{\frac{\hat{p}(1-\hat{p})}{n}}\]
z <- qnorm(0.975)
tabla_ic_A <- tabla_frec_A %>%
mutate(
p_obs = ni / n_A,
error = z * sqrt((p_obs * (1 - p_obs)) / n_A),
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, ni, p_obs, IC_inf, IC_sup)
tabla_ic_A %>%
rename("Intervalo" = Intervalo, "Frec. Obs." = ni, "p̂ observada" = p_obs,
"IC Inferior 95%" = IC_inf, "IC Superior 95%" = IC_sup) %>%
gt() %>%
tab_header(title = md("**Tabla N°6: Intervalos de Confianza 95% — Sección A**")) %>%
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_A), by = 2))) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width = pct(80), heading.title.font.size = px(16), table.font.size = px(13), data_row.padding = px(6))| Tabla N°6: Intervalos de Confianza 95% — Sección A | ||||
| Intervalo | Frec. Obs. | p̂ observada | IC Inferior 95% | IC Superior 95% |
|---|---|---|---|---|
| [1 - 2] | 5 | 0.1163 | 0.0205 | 0.2121 |
| [3 - 4] | 1 | 0.0233 | 0.0000 | 0.0683 |
| [5 - 6] | 4 | 0.0930 | 0.0062 | 0.1798 |
| [7 - 8] | 5 | 0.1163 | 0.0205 | 0.2121 |
| [9 - 10] | 11 | 0.2558 | 0.1254 | 0.3862 |
| [11 - 12] | 7 | 0.1628 | 0.0524 | 0.2731 |
| [13 - 14] | 7 | 0.1628 | 0.0524 | 0.2731 |
| [15 - 16] | 1 | 0.0233 | 0.0000 | 0.0683 |
| [17 - 17] | 0 | 0.0000 | 0.0000 | 0.0000 |
| [18 - 18] | 2 | 0.0465 | 0.0000 | 0.1095 |
| Autor: Leslye Quinchiguango | ||||
tabla_ic_B <- tabla_frec_B %>%
mutate(
p_obs = ni / n_B,
error = z * sqrt((p_obs * (1 - p_obs)) / n_B),
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, ni, p_obs, IC_inf, IC_sup)
tabla_ic_B %>%
rename("Intervalo" = Intervalo, "Frec. Obs." = ni, "p̂ observada" = p_obs,
"IC Inferior 95%" = IC_inf, "IC Superior 95%" = IC_sup) %>%
gt() %>%
tab_header(title = md("**Tabla N°7: Intervalos de Confianza 95% — Sección B**")) %>%
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_B), by = 2))) %>%
tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
tab_options(table.width = pct(80), heading.title.font.size = px(16), table.font.size = px(13), data_row.padding = px(6))| Tabla N°7: Intervalos de Confianza 95% — Sección B | ||||
| Intervalo | Frec. Obs. | p̂ observada | IC Inferior 95% | IC Superior 95% |
|---|---|---|---|---|
| [19 - 20] | 6 | 0.1622 | 0.0434 | 0.2809 |
| [21 - 22] | 4 | 0.1081 | 0.0081 | 0.2082 |
| [23 - 24] | 7 | 0.1892 | 0.0630 | 0.3154 |
| [25 - 26] | 4 | 0.1081 | 0.0081 | 0.2082 |
| [27 - 28] | 7 | 0.1892 | 0.0630 | 0.3154 |
| [29 - 30] | 3 | 0.0811 | 0.0000 | 0.1690 |
| [31 - 32] | 0 | 0.0000 | 0.0000 | 0.0000 |
| [33 - 34] | 4 | 0.1081 | 0.0081 | 0.2082 |
| [35 - 35] | 1 | 0.0270 | 0.0000 | 0.0793 |
| [36 - 36] | 1 | 0.0270 | 0.0000 | 0.0793 |
| Autor: Leslye Quinchiguango | ||||
Gráficas de Comparación Observado vs Esperado
par(mar = c(8, 6, 5, 2))
hi_obs_A <- 100 * tabla_frec_A$P_observada
hi_esp_A <- 100 * tabla_frec_A$P_teorica
barplot(
rbind(hi_obs_A, hi_esp_A),
beside = TRUE,
col = c("gray30", "gray75"),
names.arg = tabla_frec_A$Intervalo,
ylim = c(0, max(c(hi_obs_A, hi_esp_A)) * 1.35),
las = 2,
cex.names = 0.75,
ylab = ""
)
mtext("hi (%)", side = 2, line = 4, cex = 1)
mtext("Intervalo de Section (Sección A)", side = 1, line = 6.5, cex = 1)
mtext(paste0("Gráfica N°3: Observado vs Esperado — Poisson(λ=", round(lambda_hat_A, 2), ")"),
side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("Observado", "Esperado (Poisson)"),
fill = c("gray30", "gray75"), bty = "n", cex = 0.85)
par(mar = c(8, 6, 5, 2))
hi_obs_B <- 100 * tabla_frec_B$P_observada
hi_esp_B <- 100 * tabla_frec_B$P_teorica
barplot(
rbind(hi_obs_B, hi_esp_B),
beside = TRUE,
col = c("gray30", "gray75"),
names.arg = tabla_frec_B$Intervalo,
ylim = c(0, max(c(hi_obs_B, hi_esp_B)) * 1.35),
las = 2,
cex.names = 0.75,
ylab = ""
)
mtext("hi (%)", side = 2, line = 4, cex = 1)
mtext("Intervalo de Section (Sección B)", side = 1, line = 6.5, cex = 1)
mtext(paste0("Gráfica N°4: Observado vs Esperado — Geométrica(p=", round(p_hat_B, 3), ")"),
side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("Observado", "Esperado (Geométrica)"),
fill = c("gray30", "gray75"), bty = "n", cex = 0.85)
par(mar = c(8, 6, 5, 2))
p_obs_A <- tabla_ic_A$p_obs
ic_inf_A <- tabla_ic_A$IC_inf
ic_sup_A <- tabla_ic_A$IC_sup
p_teo_A <- tabla_frec_A$P_teorica
bpA <- barplot(p_obs_A, col = gray(seq(0.25, 0.8, length.out = k_int)),
names.arg = tabla_frec_A$Intervalo, ylim = c(0, max(ic_sup_A) * 1.4),
las = 2, cex.names = 0.75, ylab = "")
arrows(bpA, ic_inf_A, bpA, ic_sup_A, angle = 90, code = 3, length = 0.06, lwd = 1.5)
points(bpA, p_teo_A, pch = 18, cex = 1.2)
lines(bpA, p_teo_A, lty = 2, lwd = 1.5)
mtext("Proporción", side = 2, line = 4, cex = 1)
mtext("Intervalo (Sección A)", side = 1, line = 6.5, cex = 1)
mtext("Gráfica N°5: Intervalos de Confianza 95% — Sección A", side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("p̂ observada", "p teórica Poisson", "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)
par(mar = c(8, 6, 5, 2))
p_obs_B <- tabla_ic_B$p_obs
ic_inf_B <- tabla_ic_B$IC_inf
ic_sup_B <- tabla_ic_B$IC_sup
p_teo_B <- tabla_frec_B$P_teorica
bpB <- barplot(p_obs_B, col = gray(seq(0.25, 0.8, length.out = k_int)),
names.arg = tabla_frec_B$Intervalo, ylim = c(0, max(ic_sup_B) * 1.4),
las = 2, cex.names = 0.75, ylab = "")
arrows(bpB, ic_inf_B, bpB, ic_sup_B, angle = 90, code = 3, length = 0.06, lwd = 1.5)
points(bpB, p_teo_B, pch = 18, cex = 1.2)
lines(bpB, p_teo_B, lty = 2, lwd = 1.5)
mtext("Proporción", side = 2, line = 4, cex = 1)
mtext("Intervalo (Sección B)", side = 1, line = 6.5, cex = 1)
mtext("Gráfica N°6: Intervalos de Confianza 95% — Sección B", side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("p̂ observada", "p teórica Geométrica", "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)
Paso 8: Conclusiones
La variable Section se explica a través de dos modelos según el rango de valores: desde el intervalo 1 hasta el 18 se trabajó con el modelo Poisson (\(\hat{\lambda} = 9.4419\), \(\chi^2 = 5.2372\), \(gl=3\), \(p = 1.552e-01\), no se rechaza H₀), y desde el intervalo 19 hasta el 36 se trabajó con el modelo Geométrica (\(\hat{p} = 0.1271\), \(\chi^2 = 5.5138\), \(gl=3\), \(p = 1.378e-01\), no se rechaza H₀). Ambos modelos son aceptados con un nivel de significancia \(\alpha = 0.05\).
Autor: Leslye Quinchiguango