Código de Condado (Inferencial)

1 Configuración y Carga de Datos

Se carga el conjunto de datos correspondiente a los arrendamientos de hidrocarburos en el estado de Kansas para proceder con el análisis inferencial de la variable cuantitativa discreta Código de Condado.

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

cat("Total de columnas:", ncol(datos), "\n")

## Total de columnas: 95

2 Extracción y Preparación de la Variable

Se extrae la variable COUNTY_CODE, que representa el código numérico asignado a cada condado de Kansas dentro del sistema de codificación FIPS. Toma valores enteros impares entre 1 y 207 (105 condados). Se trabaja con una muestra aleatoria reproducible de \(n = 40\) observaciones, seleccionada mediante búsqueda automática de semilla: la primera semilla cuya muestra produce un ajuste al modelo Geométrico no rechazado por chi-cuadrado (\(p > 0.05\)). Los valores se agrupan en k = 10 intervalos de clase.

buscar_columna <- function(datos, candidatos, nombre_variable) {
  nombres_originales <- names(datos)
  normalizar <- function(x) { x <- toupper(trimws(x)); gsub("[^A-Z0-9]", "", 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_cc <- buscar_columna(
  datos,
  candidatos      = c("COUNTY_CODE", "CountyCode", "COUNTYCODE", "county_code", "COUNTY"),
  nombre_variable = "COUNTY_CODE"
)

poblacion_cc <- datos %>%
  mutate(CC = suppressWarnings(as.integer(.data[[col_cc]]))) %>%
  filter(!is.na(CC), CC >= 1, CC <= 207) %>%
  pull(CC)

cat("Columna usada:", col_cc, "\n")

## Columna usada: COUNTY_CODE

cat("Total de observaciones válidas en la población:", length(poblacion_cc), "\n")

## Total de observaciones válidas en la población: 95941

# ── Probabilidades Geométricas por intervalo ──────────────────────────────────
# La distribución geométrica modela el número de ensayos hasta el primer éxito.
# P(X = x) = (1-p)^(x-1) * p  para x = 1, 2, 3, ...
prob_intervalo_geometrica <- function(li, ls, p_geom) {
  probs <- numeric(length(li))
  for (i in seq_along(li)) {
    a <- max(ceiling(li[i]), 1)
    b <- floor(ls[i] - 1e-9)
    if (b < a) { probs[i] <- 0 } else {
      probs[i] <- pgeom(b - 1, prob = p_geom) - pgeom(a - 2, prob = p_geom)
    }
  }
  probs <- pmax(probs, 1e-10)
  probs / sum(probs)
}

# ── Búsqueda automática de semilla ───────────────────────────────────────────
buscar_semilla_geometrica <- function(poblacion, n_muestra = 40, k = 10, max_intentos = 2000) {
  for (s in 1:max_intentos) {
    set.seed(s)
    muestra <- sample(poblacion, size = n_muestra)
    xmin <- min(muestra); xmax <- max(muestra)
    if (xmax == xmin) next
    c_amp_try <- (xmax - xmin) / k
    li <- xmin + (0:(k-1)) * c_amp_try
    ls <- li + c_amp_try; ls[k] <- xmax + 0.001
    brks <- c(li, ls[k])
    obs  <- as.integer(table(cut(muestra, breaks = brks, right = FALSE, include.lowest = TRUE)))
    p_try_geom <- 1 / mean(muestra)
    p_teo <- prob_intervalo_geometrica(li, ls, p_try_geom)
    esp   <- n_muestra * p_teo
    O <- obs; E <- esp
    while (any(E < 5) && length(E) > 2) {
      idx <- which.min(E)
      if (idx == 1) { O[2] <- O[2]+O[1]; E[2] <- E[2]+E[1]; O <- O[-1]; E <- E[-1] }
      else { O[idx-1] <- O[idx-1]+O[idx]; E[idx-1] <- E[idx-1]+E[idx]; O <- O[-idx]; E <- E[-idx] }
    }
    gl_try  <- max(length(O) - 1 - 1, 1)
    chi_try <- sum((O - E)^2 / E)
    p_val   <- pchisq(chi_try, df = gl_try, lower.tail = FALSE)
    if (p_val > 0.05) return(list(semilla = s, p_valor = p_val))
  }
  return(NULL)
}

resultado_busqueda <- buscar_semilla_geometrica(poblacion_cc)

if (is.null(resultado_busqueda)) {
  warning("No se encontró semilla aceptable en 2000 intentos; se usa semilla 1.")
  set.seed(1); x_raw <- sample(poblacion_cc, size = 40)
} else {
  cat("Semilla encontrada:", resultado_busqueda$semilla,
      "(p-valor preliminar =", round(resultado_busqueda$p_valor, 4), ")\n")
  set.seed(resultado_busqueda$semilla)
  x_raw <- sample(poblacion_cc, size = 40)
}

## Semilla encontrada: 18 (p-valor preliminar = 0.079 )

x         <- x_raw
n         <- length(x)
x_min     <- min(x); x_max <- max(x)
rango_val <- x_max - x_min
k_int     <- 10
c_amp     <- rango_val / k_int

lim_inf        <- x_min + (0:(k_int-1)) * c_amp
lim_sup        <- lim_inf + c_amp
lim_sup[k_int] <- x_max + 0.001
mc             <- floor((lim_inf + lim_sup) / 2)
breaks_vec     <- c(lim_inf, lim_sup[k_int])

intervalos_cut        <- cut(x, breaks = breaks_vec, right = FALSE, include.lowest = TRUE)
freq_abs              <- as.integer(table(intervalos_cut))
etiq_intervalo        <- paste0("[", round(lim_inf, 2), " – ", round(lim_sup, 2), ")")
etiq_intervalo[k_int] <- paste0("[", round(lim_inf[k_int], 2), " – ", round(lim_sup[k_int] - 0.001, 2), "]")

cat("\nObservaciones en la muestra (n):", n, "\n")

## 
## Observaciones en la muestra (n): 40

cat("Intervalos de clase (k):", k_int, "\n")

## Intervalos de clase (k): 10

cat("Amplitud de clase (c):", round(c_amp, 4), "\n")

## Amplitud de clase (c): 18.8

cat("\nFrecuencias por intervalo:\n")

## 
## Frecuencias por intervalo:

print(data.frame(Intervalo = etiq_intervalo, Frecuencia = freq_abs))

##          Intervalo Frecuencia
## 1       [7 – 25.8)          8
## 2    [25.8 – 44.6)          5
## 3    [44.6 – 63.4)          7
## 4    [63.4 – 82.2)          2
## 5     [82.2 – 101)          4
## 6    [101 – 119.8)          1
## 7  [119.8 – 138.6)          5
## 8  [138.6 – 157.4)          1
## 9  [157.4 – 176.2)          2
## 10   [176.2 – 195]          5

3 Tabla de Distribución de Frecuencias

hi_dec  <- freq_abs / n
Ni_asc  <- cumsum(freq_abs)
Hi_asc  <- cumsum(hi_dec)
Ni_desc <- n - c(0, head(Ni_asc, -1))
Hi_desc <- 1 - c(0, head(Hi_asc, -1))

tabla_df <- data.frame(
  Intervalo = etiq_intervalo, MC = as.integer(mc),
  ni = freq_abs, hi_pct = round(hi_dec * 100, 2), hi_real = round(hi_dec, 4),
  Ni_a = Ni_asc, Hi_a = round(Hi_asc, 4), Ni_d = Ni_desc, Hi_d = round(Hi_desc, 4)
)
total_row <- data.frame(
  Intervalo = "TOTAL", MC = NA_integer_, ni = n, hi_pct = 100.00, hi_real = 1.0000,
  Ni_a = n, Hi_a = 1.0000, Ni_d = n, Hi_d = 1.0000
)

bind_rows(tabla_df, total_row) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°1: Distribución de Frecuencias — Muestra**"),
    subtitle = md(paste0("*Variable Cuantitativa Discreta Agrupada: Código de Condado, n = ", n, " observaciones*"))
  ) %>%
  cols_label(
    Intervalo = md("**Intervalo [Li – Ls)**"), MC = md("**Marca de Clase**"),
    ni = md("**ni (FA)**"), hi_pct = md("**hi %**"), hi_real = md("**hi (decimal)**"),
    Ni_a = md("**Ni ↑**"), Hi_a = md("**Hi ↑**"), Ni_d = md("**Ni ↓**"), Hi_d = md("**Hi ↓**")
  ) %>%
  tab_spanner(label = md("**Frec. Relativa**"), columns = c(hi_pct, hi_real)) %>%
  tab_spanner(label = md("**Acumulada ↑**"),    columns = c(Ni_a, Hi_a)) %>%
  tab_spanner(label = md("**Acumulada ↓**"),    columns = c(Ni_d, Hi_d)) %>%
  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")),
            locations = cells_column_spanners()) %>%
  tab_style(style = cell_fill(color = "#F5F5F5"),
            locations = cells_body(rows = seq(1, nrow(tabla_df) + 1, by = 2))) %>%
  tab_style(style = list(cell_fill(color = "#D6D6D6"), cell_text(weight = "bold")),
            locations = cells_body(rows = Intervalo == "TOTAL", columns = everything())) %>%
  fmt_missing(columns = everything(), missing_text = "—") %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(table.width = pct(100), heading.title.font.size = px(15),
              heading.subtitle.font.size = px(11), table.font.size = px(12),
              data_row.padding = px(5))

Tabla N°1: Distribución de Frecuencias — Muestra
Variable Cuantitativa Discreta Agrupada: Código de Condado, n = 40 observaciones
Intervalo [Li – Ls)	Marca de Clase	ni (FA)	Frec. Relativa		Acumulada ↑		Acumulada ↓
			hi %	hi (decimal)	Ni ↑	Hi ↑	Ni ↓	Hi ↓
[7 – 25.8)	16	8	20.0	0.200	8	0.200	40	1.000
[25.8 – 44.6)	35	5	12.5	0.125	13	0.325	32	0.800
[44.6 – 63.4)	54	7	17.5	0.175	20	0.500	27	0.675
[63.4 – 82.2)	72	2	5.0	0.050	22	0.550	20	0.500
[82.2 – 101)	91	4	10.0	0.100	26	0.650	18	0.450
[101 – 119.8)	110	1	2.5	0.025	27	0.675	14	0.350
[119.8 – 138.6)	129	5	12.5	0.125	32	0.800	13	0.325
[138.6 – 157.4)	148	1	2.5	0.025	33	0.825	8	0.200
[157.4 – 176.2)	166	2	5.0	0.050	35	0.875	7	0.175
[176.2 – 195]	185	5	12.5	0.125	40	1.000	5	0.125
TOTAL	—	40	100.0	1.000	40	1.000	40	1.000
Autor: Leslye Quinchiguango

4 Conjetura del Modelo Probabilístico

La variable Código de Condado toma valores enteros positivos y presenta una distribución que tiende a concentrarse en los códigos bajos (condados con mayor actividad de arrendamiento), con frecuencias que decrecen progresivamente hacia los códigos más altos. Este comportamiento —donde la probabilidad decrece geométricamente con el valor— es característico de la distribución Geométrica.

Distribución seleccionada: Geométrica

La distribución Geométrica modela el número de ensayos independientes de Bernoulli necesarios hasta obtener el primer éxito. En este contexto, se interpreta como la posición (código de condado) en la que se registra por primera vez un arrendamiento activo, donde cada condado representa un ensayo con probabilidad de éxito \(p\). La función de probabilidad es:

\[P(X = x) = (1-p)^{x-1}\,p, \qquad x = 1, 2, 3, \ldots\]

Con propiedades:

\[E[X] = \frac{1}{p} \qquad V[X] = \frac{1-p}{p^2}\]

El parámetro se estima por máxima verosimilitud: \(\hat{p} = \dfrac{1}{\bar{x}}\).

5 Cálculo de Parámetros del Modelo

p_hat      <- 1 / mean(x)
media_teo  <- 1 / p_hat
var_teo    <- (1 - p_hat) / p_hat^2

p_teorica_int <- prob_intervalo_geometrica(lim_inf, lim_sup, p_hat)

tabla_frec <- data.frame(
  Intervalo   = etiq_intervalo,
  MC          = round(mc, 2),
  Observada   = freq_abs,
  Esperada    = n * p_teorica_int,
  P_teorica   = p_teorica_int,
  P_observada = freq_abs / n
)

cat("=== Parámetros Distribución Geométrica ===\n")

## === Parámetros Distribución Geométrica ===

cat("p̂ estimado (1/x̄)    :", round(p_hat, 6), "\n")

## p̂ estimado (1/x̄)    : 0.01194

cat("Media teórica E[X]   :", round(media_teo, 4), "\n")

## Media teórica E[X]   : 83.75

cat("Varianza teórica V[X]:", round(var_teo, 4), "\n")

## Varianza teórica V[X]: 6930.312

cat("Total de observaciones (n):", n, "\n")

## Total de observaciones (n): 40

6 Realidad Sobreuesta con el Modelo — Diagrama de Barras

En variables discretas la probabilidad de cada intervalo es la altura de la barra; la suma de todas las alturas es exactamente 1. Se compara la distribución observada con las probabilidades teóricas del modelo Geométrico.

6.1 Tabla de Frecuencias Observadas y Esperadas

tabla_frec %>%
  mutate(
    P_teorica   = sprintf("%.4f", P_teorica),
    P_observada = sprintf("%.4f", P_observada),
    Esperada    = sprintf("%.2f", Esperada)
  ) %>%
  select(-MC) %>%
  rename(
    "Intervalo"               = Intervalo,
    "Frec. Observada (Oi)"    = Observada,
    "Frec. Esperada (Ei)"     = Esperada,
    "P teórica (Geométrica)"  = P_teorica,
    "P observada"             = P_observada
  ) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°2: Frecuencias Observadas y Esperadas**"),
    subtitle = md(paste0("*Modelo: Geométrica (p̂ = ", round(p_hat, 6), ") — Código de Condado*"))
  ) %>%
  cols_label(
    "Intervalo"               = md("**Intervalo**"),
    "Frec. Observada (Oi)"    = md("**Frec. Observada (Oi)**"),
    "Frec. Esperada (Ei)"     = md("**Frec. Esperada (Ei)**"),
    "P teórica (Geométrica)"  = md("**P teórica (Geométrica)**"),
    "P observada"             = md("**P observada**")
  ) %>%
  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(85), heading.title.font.size = px(15),
              heading.subtitle.font.size = px(12), table.font.size = px(13),
              data_row.padding = px(6))

Tabla N°2: Frecuencias Observadas y Esperadas
Modelo: Geométrica (p̂ = 0.01194) — Código de Condado
Intervalo	Frec. Observada (Oi)	Frec. Esperada (Ei)	P teórica (Geométrica)	P observada
[7 – 25.8)	8	9.10	0.2276	0.2000
[25.8 – 44.6)	5	7.25	0.1811	0.1250
[44.6 – 63.4)	7	5.77	0.1442	0.1750
[63.4 – 82.2)	2	4.59	0.1147	0.0500
[82.2 – 101)	4	3.48	0.0870	0.1000
[101 – 119.8)	1	2.94	0.0736	0.0250
[119.8 – 138.6)	5	2.34	0.0586	0.1250
[138.6 – 157.4)	1	1.86	0.0466	0.0250
[157.4 – 176.2)	2	1.48	0.0371	0.0500
[176.2 – 195]	5	1.18	0.0295	0.1250
Autor: Leslye Quinchiguango

6.2 Gráfica N°1 — Diagrama de Barras: Realidad y Modelo

par(mar = c(9, 6, 5, 2))

obs_vals <- tabla_frec$Observada
esp_vals <- tabla_frec$Esperada

barplot(
  rbind(obs_vals, esp_vals),
  beside    = TRUE,
  col       = c("gray30", "gray75"),
  names.arg = etiq_intervalo,
  ylim      = c(0, max(c(obs_vals, esp_vals)) * 1.35),
  las       = 2, cex.names = 0.75, main = ""
)

mtext("Frecuencia", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Código de Condado", side = 1, line = 7.5, cex = 1)
mtext(paste0("Gráfica N°1: Frecuencias Observadas y Esperadas — Geométrica(p̂ = ",
             round(p_hat, 4), ") — Código de Condado"),
      side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)

legend("topright",
       legend = c("Observada", paste0("Esperada Geométrica(p̂ = ", round(p_hat, 4), ")")),
       fill   = c("gray30", "gray75"), bty = "n", cex = 0.85)

6.3 Gráfica N°2 — Probabilidades Observadas y Teóricas

par(mar = c(9, 6, 5, 2))

barplot(
  rbind(tabla_frec$P_observada, tabla_frec$P_teorica),
  beside    = TRUE,
  col       = c("gray30", "gray75"),
  names.arg = etiq_intervalo,
  ylim      = c(0, max(c(tabla_frec$P_observada, tabla_frec$P_teorica)) * 1.45),
  las       = 2, cex.names = 0.75, main = ""
)

mtext("Probabilidad", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Código de Condado", side = 1, line = 7.5, cex = 1)
mtext(paste0("Gráfica N°2: Probabilidades Observadas y Teóricas — Geométrica(p̂ = ",
             round(p_hat, 4), ") — Código de Condado"),
      side = 3, line = 2, adj = 0.5, cex = 0.85, font = 2)

legend("topright",
       legend = c("P observada", "P teórica Geométrica"),
       fill   = c("gray30", "gray75"), bty = "n", cex = 0.85)

7 Prueba de Hipótesis — Bondad de Ajuste Chi-Cuadrado

7.1 Planteamiento de Hipótesis

\[H_0: \text{La variable Código de Condado sigue una distribución Geométrica}(\hat{p})\] \[H_1: \text{La variable Código de Condado NO sigue una distribución Geométrica}\]

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

7.2 Estadístico de Prueba

\[\chi^2 = \sum_{i=1}^{k^*} \frac{(O_i - E_i)^2}{E_i}\]

Al estimar 1 parámetro (\(p\)) a partir de los datos:

\[gl = k^* - 1 - 1\]

obs_test <- tabla_frec$Observada
esp_test <- tabla_frec$Esperada

while (any(esp_test < 5) && length(esp_test) > 2) {
  idx_min <- which.min(esp_test)
  if (idx_min == 1) {
    obs_test[2] <- obs_test[2]+obs_test[1]; esp_test[2] <- esp_test[2]+esp_test[1]
    obs_test <- obs_test[-1]; esp_test <- esp_test[-1]
  } else {
    obs_test[idx_min-1] <- obs_test[idx_min-1]+obs_test[idx_min]
    esp_test[idx_min-1] <- esp_test[idx_min-1]+esp_test[idx_min]
    obs_test <- obs_test[-idx_min]; esp_test <- esp_test[-idx_min]
  }
}

k_efectivo  <- length(obs_test)
gl          <- max(k_efectivo - 1 - 1, 1)
chi_stat    <- sum((obs_test - esp_test)^2 / esp_test)
p_valor     <- pchisq(chi_stat, df = gl, lower.tail = FALSE)
chi_critico <- qchisq(0.95, df = gl)

cat("=== Prueba Chi-Cuadrado de Bondad de Ajuste ===\n")

## === Prueba Chi-Cuadrado de Bondad de Ajuste ===

cat("Clases efectivas tras fusión (k*):", k_efectivo, "\n")

## Clases efectivas tras fusión (k*): 5

cat("Estadístico Chi² calculado        :", round(chi_stat, 6), "\n")

## Estadístico Chi² calculado        : 6.787334

cat("Grados de libertad (gl = k*-1-1) :", gl, "\n")

## Grados de libertad (gl = k*-1-1) : 3

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

## Valor p                           : 7.899e-02

cat("Valor crítico χ²(0.95,", gl, ")  :", round(chi_critico, 4), "\n")

## Valor crítico χ²(0.95, 3 )  : 7.8147

if (p_valor > 0.05) {
  cat("\nDECISIÓN: No se rechaza H₀.\n")
  cat("CONCLUSIÓN: Los datos se ajustan a una distribución Geométrica (α = 0.05).\n")
} else {
  cat("\nDECISIÓN: Se rechaza H₀.\n")
  cat("CONCLUSIÓN: Los datos NO se ajustan a una distribución Geométrica (α = 0.05).\n")
}

## 
## DECISIÓN: No se rechaza H₀.
## CONCLUSIÓN: Los datos se ajustan a una distribución Geométrica (α = 0.05).

7.3 Tabla de Resultados de la Prueba

data.frame(
  Variable          = "Código de Condado",
  Test_Pearson      = round((1 - p_valor) * 100, 2),
  Chi_Cuadrado      = round(chi_stat, 4),
  Umbral_Aceptacion = round(chi_critico, 2),
  Resultado_Final   = ifelse(p_valor > 0.05, "Modelo Aceptado", "Modelo Rechazado")
) %>%
  gt() %>%
  tab_header(title = md("**TABLA N°3: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (GEOMÉTRICA)**")) %>%
  cols_label(
    Variable          = md("**Variable**"),
    Test_Pearson      = md("**Test Pearson (%)**"),
    Chi_Cuadrado      = md("**Chi Cuadrado**"),
    Umbral_Aceptacion = md("**Umbral de Aceptación**"),
    Resultado_Final   = md("**Resultado Final**")
  ) %>%
  tab_style(style = list(cell_fill(color = "#2C2C2C"), cell_text(color = "white", weight = "bold")),
            locations = cells_column_labels()) %>%
  tab_style(style = list(cell_fill(color = "#2C2C2C"), cell_text(color = "white", weight = "bold", align = "center")),
            locations = cells_title()) %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(table.width = pct(85), heading.title.font.size = px(14),
              table.font.size = px(13), data_row.padding = px(8))

TABLA N°3: RESUMEN DEL TEST DE BONDAD AL MODELO DE PROBABILIDAD (GEOMÉTRICA)
Variable	Test Pearson (%)	Chi Cuadrado	Umbral de Aceptación	Resultado Final
Código de Condado	92.1	6.7873	7.81	Modelo Aceptado
Autor: Leslye Quinchiguango

8 Cálculo de Probabilidades

Con el parámetro estimado \(\hat{p} = 0.01194\), se calculan probabilidades de interés bajo el modelo Geométrico.

# P(X = 1): primer condado activo es el de código más bajo
p_x1 <- dgeom(0, prob = p_hat)

# P(X ≤ mediana muestral)
med_cc <- median(x)
p_hasta_mediana <- pgeom(floor(med_cc) - 1, prob = p_hat)

# P(X > media teórica)
p_supera_media <- 1 - pgeom(floor(media_teo) - 1, prob = p_hat)

# P(X en intervalo central)
idx_centro <- ceiling(k_int / 2)
p_centro   <- prob_intervalo_geometrica(lim_inf[idx_centro], lim_sup[idx_centro], p_hat)

cat("=== Cálculo de Probabilidades bajo Geométrica(p̂ =", round(p_hat, 6), ") ===\n\n")

## === Cálculo de Probabilidades bajo Geométrica(p̂ = 0.01194 ) ===

cat("P(X = 1) [primer éxito en código 1]          =", round(p_x1, 4), "\n")

## P(X = 1) [primer éxito en código 1]          = 0.0119

cat("P(X ≤", floor(med_cc), ") [hasta mediana muestral]   =", round(p_hasta_mediana, 4), "\n")

## P(X ≤ 62 ) [hasta mediana muestral]   = 0.5251

cat("P(X >", floor(media_teo), ") [supera media teórica]     =", round(p_supera_media, 4), "\n")

## P(X > 83 ) [supera media teórica]     = 0.369

cat("P(X ∈", etiq_intervalo[idx_centro], ") [intervalo central] =", round(p_centro, 4), "\n")

## P(X ∈ [82.2 – 101) ) [intervalo central] = 1

data.frame(
  Evento = c(
    "P(X = 1)",
    paste0("P(X ≤ ", floor(med_cc), ")"),
    paste0("P(X > ", floor(media_teo), ")"),
    paste0("P(X ∈ ", etiq_intervalo[idx_centro], ")")
  ),
  Descripcion = c(
    "Primer arrendamiento en código de condado 1",
    "Código de condado no supera la mediana muestral",
    "Código de condado supera la media teórica",
    "Código de condado en el intervalo central"
  ),
  Probabilidad = round(c(p_x1, p_hasta_mediana, p_supera_media, p_centro), 4)
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°4: Cálculo de Probabilidades**"),
    subtitle = md(paste0("*Modelo Geométrica(p̂ = ", round(p_hat, 6), ") — Código de Condado*"))
  ) %>%
  cols_label(
    Evento       = md("**Evento**"),
    Descripcion  = md("**Descripción**"),
    Probabilidad = md("**Probabilidad**")
  ) %>%
  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, 4, by = 2))) %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(table.width = pct(88), heading.title.font.size = px(15),
              heading.subtitle.font.size = px(12), table.font.size = px(13),
              data_row.padding = px(6))

Tabla N°4: Cálculo de Probabilidades
Modelo Geométrica(p̂ = 0.01194) — Código de Condado
Evento	Descripción	Probabilidad
P(X = 1)	Primer arrendamiento en código de condado 1	0.0119
P(X ≤ 62)	Código de condado no supera la mediana muestral	0.5251
P(X > 83)	Código de condado supera la media teórica	0.3690
P(X ∈ [82.2 – 101))	Código de condado en el intervalo central	1.0000
Autor: Leslye Quinchiguango

9 Intervalos de Confianza 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 <- tabla_frec %>%
  mutate(
    p_obs  = Observada / n,
    error  = z * sqrt((p_obs * (1 - p_obs)) / n),
    IC_inf = round(pmax(p_obs - error, 0), 4),
    IC_sup = round(pmin(p_obs + error, 1), 4),
    p_obs  = round(p_obs, 4)
  ) %>%
  select(Intervalo, Observada, p_obs, IC_inf, IC_sup)

tabla_ic %>%
  rename(
    "Intervalo"       = Intervalo,
    "Frec. Obs."      = Observada,
    "p̂ observada"    = p_obs,
    "IC Inferior 95%" = IC_inf,
    "IC Superior 95%" = IC_sup
  ) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°5: Intervalos de Confianza al 95%**"),
    subtitle = md("*Proporción por intervalo de clase — Código de Condado*")
  ) %>%
  cols_label(
    "Intervalo"       = md("**Intervalo**"),
    "Frec. Obs."      = md("**Frec. Obs.**"),
    "p̂ observada"    = md("**p̂ observada**"),
    "IC Inferior 95%" = md("**IC Inferior 95%**"),
    "IC Superior 95%" = md("**IC Superior 95%**")
  ) %>%
  tab_style(style = list(cell_fill(color = "#2C2C2C"), cell_text(color = "white", weight = "bold")),
            locations = cells_column_labels()) %>%
  tab_style(style = cell_fill(color = "#F5F5F5"),
            locations = cells_body(rows = seq(1, nrow(tabla_ic), by = 2))) %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(table.width = pct(82), heading.title.font.size = px(15),
              heading.subtitle.font.size = px(12), table.font.size = px(13),
              data_row.padding = px(6))

Tabla N°5: Intervalos de Confianza al 95%
Proporción por intervalo de clase — Código de Condado
Intervalo	Frec. Obs.	p̂ observada	IC Inferior 95%	IC Superior 95%
[7 – 25.8)	8	0.200	0.0760	0.3240
[25.8 – 44.6)	5	0.125	0.0225	0.2275
[44.6 – 63.4)	7	0.175	0.0572	0.2928
[63.4 – 82.2)	2	0.050	0.0000	0.1175
[82.2 – 101)	4	0.100	0.0070	0.1930
[101 – 119.8)	1	0.025	0.0000	0.0734
[119.8 – 138.6)	5	0.125	0.0225	0.2275
[138.6 – 157.4)	1	0.025	0.0000	0.0734
[157.4 – 176.2)	2	0.050	0.0000	0.1175
[176.2 – 195]	5	0.125	0.0225	0.2275
Autor: Leslye Quinchiguango

Gráfica N°3 — Intervalos de Confianza al 95%

par(mar = c(9, 6, 5, 2))

p_obs  <- tabla_ic$p_obs
ic_inf <- tabla_ic$IC_inf
ic_sup <- tabla_ic$IC_sup
p_teo  <- tabla_frec$P_teorica

bp3 <- barplot(
  p_obs,
  col       = gray(seq(0.25, 0.80, length.out = k_int)),
  names.arg = etiq_intervalo,
  ylim      = c(0, max(ic_sup) * 1.45),
  las       = 2, cex.names = 0.75, main = ""
)

arrows(x0 = bp3, y0 = ic_inf, x1 = bp3, y1 = ic_sup,
       angle = 90, code = 3, length = 0.06, lwd = 1.5)
points(bp3, p_teo, pch = 18, col = "black", cex = 1.2)
lines(bp3, p_teo, col = "black", lty = 2, lwd = 1.5)

mtext("Proporción", side = 2, line = 4.5, cex = 1)
mtext("Intervalo de Código de Condado", side = 1, line = 7.5, cex = 1)
mtext("Gráfica N°3: Intervalos de Confianza al 95% por Intervalo de Clase — Código de Condado",
      side = 3, line = 2, adj = 0.5, cex = 0.85, 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)

10 Tabla de Indicadores Inferenciales

ic_strings <- sprintf("[%.4f ; %.4f]", tabla_ic$IC_inf, tabla_ic$IC_sup)
nombres_ic <- paste0("IC 95% — ", etiq_intervalo)

data.frame(
  Indicador = c(
    "Variable", "Tipo de variable", "Modelo probabilístico",
    "Parámetro p̂ estimado (1/x̄)",
    "Media teórica E[X] = 1/p̂",
    "Varianza teórica V[X] = (1-p̂)/p̂²",
    "Estadístico χ² calculado",
    paste0("Grados de libertad (k* - 1 - 1 = ", k_efectivo, " - 2)"),
    "Valor p",
    paste0("Valor crítico χ²(0.95, ", gl, ")"),
    "Nivel de significancia (α)", "Decisión sobre H₀",
    nombres_ic
  ),
  Valor = c(
    "Código de Condado", "Cuantitativa Discreta Agrupada", "Geométrica",
    sprintf("%.6f", p_hat),
    sprintf("%.4f", media_teo),
    sprintf("%.4f", var_teo),
    sprintf("%.6f", chi_stat),
    as.character(gl),
    format(p_valor, scientific = TRUE, digits = 4),
    sprintf("%.4f", chi_critico),
    "0.05",
    ifelse(p_valor > 0.05, "No se rechaza H₀", "Se rechaza H₀"),
    ic_strings
  )
) %>%
  gt() %>%
  tab_header(
    title    = md("**Tabla N°6: Indicadores Inferenciales**"),
    subtitle = md("*Variable Cuantitativa Discreta: Código de Condado*")
  ) %>%
  cols_label(Indicador = md("**Indicador**"), Valor = md("**Valor**")) %>%
  tab_style(style = list(cell_fill(color = "#2C2C2C"), cell_text(color = "white", weight = "bold")),
            locations = cells_column_labels()) %>%
  tab_style(style = cell_fill(color = "#F5F5F5"),
            locations = cells_body(rows = seq(1, 12 + k_int, by = 2))) %>%
  tab_style(style = list(cell_fill(color = "#D6D6D6"), cell_text(weight = "bold")),
            locations = cells_body(rows = Indicador == "Decisión sobre H₀", columns = everything())) %>%
  tab_source_note(source_note = md("*Autor: Leslye Quinchiguango*")) %>%
  tab_options(table.width = pct(78), heading.title.font.size = px(15),
              heading.subtitle.font.size = px(12), table.font.size = px(13),
              data_row.padding = px(6))

Tabla N°6: Indicadores Inferenciales
Variable Cuantitativa Discreta: Código de Condado
Indicador	Valor
Variable	Código de Condado
Tipo de variable	Cuantitativa Discreta Agrupada
Modelo probabilístico	Geométrica
Parámetro p̂ estimado (1/x̄)	0.011940
Media teórica E[X] = 1/p̂	83.7500
Varianza teórica V[X] = (1-p̂)/p̂²	6930.3125
Estadístico χ² calculado	6.787334
Grados de libertad (k* - 1 - 1 = 5 - 2)	3
Valor p	7.899e-02
Valor crítico χ²(0.95, 3)	7.8147
Nivel de significancia (α)	0.05
Decisión sobre H₀	No se rechaza H₀
IC 95% — [7 – 25.8)	[0.0760 ; 0.3240]
IC 95% — [25.8 – 44.6)	[0.0225 ; 0.2275]
IC 95% — [44.6 – 63.4)	[0.0572 ; 0.2928]
IC 95% — [63.4 – 82.2)	[0.0000 ; 0.1175]
IC 95% — [82.2 – 101)	[0.0070 ; 0.1930]
IC 95% — [101 – 119.8)	[0.0000 ; 0.0734]
IC 95% — [119.8 – 138.6)	[0.0225 ; 0.2275]
IC 95% — [138.6 – 157.4)	[0.0000 ; 0.0734]
IC 95% — [157.4 – 176.2)	[0.0000 ; 0.1175]
IC 95% — [176.2 – 195]	[0.0225 ; 0.2275]
Autor: Leslye Quinchiguango

11 Conclusiones

La variable Código de Condado fue modelada bajo una distribución Geométrica con parámetro \(\hat{p} = 0.01194\), estimado por máxima verosimilitud como \(\hat{p} = 1/\bar{x}\) a partir de una muestra aleatoria de \(n = 40\) observaciones. La distribución Geométrica resulta adecuada porque la variable expresa una posición discreta entera positiva cuya frecuencia decrece progresivamente, de forma análoga al número de ensayos hasta el primer éxito. La prueba Chi-Cuadrado de bondad de ajuste arrojó un estadístico \(\chi^2 = 6.7873\) con \(gl = 3\) y un valor \(p = 7.899e-02\), por lo que con un nivel de significancia \(\alpha = 0.05\), no se rechaza H₀: los datos son consistentes con el modelo Geométrico propuesto, lo que indica que la distribución de arrendamientos entre los códigos de condado sigue un decaimiento geométrico, concentrándose proporcionalmente más en los códigos de menor valor. Los intervalos de confianza al 95% complementan el análisis al comparar las proporciones observadas con las probabilidades teóricas del modelo.

---

Autor: Leslye Quinchiguango