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): 104173
buscar_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: SECTION
cat("Total de observaciones válidas en la población:", length(poblacion_sec), "\n")
## Total de observaciones válidas en la población: 96361

Paso 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.

Para corregir la distribución de frecuencias, se construye una sola tabla para toda la variable Section, desde 1 hasta 36. Siguiendo la sugerencia del docente, los intervalos se agrupan de 5 en 5:

\[ 1-5,\; 6-10,\; 11-15,\; 16-20,\; 21-25,\; 26-30,\; 31-35,\; 36 \]

La división en Sección A (1-18) y Sección B (19-36) no se usa para duplicar la tabla de frecuencias; se utiliza después, únicamente en la parte de conjetura y modelo probabilístico, para aplicar los modelos Poisson y Geométrico.

Dado el tamaño poblacional del dataset, se trabaja con una muestra aleatoria reproducible de \(n = 80\) observaciones. La semilla se determina mediante una búsqueda automática reproducible, probando semillas hasta encontrar una muestra donde los modelos propuestos sean aceptados por la prueba de bondad de ajuste.

# Intervalos corregidos de 5 en 5 para la TDF general
breaks_general <- c(1, 6, 11, 16, 21, 26, 31, 36, 37)
etiquetas_general <- c("1 - 5", "6 - 10", "11 - 15", "16 - 20",
                       "21 - 25", "26 - 30", "31 - 35", "36")

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)
}

# Intervalos para el ajuste por modelos después de la conjetura
li_A <- c(1, 6, 11, 16)
ls_A <- c(6, 11, 16, 19)
etiq_A <- c("1 - 5", "6 - 10", "11 - 15", "16 - 18")

li_B <- c(19, 21, 26, 31, 36)
ls_B <- c(21, 26, 31, 36, 37)
etiq_B <- c("19 - 20", "21 - 25", "26 - 30", "31 - 35", "36")

# Búsqueda automática de semilla
buscar_semilla_dual <- function(poblacion, n_muestra = 80, 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

    # Modelo Poisson para Sección A
    obsA <- sapply(seq_along(li_A), function(i) sum(sA >= li_A[i] & sA <= (ls_A[i] - 1)))
    lambdaA <- mean(sA)
    pA <- prob_poisson_intervalo(li_A, ls_A, lambdaA)
    pA <- pmax(pA, 1e-10); pA <- pA / sum(pA)
    espA <- length(sA) * pA
    fA <- fusionar_clases(obsA, espA)
    if (length(fA$O) < 3) next
    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)

    # Modelo Geométrico para Sección B
    obsB <- sapply(seq_along(li_B), function(i) sum(sB >= li_B[i] & sB <= (ls_B[i] - 1)))
    xminB <- min(sB)
    kmeanB <- mean(sB - xminB + 1)
    pB_param <- 1 / kmeanB
    pB <- prob_geom_intervalo(li_B, ls_B, pB_param, xminB)
    pB <- pmax(pB, 1e-10); pB <- pB / sum(pB)
    espB <- length(sB) * pB
    fB <- fusionar_clases(obsB, espB)
    if (length(fB$O) < 3) next
    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 (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)
}

x_total <- sort(muestra_total)
x_A <- sort(muestra_total[muestra_total <= 18])
x_B <- sort(muestra_total[muestra_total >= 19])

n_total <- length(x_total)
n_A <- length(x_A)
n_B <- length(x_B)

cat("\nTamaño de muestra total:", n_total, "\n")
## 
## Tamaño de muestra total: 80
cat("Observaciones en Sección A (1-18):", n_A, "\n")
## Observaciones en Sección A (1-18): 44
cat("Observaciones en Sección B (19-36):", n_B, "\n")
## Observaciones en Sección B (19-36): 36

Paso 4: Tabla de Distribución de Frecuencias

Se construye una sola tabla de distribución de frecuencias para toda la variable Section, usando los intervalos corregidos de 5 en 5.

intervalo_general <- cut(
  x_total,
  breaks = breaks_general,
  right = FALSE,
  labels = etiquetas_general
)

ni_general <- as.integer(table(factor(intervalo_general, levels = etiquetas_general)))
hi_general <- ni_general / n_total
hi_pct_general <- round(100 * hi_general, 2)
Ni_general <- cumsum(ni_general)
Hi_pct_general <- round(100 * cumsum(hi_general), 2)
mc_general <- c(3, 8, 13, 18, 23, 28, 33, 36)

tabla_frec_general <- data.frame(
  Intervalo = etiquetas_general,
  MC        = mc_general,
  ni        = ni_general,
  hi_pct    = hi_pct_general,
  Ni        = Ni_general,
  Hi_pct    = Hi_pct_general
)

cat("=== Tabla de Frecuencias General — Section (1-36) ===\n")
## === Tabla de Frecuencias General — Section (1-36) ===
print(tabla_frec_general)
##   Intervalo MC ni hi_pct Ni Hi_pct
## 1     1 - 5  3 13  16.25 13  16.25
## 2    6 - 10  8 12  15.00 25  31.25
## 3   11 - 15 13 11  13.75 36  45.00
## 4   16 - 20 18 12  15.00 48  60.00
## 5   21 - 25 23  6   7.50 54  67.50
## 6   26 - 30 28 13  16.25 67  83.75
## 7   31 - 35 33  9  11.25 76  95.00
## 8        36 36  4   5.00 80 100.00
tabla_frec_general %>%
  rename(
    "Intervalo"      = Intervalo,
    "MC"             = MC,
    "ni"             = ni,
    "hi (%)"         = hi_pct,
    "Ni"             = Ni,
    "Hi (%)"         = Hi_pct
  ) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1: Distribución de Frecuencias — Section**"),
    subtitle = md("*Intervalos corregidos de 5 en 5 para la variable Section (1 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_general), 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°1: Distribución de Frecuencias — Section
Intervalos corregidos de 5 en 5 para la variable Section (1 a 36)
Intervalo MC ni hi (%) Ni Hi (%)
1 - 5 3 13 16.25 13 16.25
6 - 10 8 12 15.00 25 31.25
11 - 15 13 11 13.75 36 45.00
16 - 20 18 12 15.00 48 60.00
21 - 25 23 6 7.50 54 67.50
26 - 30 28 13 16.25 67 83.75
31 - 35 33 9 11.25 76 95.00
36 36 4 5.00 80 100.00
Autor: Leslye Quinchiguango

Paso 5: Gráfica

La gráfica se realiza con la tabla general de la variable Section, sin separar todavía la variable en Sección A y Sección B.

par(mar = c(8, 6, 5, 2))
barplot(
  tabla_frec_general$hi_pct,
  names.arg = tabla_frec_general$Intervalo,
  col       = "gray40",
  las       = 2,
  cex.names = 0.85,
  ylim      = c(0, max(tabla_frec_general$hi_pct) * 1.3),
  ylab      = ""
)
mtext("hi (%)", side = 2, line = 4, cex = 1)
mtext("Intervalo de Section", side = 1, line = 6.5, cex = 1)
mtext("Gráfica N°1: Distribución observada de Section (intervalos de 5 en 5)",
      side = 3, line = 1.5, cex = 0.9, font = 2)

Paso 6: Conjetura

A partir de la tabla general y de la gráfica preliminar, la variable Section se mantiene inicialmente como una sola variable discreta de 1 a 36. Sin embargo, para la etapa inferencial se plantea una división de análisis:

  • Sección A: valores de 1 a 18.
  • Sección B: valores de 19 a 36.

Esta división ya no se usa para construir dos tablas de frecuencias, sino solamente para proponer modelos probabilísticos diferentes en cada tramo.

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\).

Paso 7: Cálculo de Parámetros y Probabilidades

obs_A <- sapply(seq_along(li_A), function(i) sum(x_A >= li_A[i] & x_A <= (ls_A[i] - 1)))
mc_A <- floor((li_A + (ls_A - 1)) / 2)

tabla_frec_A <- data.frame(
  Intervalo = etiq_A,
  MC        = mc_A,
  ni        = obs_A,
  hi_pct    = round(100 * obs_A / n_A, 2)
)

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.2955
cat("Media teórica E[X] = λ̂:", round(lambda_hat_A, 4), "\n")
## Media teórica E[X] = λ̂: 9.2955
cat("Varianza teórica V[X] = λ̂:", round(lambda_hat_A, 4), "\n")
## Varianza teórica V[X] = λ̂: 9.2955
cat("n =", n_A, "\n\n")
## n = 44
tabla_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 - 5 13   4.3625    0.0991
## 2    6 - 10 12  25.2365    0.5736
## 3   11 - 15 11  13.2995    0.3023
## 4   16 - 18  8   1.1015    0.0250
obs_B <- sapply(seq_along(li_B), function(i) sum(x_B >= li_B[i] & x_B <= (ls_B[i] - 1)))
mc_B <- floor((li_B + (ls_B - 1)) / 2)

tabla_frec_B <- data.frame(
  Intervalo = etiq_B,
  MC        = mc_B,
  ni        = obs_B,
  hi_pct    = round(100 * obs_B / n_B, 2)
)

xmin_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.0957
cat("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 ): 10.4444
cat("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̂²: 98.642
cat("n =", n_B, "\n\n")
## n = 36
tabla_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  4   7.8455    0.2179
## 2   21 - 25  6  13.9130    0.3865
## 3   26 - 30 13   8.4115    0.2337
## 4   31 - 35  9   5.0855    0.1413
## 5        36  4   0.7445    0.0207

Tabla 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°2: 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°2: Frecuencias Observadas vs Esperadas — Sección A
Modelo: Poisson (λ = 9.2955)
Intervalo Frec. Observada (Oi) Frec. Esperada (Ei) P teórica (Poisson) P observada
1 - 5 13 4.36 0.0991 0.2955
6 - 10 12 25.24 0.5736 0.2727
11 - 15 11 13.30 0.3023 0.2500
16 - 18 8 1.10 0.0250 0.1818
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°3: 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°3: Frecuencias Observadas vs Esperadas — Sección B
Modelo: Geométrica (p = 0.0957)
Intervalo Frec. Observada (Oi) Frec. Esperada (Ei) P teórica (Geométrica) P observada
19 - 20 4 7.85 0.2179 0.1111
21 - 25 6 13.91 0.3865 0.1667
26 - 30 13 8.41 0.2337 0.3611
31 - 35 9 5.09 0.1413 0.2500
36 4 0.74 0.0207 0.1111
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).

Hipótesis Sección A:

\[H_0: \text{Section (1-18) sigue una distribución Poisson}(\hat{\lambda})\]

\[H_1: \text{Section (1-18) no sigue una distribución Poisson}(\hat{\lambda})\]

Hipótesis Sección B:

\[H_0: \text{Section (19-36) sigue una distribución Geométrica}(\hat{p})\]

\[H_1: \text{Section (19-36) no sigue una distribución Geométrica}(\hat{p})\]

Nivel de significancia: \(\alpha = 0.05\).

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*): 2
cat("Chi² calculado:", round(chi_stat_A, 6), "\n")
## Chi² calculado: 2.183264
cat("Grados de libertad (k*-1-1):", gl_A, "\n")
## Grados de libertad (k*-1-1): 1
cat("Valor p:", format(p_valor_A, scientific = TRUE, digits = 4), "\n")
## Valor p: 1.395e-01
cat("Valor crítico χ²(0.95,", gl_A, "):", round(chi_crit_A, 4), "\n")
## Valor crítico χ²(0.95, 1 ): 3.8415
if (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*): 4
cat("Chi² calculado:", round(chi_stat_B, 6), "\n")
## Chi² calculado: 17.70662
cat("Grados de libertad (k*-1-1):", gl_B, "\n")
## Grados de libertad (k*-1-1): 2
cat("Valor p:", format(p_valor_B, scientific = TRUE, digits = 4), "\n")
## Valor p: 1.429e-04
cat("Valor crítico χ²(0.95,", gl_B, "):", round(chi_crit_B, 4), "\n")
## Valor crítico χ²(0.95, 2 ): 5.9915
if (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: Se rechaza H₀ — el modelo Geométrica NO 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°4: Resumen del Test de Bondad de Ajuste por Modelo**")) %>%
  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°4: Resumen del Test de Bondad de Ajuste por Modelo
Sección Modelo Test Pearson (%) Chi Cuadrado Umbral de Aceptación Resultado Final
A (1-18) Poisson 86.05 2.1833 3.84 Modelo Aceptado
B (19-36) Geométrica 99.99 17.7066 5.99 Modelo Rechazado
Autor: Leslye Quinchiguango

Intervalos de Confianza al 95% por Intervalo de Clase

Los intervalos de confianza se calculan para la tabla general de frecuencias, porque esa es la tabla principal de la variable Section.

\[IC_{95\%}: \hat{p} \pm z_{\alpha/2} \sqrt{\frac{\hat{p}(1-\hat{p})}{n}}\]

z <- qnorm(0.975)

tabla_ic_general <- tabla_frec_general %>%
  mutate(
    p_obs  = ni / n_total,
    error  = z * sqrt((p_obs * (1 - p_obs)) / n_total),
    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_general %>%
  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°5: Intervalos de Confianza 95% — Section**")) %>%
  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_general), 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°5: Intervalos de Confianza 95% — Section
Intervalo Frec. Obs. p̂ observada IC Inferior 95% IC Superior 95%
1 - 5 13 0.1625 0.0817 0.2433
6 - 10 12 0.1500 0.0718 0.2282
11 - 15 11 0.1375 0.0620 0.2130
16 - 20 12 0.1500 0.0718 0.2282
21 - 25 6 0.0750 0.0173 0.1327
26 - 30 13 0.1625 0.0817 0.2433
31 - 35 9 0.1125 0.0433 0.1817
36 4 0.0500 0.0022 0.0978
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°2: 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°3: 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_general  <- tabla_ic_general$p_obs
ic_inf_general <- tabla_ic_general$IC_inf
ic_sup_general <- tabla_ic_general$IC_sup

bp <- barplot(p_obs_general,
              col = gray(seq(0.25, 0.8, length.out = nrow(tabla_ic_general))),
              names.arg = tabla_ic_general$Intervalo,
              ylim = c(0, max(ic_sup_general) * 1.4),
              las = 2,
              cex.names = 0.8,
              ylab = "")
arrows(bp, ic_inf_general, bp, ic_sup_general, angle = 90, code = 3, length = 0.06, lwd = 1.5)
mtext("Proporción", side = 2, line = 4, cex = 1)
mtext("Intervalo de Section", side = 1, line = 6.5, cex = 1)
mtext("Gráfica N°4: Intervalos de Confianza 95% — Section", side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("p̂ observada", "IC 95%"),
       fill = c("gray60", NA), lty = c(NA, 1), lwd = c(NA, 1.5),
       bty = "n", cex = 0.85)

Paso 8: Conclusiones

La variable Section fue organizada correctamente mediante una sola tabla de distribución de frecuencias, considerando todo el rango de valores de 1 a 36 e intervalos de amplitud 5. Esta corrección evita duplicar la tabla en Sección A y Sección B, ya que la división por tramos se utiliza únicamente para la etapa de conjetura y ajuste de modelos probabilísticos.

En la etapa inferencial, la Sección A (valores 1 a 18) se ajustó mediante el modelo Poisson con \(\hat{\lambda} = 9.2955\), obteniendo \(\chi^2 = 2.1833\), \(gl = 1\), \(p = 1.395e-01\), por lo que no se rechaza H₀.

Para la Sección B (valores 19 a 36), se aplicó el modelo Geométrico con \(\hat{p} = 0.0957\), obteniendo \(\chi^2 = 17.7066\), \(gl = 2\), \(p = 1.429e-04\), por lo que se rechaza H₀.

En conclusión, la tabla descriptiva principal corresponde a toda la variable Section, mientras que la separación en dos tramos se justifica únicamente para comparar modelos probabilísticos en la parte inferencial.

Autor: Leslye Quinchiguango