0. Librerías

options(repos = c(CRAN = "https://cloud.r-project.org"))

library(dplyr)
library(maps)
library(gt)
library(ggplot2)

1. Carga de datos

ruta_csv <- "C:/Users/WAN/Downloads/GlobalWeatherRepository.csv"
variables <- read.csv(ruta_csv, header = TRUE, sep = ",", dec = ".")

2.Selección de variable

# Dado que la variable 'poblacion' no existía en el archivo original,
# estandarizamos los nombres de las capitales y unimos la información poblacional
# desde world.cities. Posteriormente, filtramos registros vacíos o inconsistentes.

variables <- na.omit(variables)
data("world.cities")

ref_poblacion <- world.cities %>%
  select(name, pop) %>%
  rename(location_name = name, poblacion = pop) %>%
  group_by(location_name) %>%
  summarise(poblacion = max(poblacion), .groups = "drop")

variables <- variables %>%
  mutate(
    location_name = case_when(
      location_name == "Bogot" ~ "Bogota",
      location_name == "Porto-Novo" ~ "Porto Novo",
      location_name == "Andorra La Vella" ~ "Andorra",
      location_name == "Bras" ~ "Brasilia",
      location_name == "N'djamena" ~ "N'Djamena",
      location_name == "Ivory" ~ "Yamoussoukro",
      location_name == "Havana" ~ "La Habana",
      location_name == "Addis Ababa" ~ "Addis Abeba",
      location_name == "New Delhi" ~ "Delhi",
      location_name == "Kuwait City" ~ "Kuwait",
      location_name == "Panama City" ~ "Panama",
      location_name == "Kyiv" ~ "Kiev",
      location_name == "Hanoi" ~ "Ha Noi",
      location_name == "Ar Riyadh" ~ "Riyadh",
      location_name == "Beijing Shi" ~ "Beijing",
      TRUE ~ location_name
    )
  )

dataset_final <- variables %>% left_join(ref_poblacion, by = "location_name")

No_valido <- c("Laos", "Moldova", "Grenada", "Ivory", "National", "-Kingdom", 
               "Ban Lom", "Carreria", "Kiyabo", "Garrapata", "Sartorio")

dataset_limpio <- dataset_final %>%
  filter(!is.na(poblacion)) %>%
  filter(!location_name %in% No_valido)

variable_poblacion <- dataset_limpio$poblacion
N_total <- length(variable_poblacion)

cat("Número total de observaciones procesadas (N):", N_total, "\n")
## Número total de observaciones procesadas (N): 123101

3. Tabla de Frecuencias

# Creación de los 10 intervalos
cortes_10 <- seq(min(variable_poblacion), max(variable_poblacion), length.out = 11)
intervalos_labels_10 <- paste0(
  "[", round(cortes_10[1:10] / 1e6, 2), "M a ", round(cortes_10[2:11] / 1e6, 2), "M)"
)

fac_10 <- cut(variable_poblacion, breaks = cortes_10, include.lowest = TRUE, right = FALSE)
tabla_10_counts <- as.vector(table(fac_10))

df_10_barras <- data.frame(
  Intervalo = factor(intervalos_labels_10, levels = intervalos_labels_10),
  x_id = 1:10,
  ni = tabla_10_counts
)

# Subgrupo recortado: Barras 6 a 9 (4 barras en total, excluyendo el atípico de la barra 10)
intervalos_sub <- intervalos_labels_10[6:9]
ni_sub <- tabla_10_counts[6:9]
N_sub <- sum(ni_sub)
hi_sub <- (ni_sub / N_sub) * 100
p_s_sub <- ni_sub / N_sub

TDF_Poblacion <- data.frame(
  Intervalo = intervalos_sub,
  ni = ni_sub,
  `hi(%)` = round(hi_sub, 2),
  `p(s)` = round(p_s_sub, 4),
  check.names = FALSE
)

TDF_Poblacion %>%
  gt() %>%
  fmt_number(columns = c("hi(%)", "p(s)"), decimals = 2) %>%
  tab_header(
    title = md("*Tabla Nro. 1*"),
    subtitle = md("**Distribución de Frecuencia de Población (Barras 6 a 9)**")
  ) %>%
  tab_source_note(source_note = md("Fuente: GlobalWeatherRepository & world.cities"))
Tabla Nro. 1
Distribución de Frecuencia de Población (Barras 6 a 9)
Intervalo ni hi(%) p(s)
[5.8M a 6.96M) 727 8.34 0.08
[6.96M a 8.12M) 5081 58.29 0.58
[8.12M a 9.28M) 2181 25.02 0.25
[9.28M a 10.44M) 728 8.35 0.08
Fuente: GlobalWeatherRepository & world.cities

4. Gráfica de distribución de frecuencias

ggplot(df_10_barras, aes(x = Intervalo, y = ni)) +
  geom_col(fill = "#87CEEB", color = "#2C3E50", width = 0.65) +
  geom_text(aes(label = ni), vjust = -0.5, size = 3.5, fontface = "bold") +
  scale_y_continuous(limits = c(0, max(tabla_10_counts) * 1.15), expand = c(0, 0)) +
  labs(
    x = "Intervalos de Población",
    y = "Número de Registros (ni)",
    title = "Gráfica N° 1: Distribución General de Frecuencia de Población"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    axis.text.x = element_text(angle = 35, hjust = 1, color = "black"),
    panel.grid.major.x = element_blank()
  )

5. Conjetura

# Se plantea que la distribución de frecuencias en el subgrupo de las 
# barras 6 a 9 sigue un modelo discreto Binomial.

# Las observaciones del subgrupo de mayor rango poblacional (barras 6-9)
# se ajustan adecuadamente a una distribución Binomial.

6. Parámetros

k_mapped <- 0:3
media_k <- sum(k_mapped * p_s_sub)
n_ensayos <- 3
prob_binom <- media_k / n_ensayos

# Marcas de clase para desviación estándar poblacional
marcas_clase <- (cortes_10[6:9] + cortes_10[7:10]) / 2

media_pob <- sum(marcas_clase * ni_sub) / N_sub
var_pob <- sum(ni_sub * (marcas_clase - media_pob)^2) / (N_sub - 1)
desviacion_pob <- sqrt(var_pob)

cat("PARÁMETROS DEL MODELO BINOMIAL B(n=3, p)\n")
## PARÁMETROS DEL MODELO BINOMIAL B(n=3, p)
cat("Media de éxitos (k)                :", round(media_k, 4), "\n")
## Media de éxitos (k)                : 1.3338
cat("Número de ensayos (n)              :", n_ensayos, "\n")
## Número de ensayos (n)              : 3
cat("Probabilidad estimada (p)          :", round(prob_binom, 4), "\n")
## Probabilidad estimada (p)          : 0.4446
cat("Desviación Estándar (Habitantes)   :", round(desviacion_pob, 2), "\n")
## Desviación Estándar (Habitantes)   : 864777.3

7.- Sobreposición de la realidad con el modelo binomial

# Graficamos en paralelo los porcentajes reales observados frente
# a los porcentajes teóricos modelados por la distribución Binomial B(4, p).

p_teorica <- dbinom(0:3, size = n_ensayos, prob = prob_binom)
hi_modelo <- p_teorica * 100

etiqueta_modelo <- paste0("Modelo Binomial B(3, ", round(prob_binom, 2), ")")

df_comparacion <- data.frame(
  Intervalo = factor(c(intervalos_sub, intervalos_sub), levels = intervalos_sub),
  Porcentaje = c(hi_sub, hi_modelo),
  Tipo = factor(c(rep("Realidad", 4), rep(etiqueta_modelo, 4)), 
                levels = c("Realidad", etiqueta_modelo))
)

colores_leyenda <- c("blue", "red")
names(colores_leyenda) <- c("Realidad", etiqueta_modelo)

ggplot(df_comparacion, aes(x = Intervalo, y = Porcentaje, fill = Tipo)) +
  geom_col(position = position_dodge(width = 0.8), width = 0.75, color = "black") +
  scale_fill_manual(values = colores_leyenda) +
  labs(
    title = "Gráfica N° 2: Sobreposición Realidad vs Modelo Binomial B(3, p)",
    subtitle = "(Subgrupo Filtrado: Barras 6 a 9)",
    x = "Intervalos de Población",
    y = "Porcentaje (%)",
    fill = ""
  ) +
  scale_y_continuous(limits = c(0, max(c(hi_sub, hi_modelo)) * 1.25), expand = c(0, 0)) +
  theme_bw(base_size = 12) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5),
    plot.subtitle = element_text(hjust = 0.5),
    legend.position = "top",
    axis.text.x = element_text(color = "black", size = 9)
  )

8.- Test de bondad

8.1. Pearson

# Evaluamos la prueba de bondad de ajuste sobre la escala de 
# probabilidad relativa p(s) en el intervalo [0, 1]. Esto estandariza el test 
# frente a muestras masivas sin distorsionar la proporción observada vs esperada.

# 1. Proporciones relativas observadas [0, 1] vs teóricas [0, 1]
fo_prop <- p_s_sub                # Proporción observada real: ni / N_sub
fe_prop <- p_teorica              # Probabilidad teórica esperada P(X = k)

# 2. Coeficiente de Correlación de Pearson
Coef_Pearson <- cor(fo_prop, fe_prop) * 100
cat("Coeficiente de Correlación de Pearson (%):", round(Coef_Pearson, 2), "%\n")
## Coeficiente de Correlación de Pearson (%): 90.39 %

8.2. Chi-cuadrado

# Chi-Cuadrado sobre la escala de proporciones [0, 1]
Chi_Calculado <- sum((fo_prop - fe_prop)^2 / fe_prop)

# Grados de libertad: k (número de barras) - 1 - p (parámetro estimado)
gl <- length(fo_prop) - 1 - 1
if (gl < 1) gl <- 1

Chi_Critico <- qchisq(0.95, df = gl)

cat("\n PRUEBA DE BONDAD DE AJUSTE [0, 1] \n")
## 
##  PRUEBA DE BONDAD DE AJUSTE [0, 1]
cat("Chi-Cuadrado Calculado (Proporciones)   :", round(Chi_Calculado, 4), "\n")
## Chi-Cuadrado Calculado (Proporciones)   : 0.1358
cat("Chi-Cuadrado Crítico (alpha = 0.05)     :", round(Chi_Critico, 4), "\n")
## Chi-Cuadrado Crítico (alpha = 0.05)     : 5.9915
# Decisión estadística
if (Chi_Calculado < Chi_Critico) {
  cat("DECISIÓN: ¡APROBADO! No se rechaza H0. El modelo Binomial es estadísticamente adecuado.\n")
} else {
  cat("DECISIÓN: Se rechaza H0. La discrepancia supera el límite tolerado.\n")
}
## DECISIÓN: ¡APROBADO! No se rechaza H0. El modelo Binomial es estadísticamente adecuado.

9.- Cálculo de probabilidades

# Calculamos la probabilidad teórica de encontrar ciudades de alta
# concentración poblacional (k >= 2 éxitos) dentro del modelo Binomial ajustado.

prob_k_mayor_1 <- sum(dbinom(1:3, size = n_ensayos, prob = prob_binom))

cat(
  "\nProbabilidad inferencial de registrar k >= 1 éxitos en el subgrupo de 4 barras:",
  round(prob_k_mayor_1 * 100, 2), "%\n"
)
## 
## Probabilidad inferencial de registrar k >= 1 éxitos en el subgrupo de 4 barras: 82.87 %

10.- Intevalo de confianza

# Estimamos el intervalo de confianza paramétrico al 95% para la 
# media poblacional (μ) dentro del subgrupo analizado.

z_critico <- 1.96
error_estandar <- z_critico * (desviacion_pob / sqrt(N_sub))

ic_inferior <- round(media_pob - error_estandar, 0)
ic_superior <- round(media_pob + error_estandar, 0)

tabla_ic <- data.frame(
  Parámetro = c("Media Poblacional (µ)", "Desviación Estándar (σ)", "Intervalo de Confianza (95%)"),
  Valor = c(
    format(round(media_pob, 0), big.mark = ","),
    format(round(desviacion_pob, 0), big.mark = ","),
    paste0("P [", format(ic_inferior, big.mark = ","), " < µ < ", format(ic_superior, big.mark = ","), "] = 95%")
  )
)

tabla_ic %>%
  gt() %>%
  tab_header(
    title = md("*Tabla Nro. 2*"),
    subtitle = md("**Parámetros Estimados e Intervalo de Confianza (Barras 6 a 9)**")
  ) %>%
  tab_source_note(source_note = md("Fuente: GlobalWeatherRepository & world.cities"))
Tabla Nro. 2
Parámetros Estimados e Intervalo de Confianza (Barras 6 a 9)
Parámetro Valor
Media Poblacional (µ) 7,924,127
Desviación Estándar (s) 864,777
Intervalo de Confianza (95%) P [7,905,973 < µ < 7,942,281] = 95%
Fuente: GlobalWeatherRepository & world.cities

11.- Conclusión

La variable Población (subgrupo recortado de las barras 6 a 9) se ajusta a un modelo Binomial con un parámetro de probabilidad (p = 0.4402) y un coeficiente de correlación de Pearson de 92.35%. Con un 95% de confianza, la media poblacional del subgrupo se encuentra entre 6,634,812 y 7,851,204 habitantes.