#UNIVERSIDAD CENTRAL DEL ECUADOR
#FACULTAD: FIGEMPA
#CARRERA: INGENIERIA AMBIENTAL
#AUTOR: KEVIN CHICAIZA
#TEMA DISCRETA
#VARIABLE: POBLACION POR REGIONES DE CHILE

#CARGAR DATOS#
library(readxl)
datos <- read_excel("C:/Estadistica/DatosTerritorialesPoblacion.xls")

#EXTRACCION DE DATOS#
poblaciones<-datos$Poblacion
length(poblaciones)

## [1] 16

##AGRUPACIONES POR INTERVALOS##
breaks <- seq(100000, 8600000, by = 500000)
labels <- paste(head(breaks, -1), tail(breaks, -1) - 1, sep = "-")
intervalospobl <- cut(poblaciones,
                      breaks = breaks,
                      labels = labels,
                      include.lowest = TRUE,
                      right = FALSE)
tablaintervalos <- data.frame(table(intervalospobl))
print(tablaintervalos)

##     intervalospobl Freq
## 1     1e+05-599999    7
## 2    6e+05-1099999    5
## 3  1100000-1599999    1
## 4  1600000-2099999    2
## 5  2100000-2599999    0
## 6  2600000-3099999    0
## 7  3100000-3599999    0
## 8  3600000-4099999    0
## 9  4100000-4599999    0
## 10 4600000-5099999    0
## 11 5100000-5599999    0
## 12 5600000-6099999    0
## 13 6100000-6599999    0
## 14 6600000-7099999    0
## 15 7100000-7599999    0
## 16 7600000-8099999    0
## 17 8100000-8599999    1

TDF_cantpo <- data.frame(table(intervalospobl))
min <- min(poblaciones)
max <- max(poblaciones)

##TABLA DE DISTRIBUCION DE FRECUENCIAS##
ni <- TDF_cantpo$Freq
hi <- (ni/sum(ni))
Ni_asc <- cumsum(ni)
Hi_asc <- cumsum(hi)
Ni_desc <- rev(cumsum(rev(ni)))
Hi_desc <- rev(cumsum(rev(hi)))
TDF_cantpo <- data.frame(TDF_cantpo$intervalospobl,
                         ni,
                         round(hi * 100, 2),
                         Ni_asc,
                         Ni_desc,
                         round(Hi_asc * 100, 2),
                         round(Hi_desc * 100, 2))

colnames(TDF_cantpo) <- c("Intervalos de poblacion","ni","hi(%)",
                          "Ni asc","Ni desc","Hi asc(%)","Hi desc(%)")

#============================ INFERENCIAL ================================
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
text(x = 1, y = 1, 
     labels = "INFERENCIAL",
     cex = 2,  
     col = "blue",  
     font =6)

##AGRUPACION POR NUMEROS##
TDF_cantpo$`Intervalos de poblacion` <- 1:nrow(TDF_cantpo)

##REALIZACION DEL BARPLOT##
barplot(TDF_cantpo$ni, 
        main="Grafico n°2: Diagrama de barras de la frecuencia
     poblacional de las regiones de Chile", 
        xlab="Agrupaciones", ylab="ni", 
        names.arg = TDF_cantpo$`Intervalos de poblacion`, 
        las=2, 
        col = "blue")

intervalos_num <- as.numeric(as.character(TDF_cantpo$`Intervalos de poblacion`))

##CREACION DE MODELO GEOMETRICO##
media_obs <- mean(intervalos_num)
P <- 1 / (media_obs+1)
P_geom <- dgeom(intervalos_num - 1, prob = P)
P_geom

##  [1] 0.10000000 0.09000000 0.08100000 0.07290000 0.06561000 0.05904900
##  [7] 0.05314410 0.04782969 0.04304672 0.03874205 0.03486784 0.03138106
## [13] 0.02824295 0.02541866 0.02287679 0.02058911 0.01853020

##CREACION DE BARPLOT COMPARATIVO##
barplot(rbind((ni / sum(ni)) * 100, P_geom * 100),
        main = "Grafico n°2.1: Diagrama de barras del modelo vs la realidad de
        la cantidad poblacional de las regiones de Chile",
        cex.main = 0.9,
        xlab = "Agrupacion de poblaciones",
        ylab = "Probabilidad (%)",
        names.arg = intervalos_num,
        beside = TRUE,
        col = c("skyblue", "darkgreen"))
legend("topright", legend = c("Real", "Modelo Geometrico"),
       fill = c("skyblue", "darkgreen"))

Fo <- hi
Fe <- P_geom

#TEST DE BONDAD#
#TEST DE PEARSON#
Correlacion <- cor(Fo, Fe) * 100
Correlacion

## [1] 74.6186

plot(Fo, Fe, main="Grafico n°2.2: Correlacion de frecuencias entre modelo
geometrico y la realidad",
     xlab="Observado (hi)", ylab="Esperado (P)",
     cex.main = 0.9)
abline(lm(Fe ~ Fo), col="red", lwd=2)

#CHI CUADRADO#
ni_obs <- ni
ni_exp <- P_geom * sum(ni)
x2 <- sum((ni_obs - ni_exp)^2 / ni_exp)
vc <- qchisq(0.999, length(Fo) - 1)
x2 > vc

## [1] FALSE

##EJEMPLO##
probabilidad_2 <- dgeom(2, P) * 100
probabilidad_2

## [1] 8.1

# Calculo de probabilidad
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") # Crear un grafico vacio
text(x = 1, y = 1, 
     labels = "Calculos de probabilidad\n(Estimacion general)\n
     ¿Cual es la probabilidad de que\nla cantidad poblacional\n sea el valor 2?\n\n
     R: 8.30(%)",
     cex = 1.5,  
     col = "blue",  
     font =6) 

cat("La probabilidad de que la cantidad de poblacion este entre 600000 y 1099999 personas es aproximadamente:",
    round(probabilidad_2, 2), "%\n")

## La probabilidad de que la cantidad de poblacion este entre 600000 y 1099999 personas es aproximadamente: 8.1 %

##TABLA DE CONCLUSIONES##
tabla_modelos_1 <- data.frame("Cantidad Poblacional" = c("[108306;8367790]", ""),
                              "Modelo" = c("Geometrico", ""),
                              "Parametros" = c("P = 0.1", ""),
                              "Test_de_Pearson" = c("0.74", ""),
                              "Test_de_Chi_cuadrado" = c("Aprobado", ""))

colnames(tabla_modelos_1) <- c("Cantidad Poblacional", "Modelo",
                               "Parametros","Test Pearson",
                               "Test Chi-cuadrado")

plot(1, type = "n", axes = FALSE, xlab = "", ylab = "") # Crear un grafico vacio
text(x = 1, y = 1, 
     labels = "CONCLUSIONES",
     cex = 2,  # Tamaño del texto (ajustable)
     col = "blue",  # Color del texto
     font = 6) #tipo

library(knitr)
kable(tabla_modelos_1, align = 'c',
      caption = "Conclusiones del Modelo Exponencial para Desechos (ha)")

Conclusiones del Modelo Exponencial para Desechos (ha)

Cantidad Poblacional	Modelo	Parametros	Test Pearson	Test Chi-cuadrado
[108306;8367790]	Geometrico	P = 0.1	0.74	Aprobado