# Variable Discreta
#Fecha
#Autor: Ariana Viteri
#Fecha:04/087/2026

0.- Carga de Librerías

library(gt)

## Warning: package 'gt' was built under R version 4.5.3

library(dplyr)

## Warning: package 'dplyr' was built under R version 4.5.3

## 
## Adjuntando el paquete: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(e1071)

## Warning: package 'e1071' was built under R version 4.5.3

1.- Carga de Datos

# 1. CARGA DE DATOS
TDFDate <-read.csv("~/semestre 3 y 4/Estadistica/Datos Cambiados.csv",
                     header = TRUE, dec = ".", sep = ",")

2.- Seleccionar variable

# 2. SELECCIONAR LA VARIABLE

# Preparación de Datos: Convertir a formato de fecha R
TDFDate$Date_Convertida <- as.Date(TDFDate$Date, format = "%d/%m/%Y")

# Agrupación por Año:
grupos_Anio <- format(TDFDate$Date_Convertida, format = "%Y")
grupos_Anio_limpio <- grupos_Anio[!is.na(grupos_Anio)]

3.- Frecuencias

# 3. FRECUENCIAS
tabla_frecuencia <- as.data.frame(table(grupos_Anio_limpio))

# AQUI AÑADIMOS LA JERARQUÍA DESCENDENTE (2020 → 2015)
tabla_frecuencia <- tabla_frecuencia[order(-as.numeric(as.character(tabla_frecuencia$grupos_Anio_limpio))), ]

# Asignación de Variables
Anio <- tabla_frecuencia$grupos_Anio_limpio
ni <- tabla_frecuencia$Freq            

# Cálculos Derivados (Frecuencias relativas y acumuladas)
hi <- ni / sum(ni) * 100

# 4. TABLA DE DISTRIBUCIÓN DE FRECUENCIAS
TDFAnioFin <- data.frame(Anio, ni, hi)

# --- INCLUSIÓN DE LA FILA TOTAL ---
total_ni <- sum(ni)
total_hi <- sum(hi) 

# CREACIÓN DE TDFAnioCompleto (La variable que gt necesita)
TDFAnioCompleto <- rbind(TDFAnioFin, 
                         data.frame(Anio = "Total",
                                    ni = total_ni, 
                                    hi = total_hi))


# Limpiar nombres de columnas (esto suele causar problemas con GT/Markdown)
colnames(TDFAnioCompleto) <- c("Anio", "ni ", "hi (%)")

# Asegurar que las columnas sean de tipo character/numeric para gt
TDFAnioCompleto$Anio <- as.character(TDFAnioCompleto$Anio)
TDFAnioCompleto$`hi (%)` <- round(TDFAnioCompleto$`hi (%)`, 2) # Redondear porcentajes

4.- Tabla distribución de frecuencia

library(gt)
library(dplyr)
TDFAnioCompleto %>%
  gt() %>%
  cols_label(
    Anio = "Año",
    `ni ` = "ni",
    `hi (%)` = "hi (%)"
  ) %>%
  tab_header(
    title = md("Tabla Nro. 1"),
    subtitle = md("Distribución de registros por año en el estudio de calidad del aire en India (2015-2020)")
  ) %>%
  tab_source_note(
    source_note = md("Fuente: Datos procesados por el autor a partir de archivo city.day.csv")
  ) %>%
  tab_style(
    style = cell_borders(sides = "left", color = "black", weight = px(2)),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_borders(sides = "right", color = "black", weight = px(2)),
    locations = cells_body()
  ) %>%
  tab_style(
    style = cell_borders(sides = "left", color = "black", weight = px(2)),
    locations = cells_column_labels()
  ) %>%
  tab_style(
    style = cell_borders(sides = "right", color = "black", weight = px(2)),
    locations = cells_column_labels()
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    row.striping.include_table_body = TRUE,
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black"
  )

Año	ni	hi (%)
Tabla Nro. 1
Distribución de registros por año en el estudio de calidad del aire en India (2015-2020)
2020	4646	15.73
2019	7446	25.21
2018	6471	21.91
2017	4689	15.88
2016	3478	11.78
2015	2801	9.48
Total	29531	100.00
Fuente: Datos procesados por el autor a partir de archivo city.day.csv

4.1 Diagrama porcentaje

#Histograma de Barras de porcentaje local 3
library(RColorBrewer)

# Número de barras
n <- length(TDFAnioFin$Anio)

# Paleta de colores verde pastel
colores <- colorRampPalette(brewer.pal(9, 'Greens'))(n)

# Porcentaje local (frecuencia relativa)
hi_local <- TDFAnioFin$hi

# Calcular límite Y automático (máximo porcentaje local + 10% para margen)
ylim_local <- c(0, max(hi_local) * 1.1)

## 5.3 DIAGRAMA LOCAL PORCENTUAL
# Gráfico de barras de porcentaje local
barplot(
  height = hi_local,               # frecuencia relativa local
  names.arg = TDFAnioFin$Anio,
  main = "Gráfica Nro 3: Distribución porcentual de la muestra por año en India (2015-2020)",
  xlab = "Año",
  ylab = "Porcentaje",
  col = colores,                   # aplica el verde pastel
  ylim = ylim_local,               # eje Y adaptado al máximo porcentaje local
  las = 1,                          # nombres de eje X horizontales
  cex.names = 0.8,                  # tamaño de nombres
  cex.main = 0.9,                   # tamaño del título
  mgp = c(3, 1, 0)                # posición de títulos y labels
)

5.- Conjetura

Conjetura

A partir de la gráfica se observa que la mayor concentración de los datos se encuentra en los años centrales, especialmente entre 2018 y 2019, mientras que hacia los extremos (2015 y 2020) los porcentajes disminuyen. Esta distribución muestra un único pico y una reducción gradual de la frecuencia a medida que se aleja del centro, lo que sugiere un comportamiento aproximadamente unimodal y con ligera asimetría. Por ello, se puede conjeturar que los datos presentan un comportamiento compatible con una distribución de Poisson, en la que la mayor probabilidad de ocurrencia se concentra alrededor de un valor medio y decrece hacia los extremos.

6.- Modelo Poisson

#=========================
# MODELO DE POISSON
#=========================

# A. Cálculo del parámetro lambda
# Se utilizan los mismos valores discretos
x_mapped <- 0:5

# Probabilidades observadas (en decimales)
p_s_data <- hi / 100

# Esperanza matemática (λ de Poisson)
lambda <- sum(x_mapped * p_s_data)

# B. Probabilidades teóricas del modelo Poisson

# Primeros cinco valores
esperada_poisson <- dpois(0:4, lambda = lambda)

# Última categoría como cola
esperada_cola <- 1 - ppois(4, lambda = lambda)

# Probabilidades en porcentaje
hi_poisson <- c(esperada_poisson, esperada_cola) * 100

#=========================
# COMPARACIÓN
#=========================

datos_poisson <- rbind(
  Realidad = hi,
  `Modelo Poisson` = hi_poisson
)

#=========================
# GRÁFICA
#=========================

par(mar = c(6.1,4.1,4.1,2.1))

grafica_comp <- barplot(
  datos_poisson,
  beside = TRUE,
  names.arg = Anio,
  col = c("blue","red"),
  main = "Gráfica N° 4: Comparación de la Realidad con el Modelo de Poisson\nDistribución de registros por año en India (2015-2020)",
  xlab = "Año",
  ylab = "Porcentaje ",
  ylim = c(0,max(datos_poisson)*1.35),
  las = 1,
  cex.names = 0.85
)

# Cuadrícula
abline(h = pretty(c(0,max(datos_poisson))), col = "gray80", lty = 2)

# Repintar barras
barplot(
  datos_poisson,
  beside = TRUE,
  col = c("blue","red"),
  add = TRUE,
  axes = FALSE,
  names.arg = rep("",6)
)

# Leyenda
legend(
  "top",
  legend = c("Realidad","Modelo Poisson"),
  fill = c("blue","red"),
  bty = "n",
  horiz = TRUE,
  inset = c(0,0),
  cex = 0.9
)
box()

7.- Test de bondad

#==========================================
#TEST DE BONDAD DE AJUSTE
#==========================================

#==========================================
# TEST DE PEARSON
#==========================================

# Probabilidades teóricas del modelo de Poisson (en decimal)
P_teorica <- hi_poisson / 100

# Frecuencias observadas
fo_pearson <- ni

# Frecuencias esperadas
N <- sum(ni)
fe_pearson <- N * P_teorica

# Coeficiente de Pearson
Coef_Pearson <- cor(fo_pearson, fe_pearson) * 100

cat("Coeficiente de Pearson (%):",
    round(Coef_Pearson,2), "\n")

## Coeficiente de Pearson (%): 94.27

#==========================================
# TEST CHI-CUADRADO
#==========================================

# Total de observaciones
N_chi <- sum(ni)

# Frecuencias relativas observadas
fo <- ni / N_chi

# Probabilidades esperadas
fe <- P_teorica

# Número de categorías
k <- length(fo)

# Estadístico Chi-cuadrado
Chi_Calculado <- sum((fo - fe)^2 / fe)

# Grados de libertad
gl <- k - 1

# Valor crítico para α = 0.05
Chi_Critico <- qchisq(0.95, df = gl)

# Resultados
cat("\nChi Calculado:",
    round(Chi_Calculado,4), "\n")

## 
## Chi Calculado: 0.0443

cat("Chi Crítico:",
    round(Chi_Critico,4), "\n")

## Chi Crítico: 11.0705

# Decisión
if (Chi_Calculado < Chi_Critico) {
  cat("\nNo se rechaza H0: El modelo de Poisson es adecuado.\n")
} else {
  cat("\nSe rechaza H0: El modelo de Poisson no es adecuado.\n")
}

## 
## No se rechaza H0: El modelo de Poisson es adecuado.

8.- Cálculo de probabilidad

# A. Cálculo de la probabilidad (Años 2015 a 2020)
# ¿Cuál es la probabilidad de que un registro corresponda a un año mayor o igual a 2018?

prob_2018_o_mas <- 1 - ppois(2, lambda)
# (2015=0, 2016=1, 2017=2, 2018=3...)

cat("Probabilidad de año mayor o igual a 2018:",
    round(prob_2018_o_mas * 100, 2), "%\n")

## Probabilidad de año mayor o igual a 2018: 35.36 %

9 .- Intervalo de Confianza

#==========================================
# INTERVALO DE CONFIANZA
#==========================================

# Extraer el año como valor numérico
Anios <- as.numeric(format(TDFDate$Date_Convertida, "%Y"))

# Eliminar valores NA
Anios <- Anios[!is.na(Anios)]

# Media, desviación estándar y tamaño de muestra
media_anio <- mean(Anios)
desviacion_anio <- sd(Anios)
n_anio <- length(Anios)

# Nivel de confianza del 95%
error_anio <- 1.96 * (desviacion_anio / sqrt(n_anio))

# Redondear a 0 decimales por ser una variable discreta
limite_inferior <- round(media_anio - error_anio, 0)
limite_superior <- round(media_anio + error_anio, 0)

# Crear tabla
tabla_intervalo <- data.frame(
  Intervalo = paste0("P [", limite_inferior,
                     " < µ < ",
                     limite_superior,
                     "] = 95%")
)

# Mostrar tabla
tabla_intervalo %>%
  gt() %>%
  tab_header(
    title = md("**Tabla Nro. 2**"),
    subtitle = md("**Intervalo de confianza de los registros por año en el estudio de calidad del aire en India (2015-2020)**")
  ) %>%
  tab_source_note(
    source_note = md("Fuente: Datos procesados por el autor a partir del archivo city.day.csv")
  ) %>%
  tab_options(
    table.border.top.color = "black",
    table.border.bottom.color = "black",
    table.border.top.style = "solid",
    table.border.bottom.style = "solid",
    column_labels.border.top.color = "black",
    column_labels.border.bottom.color = "black",
    column_labels.border.bottom.width = px(2),
    row.striping.include_table_body = TRUE,
    heading.border.bottom.color = "black",
    heading.border.bottom.width = px(2),
    table_body.hlines.color = "gray",
    table_body.border.bottom.color = "black",
    table.border.left.color = "black",
    table.border.left.style = "solid",
    table.border.left.width = px(1),
    table.border.right.color = "black",
    table.border.right.style = "solid",
    table.border.right.width = px(1)
  )

Intervalo
Tabla Nro. 2
Intervalo de confianza de los registros por año en el estudio de calidad del aire en India (2015-2020)
P [2018 < µ < 2018] = 95%
Fuente: Datos procesados por el autor a partir del archivo city.day.csv

10.-Conclusión

En conclusión:

El análisis de la distribución de registros por año revela que la distribución de los datos se ajusta a un modelo de Poisson λ = 2.112, validado matemáticamente mediante la prueba de Pearson (94.27%). Con un nivel de confianza del 95%, se estima que el promedio real de los registros por año se sitúa alrededor del año 2018. Aunque existe una probabilidad de registrar observaciones correspondientes a los años 2019 y 2020 de acuerdo con el modelo de Poisson, la gráfica demuestra una mayor concentración de registros en los años centrales, indicando que la distribución de la muestra se concentra principalmente entre 2018 y 2019 durante el periodo estudiado (2015–2020).

Estadística Descriptiva

Grupo 1

2026-06-11