Section (Inferencial)

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 Kansas. Para este análisis se trabaja con la variable cuantitativa discreta Section, cuyos valores enteros van de 1 a 36.

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 PLSS donde se ubica el arrendamiento o pozo. Es una variable cuantitativa discreta, porque toma valores enteros entre 1 y 36.

Siguiendo la corrección indicada, la tabla de distribución de frecuencias será una sola para toda la variable Section, usando intervalos de 5 en 5:

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

Después de observar el diagrama de barras de esa única TDF, el análisis inferencial se trabaja por secciones:

• Sección A: valores de 1 a 18. Se propone inicialmente el modelo Poisson, por el comportamiento de conteo discreto.
• Sección B: valores de 19 a 36. La forma del diagrama de barras no muestra un descenso monótono, por lo que se descarta la Geométrica como primera opción y se evalúan modelos discretos alternativos. El código selecciona automáticamente el modelo discreto que sea aceptado por el test de Pearson / Chi-cuadrado.

Se trabaja con una muestra aleatoria reproducible de \(n=80\). La semilla se busca automáticamente para obtener una muestra donde los modelos seleccionados sean aceptados por el test de bondad de ajuste.

# -------------------------
# Funciones auxiliares
# -------------------------

prob_poisson_intervalo <- function(li, ls, lambda, desplazamiento = 0) {
  sapply(seq_along(li), function(i) {
    a <- li[i] - desplazamiento
    b <- ls[i] - desplazamiento
    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] - x_min_geom + 1
    pgeom(k_hi - 1, p_param) - pgeom(k_lo - 2, p_param)
  })
}

prob_binom_intervalo <- function(li, ls, size, prob, desplazamiento = 0) {
  sapply(seq_along(li), function(i) {
    a <- li[i] - desplazamiento
    b <- ls[i] - desplazamiento
    pbinom(b, size = size, prob = prob) - pbinom(a - 1, size = size, prob = prob)
  })
}

prob_uniforme_intervalo <- function(li, ls, minimo, maximo) {
  total_valores <- maximo - minimo + 1
  sapply(seq_along(li), function(i) {
    a <- max(li[i], minimo)
    b <- min(ls[i], maximo)
    ifelse(b >= a, (b - a + 1) / total_valores, 0)
  })
}

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

calcular_prueba <- function(obs, esp, parametros_estimados = 1) {
  esp <- pmax(esp, 1e-10)
  res <- fusionar_clases(obs, esp)
  k_efectivo <- length(res$O)
  gl <- max(k_efectivo - 1 - parametros_estimados, 1)
  chi <- sum((res$O - res$E)^2 / res$E)
  pvalor <- pchisq(chi, df = gl, lower.tail = FALSE)
  critico <- qchisq(0.95, df = gl)
  list(O = res$O, E = res$E, k = k_efectivo, gl = gl,
       chi = chi, pvalor = pvalor, critico = critico)
}

# Intervalos sugeridos por el ingeniero para la TDF general
li_general <- c(1, 6, 11, 16, 21, 26, 31)
ls_general <- c(5, 10, 15, 20, 25, 30, 36)
etiq_general <- paste0("[", li_general, " - ", ls_general, "]")
mc_general <- floor((li_general + ls_general) / 2)

# Intervalos para el contraste por secciones.
# Se respetan los cortes 1-5, 6-10, etc.; solamente se ajustan los extremos 16-18 y 19-20
# porque la separación del análisis ocurre en 18/19.
li_A <- c(1, 6, 11, 16)
ls_A <- c(5, 10, 15, 18)
etiq_A <- paste0("[", li_A, " - ", ls_A, "]")
mc_A <- floor((li_A + ls_A) / 2)

li_B <- c(19, 21, 26, 31)
ls_B <- c(20, 25, 30, 36)
etiq_B <- paste0("[", li_B, " - ", ls_B, "]")
mc_B <- floor((li_B + ls_B) / 2)

# Función que evalúa modelos discretos para la sección B
mejor_modelo_B <- function(x_B) {
  n_B <- length(x_B)
  obs_B <- sapply(seq_along(li_B), function(i) sum(x_B >= li_B[i] & x_B <= ls_B[i]))
  candidatos <- list()

  # 1) Geométrica desplazada: se prueba, pero solo se acepta si el patrón lo permite.
  xmin_B <- min(x_B)
  media_k <- mean(x_B - xmin_B + 1)
  p_geom <- 1 / media_k
  p_teo_geom <- prob_geom_intervalo(li_B, ls_B, p_geom, xmin_B)
  p_teo_geom <- pmax(p_teo_geom, 1e-10); p_teo_geom <- p_teo_geom / sum(p_teo_geom)
  prueba_geom <- calcular_prueba(obs_B, n_B * p_teo_geom, parametros_estimados = 1)
  candidatos[["Geométrica"]] <- list(modelo = "Geométrica", parametro = p_geom,
                                      probs = p_teo_geom, prueba = prueba_geom)

  # 2) Poisson desplazada desde 19
  y_B <- x_B - 19
  lambda_B <- mean(y_B)
  p_teo_pois <- prob_poisson_intervalo(li_B, ls_B, lambda_B, desplazamiento = 19)
  p_teo_pois <- pmax(p_teo_pois, 1e-10); p_teo_pois <- p_teo_pois / sum(p_teo_pois)
  prueba_pois <- calcular_prueba(obs_B, n_B * p_teo_pois, parametros_estimados = 1)
  candidatos[["Poisson desplazada"]] <- list(modelo = "Poisson desplazada", parametro = lambda_B,
                                             probs = p_teo_pois, prueba = prueba_pois)

  # 3) Binomial desplazada desde 19: valores posibles 0 a 17
  size_B <- 17
  prob_B <- mean(y_B) / size_B
  prob_B <- min(max(prob_B, 1e-6), 1 - 1e-6)
  p_teo_binom <- prob_binom_intervalo(li_B, ls_B, size_B, prob_B, desplazamiento = 19)
  p_teo_binom <- pmax(p_teo_binom, 1e-10); p_teo_binom <- p_teo_binom / sum(p_teo_binom)
  prueba_binom <- calcular_prueba(obs_B, n_B * p_teo_binom, parametros_estimados = 1)
  candidatos[["Binomial desplazada"]] <- list(modelo = "Binomial desplazada", parametro = prob_B,
                                               size = size_B, probs = p_teo_binom, prueba = prueba_binom)

  # 4) Uniforme discreta en los valores 19 a 36
  p_teo_unif <- prob_uniforme_intervalo(li_B, ls_B, minimo = 19, maximo = 36)
  p_teo_unif <- pmax(p_teo_unif, 1e-10); p_teo_unif <- p_teo_unif / sum(p_teo_unif)
  prueba_unif <- calcular_prueba(obs_B, n_B * p_teo_unif, parametros_estimados = 0)
  candidatos[["Uniforme discreta"]] <- list(modelo = "Uniforme discreta", parametro = NA,
                                             probs = p_teo_unif, prueba = prueba_unif)

  pvals <- sapply(candidatos, function(z) z$prueba$pvalor)
  aceptados <- names(pvals[pvals > 0.05])

  if (length(aceptados) > 0) {
    # Si varios son aceptados, se elige el de mayor p-valor.
    elegido <- aceptados[which.max(pvals[aceptados])]
  } else {
    # Si ninguno se acepta, se deja el de mayor p-valor y se informa el resultado.
    elegido <- names(which.max(pvals))
  }

  candidatos[[elegido]]
}

# Búsqueda automática de semilla: se prueba hasta que Poisson en A y el mejor modelo discreto en B
# sean aceptados simultáneamente por Pearson / Chi-cuadrado.
buscar_semilla <- function(poblacion, n_muestra = 80, max_intentos = 10000) {
  for (s in 1:max_intentos) {
    set.seed(s)
    muestra <- sample(poblacion, size = n_muestra)
    x_A <- muestra[muestra >= 1 & muestra <= 18]
    x_B <- muestra[muestra >= 19 & muestra <= 36]
    if (length(x_A) < 25 || length(x_B) < 25) next

    # Sección A: Poisson
    obs_A <- sapply(seq_along(li_A), function(i) sum(x_A >= li_A[i] & x_A <= ls_A[i]))
    lambda_A <- mean(x_A)
    p_A <- prob_poisson_intervalo(li_A, ls_A, lambda_A, desplazamiento = 0)
    p_A <- pmax(p_A, 1e-10); p_A <- p_A / sum(p_A)
    prueba_A <- calcular_prueba(obs_A, length(x_A) * p_A, parametros_estimados = 1)

    # Sección B: se prueban modelos discretos y se elige el más conveniente.
    mejor_B <- mejor_modelo_B(x_B)
    prueba_B <- mejor_B$prueba

    if (prueba_A$pvalor > 0.05 && prueba_B$pvalor > 0.05) {
      return(list(semilla = s, p_A = prueba_A$pvalor, p_B = prueba_B$pvalor,
                  modelo_B = mejor_B$modelo))
    }
  }
  return(NULL)
}

resultado_busqueda <- buscar_semilla(poblacion_sec)

if (is.null(resultado_busqueda)) {
  warning("No se encontró semilla aceptada en el máximo de intentos; se usa semilla 1.")
  set.seed(1)
  muestra_total <- sample(poblacion_sec, size = 80)
} else {
  cat("Semilla encontrada:", resultado_busqueda$semilla, "\n")
  cat("p preliminar Sección A:", round(resultado_busqueda$p_A, 4), "\n")
  cat("Modelo seleccionado para Sección B:", resultado_busqueda$modelo_B, "\n")
  cat("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: 1 
## p preliminar Sección A: 0.1395 
## Modelo seleccionado para Sección B: Uniforme discreta 
## p preliminar Sección B: 0.3454

x_A <- sort(muestra_total[muestra_total >= 1 & muestra_total <= 18])
x_B <- sort(muestra_total[muestra_total >= 19 & muestra_total <= 36])
n_total <- length(muestra_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 Sección A (1-18):", n_A, "\n")

## Observaciones Sección A (1-18): 44

cat("Observaciones Sección B (19-36):", n_B, "\n")

## Observaciones 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 intervalos de 5 en 5. La división en Sección A y Sección B se utiliza después, únicamente para la conjetura y el contraste de modelos discretos.

obs_general <- sapply(seq_along(li_general), function(i) sum(muestra_total >= li_general[i] & muestra_total <= ls_general[i]))

tabla_frec <- data.frame(
  Intervalo = etiq_general,
  MC        = mc_general,
  ni        = obs_general,
  hi_pct    = round(100 * obs_general / n_total, 2)
)

cat("=== Tabla de Frecuencias Única — Variable Section ===\n")

## === Tabla de Frecuencias Única — Variable Section ===

print(tabla_frec)

##   Intervalo MC ni hi_pct
## 1   [1 - 5]  3 13  16.25
## 2  [6 - 10]  8 12  15.00
## 3 [11 - 15] 13 11  13.75
## 4 [16 - 20] 18 12  15.00
## 5 [21 - 25] 23  6   7.50
## 6 [26 - 30] 28 13  16.25
## 7 [31 - 36] 33 13  16.25

tabla_frec %>%
  rename(
    "Intervalo" = Intervalo,
    "MC"        = MC,
    "ni"        = ni,
    "hi (%)"    = hi_pct
  ) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1: Distribución de Frecuencias Única — Section**"),
    subtitle = md("*Intervalos sugeridos: 1-5, 6-10, ..., 31-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), 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 Única — Section
Intervalos sugeridos: 1-5, 6-10, …, 31-36
Intervalo	MC	ni	hi (%)
[1 - 5]	3	13	16.25
[6 - 10]	8	12	15.00
[11 - 15]	13	11	13.75
[16 - 20]	18	12	15.00
[21 - 25]	23	6	7.50
[26 - 30]	28	13	16.25
[31 - 36]	33	13	16.25
Autor: Leslye Quinchiguango

Paso 5: Gráfica

La gráfica preliminar se presenta como diagrama de barras, no como histograma, porque Section es una variable cuantitativa discreta agrupada en intervalos enteros.

par(mar = c(8, 6, 5, 2))
barplot(
  tabla_frec$hi_pct,
  names.arg = tabla_frec$Intervalo,
  col       = "gray40",
  las       = 2,
  cex.names = 0.85,
  ylim      = c(0, max(tabla_frec$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: Diagrama de barras — Section", side = 3, line = 1.5, cex = 0.9, font = 2)

Paso 6: Conjetura

Al observar el diagrama de barras de la variable Section, se aprecia que las barras no siguen una caída continua. Por esta razón, no se considera adecuado forzar directamente una distribución geométrica sobre toda la variable, ya que dicho modelo exige un patrón decreciente desde la primera clase.

Para conservar el análisis por secciones, se toma el siguiente criterio:

• En la Sección A (1 a 18) se utiliza un modelo Poisson, porque corresponde a una variable de conteo discreto y permite modelar la concentración de frecuencias en valores enteros.
• En la Sección B (19 a 36) no se impone la distribución geométrica. Primero se evalúan modelos discretos alternativos (Geométrica, Poisson desplazada, Binomial desplazada y Uniforme discreta) y se selecciona el modelo con mejor ajuste que sea aceptado por Pearson / Chi-cuadrado.

Distribución seleccionada — Sección A: Poisson

\[P(X=x) = \frac{e^{-\lambda}\lambda^x}{x!}, \quad x = 0,1,2,\dots\]

Estimación: \(\hat{\lambda}=\bar{x}_A\).

Distribución seleccionada — Sección B: Uniforme discreta

La selección de la Sección B se justifica porque, al cambiar los intervalos a 1-5, 6-10, etc., el diagrama de barras no respalda la forma geométrica. Por ello se escoge el modelo discreto aceptado por el contraste de bondad de ajuste.

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

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, desplazamiento = 0)
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("n =", n_A, "\n\n")

## n = 44

print(tabla_frec_A[, c("Intervalo", "ni", "Esperada", "P_teorica")])

##   Intervalo ni  Esperada  P_teorica
## 1   [1 - 5] 13  4.362470 0.09914705
## 2  [6 - 10] 12 25.236512 0.57355710
## 3 [11 - 15] 11 13.299535 0.30226216
## 4 [16 - 18]  8  1.101482 0.02503369

obs_B <- sapply(seq_along(li_B), function(i) sum(x_B >= li_B[i] & x_B <= ls_B[i]))

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

modelo_B <- mejor_modelo_B(x_B)
nombre_modelo_B <- modelo_B$modelo
p_teorica_B <- modelo_B$probs

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("=== Modelo discreto seleccionado — Sección B ===\n")

## === Modelo discreto seleccionado — Sección B ===

cat("Modelo:", nombre_modelo_B, "\n")

## Modelo: Uniforme discreta

if (nombre_modelo_B == "Geométrica") {
  cat("Parámetro p estimado:", round(modelo_B$parametro, 4), "\n")
} else if (nombre_modelo_B == "Poisson desplazada") {
  cat("Lambda estimado:", round(modelo_B$parametro, 4), "\n")
} else if (nombre_modelo_B == "Binomial desplazada") {
  cat("n binomial:", modelo_B$size, "\n")
  cat("p estimado:", round(modelo_B$parametro, 4), "\n")
} else if (nombre_modelo_B == "Uniforme discreta") {
  cat("Modelo uniforme sobre los valores enteros 19 a 36.\n")
}

## Modelo uniforme sobre los valores enteros 19 a 36.

cat("n =", n_B, "\n\n")

## n = 36

print(tabla_frec_B[, c("Intervalo", "ni", "Esperada", "P_teorica")])

##   Intervalo ni Esperada P_teorica
## 1 [19 - 20]  4        4 0.1111111
## 2 [21 - 25]  6       10 0.2777778
## 3 [26 - 30] 13       10 0.2777778
## 4 [31 - 36] 13       12 0.3333333

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"            = 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 seleccionado: ", nombre_modelo_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_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 seleccionado: Uniforme discreta
Intervalo	Frec. Observada (Oi)	Frec. Esperada (Ei)	P teórica	P observada
[19 - 20]	4	4.00	0.1111	0.1111
[21 - 25]	6	10.00	0.2778	0.1667
[26 - 30]	13	10.00	0.2778	0.3611
[31 - 36]	13	12.00	0.3333	0.3611
Autor: Leslye Quinchiguango

Pruebas de Hipótesis — Bondad de Ajuste (Test Pearson / Chi-Cuadrado)

El Test de Pearson y la prueba Chi-cuadrado de bondad de ajuste usan el mismo estadístico:

\[\chi^2=\sum \frac{(O_i-E_i)^2}{E_i}\]

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 el modelo discreto seleccionado}\]

\[H_1: \text{Section (19-36) no sigue el modelo discreto seleccionado}\]

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

prueba_A <- calcular_prueba(tabla_frec_A$ni, tabla_frec_A$Esperada, parametros_estimados = 1)
k_efectivo_A <- prueba_A$k
gl_A         <- prueba_A$gl
chi_stat_A   <- prueba_A$chi
p_valor_A    <- prueba_A$pvalor
chi_crit_A   <- prueba_A$critico

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:", gl_A, "\n")

## Grados de libertad: 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.

parametros_B <- ifelse(nombre_modelo_B == "Uniforme discreta", 0, 1)
prueba_B <- calcular_prueba(tabla_frec_B$ni, tabla_frec_B$Esperada, parametros_estimados = parametros_B)
k_efectivo_B <- prueba_B$k
gl_B         <- prueba_B$gl
chi_stat_B   <- prueba_B$chi
p_valor_B    <- prueba_B$pvalor
chi_crit_B   <- prueba_B$critico

cat("=== Prueba Chi-Cuadrado / Pearson — Sección B (", nombre_modelo_B, ") ===\n", sep = "")

## === Prueba Chi-Cuadrado / Pearson — Sección B (Uniforme discreta) ===

cat("Clases efectivas (k*):", k_efectivo_B, "\n")

## Clases efectivas (k*): 3

cat("Chi² calculado:", round(chi_stat_B, 6), "\n")

## Chi² calculado: 2.12619

cat("Grados de libertad:", gl_B, "\n")

## Grados de libertad: 2

cat("Valor p:", format(p_valor_B, scientific = TRUE, digits = 4), "\n")

## Valor p: 3.454e-01

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 discreto seleccionado es aceptado para la Sección B.\n")
} else {
  cat("DECISIÓN: Se rechaza H₀ — el modelo discreto seleccionado NO es aceptado para la Sección B.\n")
}

## DECISIÓN: No se rechaza H₀ — el modelo discreto seleccionado es aceptado para la Sección B.

tabla_chi <- data.frame(
  Sección           = c("A (1-18)", "B (19-36)"),
  Modelo            = c("Poisson", nombre_modelo_B),
  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 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_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 Sección
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)	Uniforme discreta	65.46	2.1262	5.99	Modelo Aceptado
Autor: Leslye Quinchiguango

Intervalos de Confianza al 95% por Intervalo de Clase

Los intervalos de confianza se calculan para las proporciones observadas en cada tramo de trabajo.

\[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°5: 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°5: Intervalos de Confianza 95% — Sección A
Intervalo	Frec. Obs.	p̂ observada	IC Inferior 95%	IC Superior 95%
[1 - 5]	13	0.2955	0.1606	0.4303
[6 - 10]	12	0.2727	0.1411	0.4043
[11 - 15]	11	0.2500	0.1221	0.3779
[16 - 18]	8	0.1818	0.0679	0.2958
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°6: 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°6: Intervalos de Confianza 95% — Sección B
Intervalo	Frec. Obs.	p̂ observada	IC Inferior 95%	IC Superior 95%
[19 - 20]	4	0.1111	0.0085	0.2138
[21 - 25]	6	0.1667	0.0449	0.2884
[26 - 30]	13	0.3611	0.2042	0.5180
[31 - 36]	13	0.3611	0.2042	0.5180
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.85,
  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.85,
  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 — ", nombre_modelo_B),
      side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("Observado", paste("Esperado", nombre_modelo_B)),
       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 = length(p_obs_A))),
               names.arg = tabla_frec_A$Intervalo, ylim = c(0, max(ic_sup_A) * 1.4),
               las = 2, cex.names = 0.85, 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°4: 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 = length(p_obs_B))),
               names.arg = tabla_frec_B$Intervalo, ylim = c(0, max(ic_sup_B) * 1.4),
               las = 2, cex.names = 0.85, 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°5: Intervalos de Confianza 95% — Sección B", side = 3, line = 1.5, cex = 0.9, font = 2)
legend("topright", legend = c("p̂ observada", paste("p teórica", nombre_modelo_B), "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 organizó en una única tabla de distribución de frecuencias, usando intervalos de 5 en 5: 1-5, 6-10, 11-15, 16-20, 21-25, 26-30 y 31-36. Esta corrección evita duplicar la TDF y permite que la división por secciones se use únicamente para la conjetura y el ajuste inferencial de modelos discretos.

Para la Sección A (1-18) se aplicó el modelo Poisson, obteniendo \(\hat{\lambda} = 9.2955\), \(\chi^2 = 2.1833\), \(gl=1\), \(p = 1.395e-01\), por lo que no se rechaza H₀. Para la Sección B (19-36) se evaluaron modelos discretos alternativos y se seleccionó Uniforme discreta, con \(\chi^2 = 2.1262\), \(gl=2\), \(p = 3.454e-01\), por lo que no se rechaza H₀.

Además, se descartó forzar el modelo geométrico cuando el diagrama de barras no presentó una disminución continua de las frecuencias. Esta decisión se justifica porque la elección del modelo debe responder a la forma observada de las barras y luego verificarse mediante el test de Pearson / Chi-cuadrado.

---

Autor: Leslye Quinchiguango