library(readxl)
Parcial <-read_excel("C:/Users/wsand/Dropbox/2021-II/Ulibertadores/Mineria de datos/Parcial Segundo.xls", col_names = c("Departamento","Municipios", "Superficie", "Homicidios_2016", "Poblacion", "Region"), skip=1)
Parcial=as.data.frame(Parcial)

library(DT)
DT::datatable(Parcial)

1. Carga de paquetes R requeridos.

library(tidyverse)
library(caret)
theme_set(theme_classic())

2. Preparando los datos.

Divida los datos en entrenamiento y conjunto de prueba:
Cargamos la data

rownames(Parcial)=Parcial$Departamento
Parcial=Parcial[,-1]
DT::datatable(Parcial)

Dividimos la data para entrenamiento en un (80%) y para la prueba en un (20%)

set.seed(123)
training.samples <- Parcial$Region %>%
  createDataPartition(p = 0.8, list = FALSE)

## Warning in createDataPartition(., p = 0.8, list = FALSE): Some classes have a
## single record ( Insular ) and these will be selected for the sample

train.data <- Parcial[training.samples, ]
test.data <- Parcial[-training.samples, ]

Normaliza los datos. Las variables categóricas se ignoran automáticamente.

Estimar parámetros de preprocesamiento

preproc.param <- train.data %>% 
  preProcess(method = c("center", "scale"))

Transformar los datos usando los parámetros estimados

train.transformed <- preproc.param %>% predict(train.data)
test.transformed <- preproc.param %>% predict(test.data)

3. Análisis discriminante lineal - LDA.

Estimación del modelo

train.transformed

##                           Municipios  Superficie Homicidios_2016   Poblacion
## Antioquia                 2.68445891  1.11310419      2.69971822  2.54741191
## Arauca                   -0.75478422 -0.35885541     -0.54252319 -0.66487355
## Atlántico                -0.28844617 -1.12819973      0.30224764  0.52610092
## Bogotá                   -0.92966099 -1.17421465      1.60680736  3.47544797
## Boyacá                    2.62616665 -0.38866894     -0.50785657 -0.13556791
## Caldas                   -0.17186165 -0.94809792     -0.30897964 -0.28636598
## Caquetá                  -0.49246906  2.05089863     -0.44217245 -0.54681716
## Casanare                 -0.40503068  0.40579124     -0.54252319 -0.61015142
## Cauca                     0.23618414 -0.15578313      0.26940558 -0.06534457
## Cesar                    -0.23015391 -0.39262681     -0.37466376 -0.24880268
## Chocó                    -0.05527714  0.48124979     -0.36189185 -0.53692269
## Córdoba                  -0.08442327 -0.31439405     -0.09550623  0.12962586
## Cundinamarca              2.42214376 -0.34435553      0.12344086  0.89463132
## Guainía                  -0.90051486  1.43217550     -0.69761071 -0.78382392
## Guaviare                 -0.84222260  0.71898122     -0.66111953 -0.74593820
## Huila                     0.11959963 -0.50415011     -0.23964639 -0.18002081
## La Guajira               -0.52161519 -0.46871418     -0.35094449 -0.26212023
## Magdalena                -0.08442327 -0.38215879     -0.33452346 -0.12688826
## Meta                     -0.11356940  1.92772364     -0.15571668 -0.27443127
## Nariño                    0.90654509 -0.02587606      0.12344086  0.14043577
## Norte de Santander        0.20703801 -0.43912260      0.23473896 -0.07831406
## Putumayo                 -0.57990745 -0.31938763     -0.50055834 -0.61871539
## Quindío                  -0.60905358 -1.17162539     -0.22687448 -0.50562613
## San Andrés y Providencia -0.90051486 -1.23794753     -0.67936512 -0.76552197
## Sucre                    -0.20100778 -0.84519317     -0.49690922 -0.34752392
## Tolima                    0.41106091 -0.36832472     -0.11010270 -0.06334935
## Valle del Cauca           0.26533027 -0.41888935      3.64119069  1.68263107
## Vaupés                   -0.87136873  0.76255483     -0.69761071 -0.78304823
## Vichada                  -0.84222260  2.49410665     -0.67389144 -0.76611709
##                             Region
## Antioquia                   Andina
## Arauca                   Orinoquia
## Atlántico                   Caribe
## Bogotá                      Andina
## Boyacá                      Andina
## Caldas                      Andina
## Caquetá                  Amazónica
## Casanare                 Orinoquia
## Cauca                     Pacifica
## Cesar                       Caribe
## Chocó                     Pacifica
## Córdoba                     Caribe
## Cundinamarca                Andina
## Guainía                  Amazónica
## Guaviare                 Amazónica
## Huila                       Andina
## La Guajira                  Caribe
## Magdalena                   Caribe
## Meta                     Orinoquia
## Nariño                    Pacifica
## Norte de Santander          Andina
## Putumayo                 Amazónica
## Quindío                     Andina
## San Andrés y Providencia   Insular
## Sucre                       Caribe
## Tolima                      Andina
## Valle del Cauca           Pacifica
## Vaupés                   Amazónica
## Vichada                  Orinoquia

library(MASS)

model <- lda(Region~., data = train.transformed)
model

## Call:
## lda(Region ~ ., data = train.transformed)
## 
## Prior probabilities of groups:
##  Amazónica     Andina     Caribe    Insular  Orinoquia   Pacifica 
## 0.17241379 0.31034483 0.20689655 0.03448276 0.13793103 0.13793103 
## 
## Group means:
##           Municipios  Superficie Homicidios_2016   Poblacion
## Amazónica -0.7372965  0.92904451      -0.5998143 -0.69566858
## Andina     0.7510991 -0.46949507       0.3634717  0.62980522
## Caribe    -0.2350116 -0.58854779      -0.2250499 -0.05493472
## Insular   -0.9005149 -1.23794753      -0.6793651 -0.76552197
## Orinoquia -0.5289017  1.11719153      -0.4786636 -0.57889333
## Pacifica   0.3381956 -0.02982469       0.9180363  0.30519989
## 
## Coefficients of linear discriminants:
##                        LD1        LD2        LD3         LD4
## Municipios       0.8575527  0.2416794  0.4984838 -0.73752051
## Superficie      -1.2291546  0.2651394  0.7121130  0.10782884
## Homicidios_2016 -0.1190118  1.7095798 -1.0281596 -0.02527641
## Poblacion        0.4836722 -1.1844591  1.2171459  0.94144939
## 
## Proportion of trace:
##    LD1    LD2    LD3    LD4 
## 0.7970 0.1207 0.0815 0.0008

Hacer predicciones del modelo

predictions <- model %>% predict(test.transformed)
predictions

## $class
## [1] Orinoquia Andina    Caribe    Andina   
## Levels: Amazónica Andina Caribe Insular Orinoquia Pacifica
## 
## $posterior
##              Amazónica       Andina       Caribe      Insular    Orinoquia
## Amazonas  0.4651333538 4.046352e-07 1.505022e-05 1.618766e-07 0.5348340999
## Bolívar   0.0067335007 5.646473e-01 3.569401e-01 1.070048e-02 0.0051825161
## Risaralda 0.0061467374 2.271803e-01 5.550421e-01 1.131924e-01 0.0031435535
## Santander 0.0003710739 8.732359e-01 1.086700e-01 1.316986e-03 0.0003665584
##               Pacifica
## Amazonas  1.692958e-05
## Bolívar   5.579611e-02
## Risaralda 9.529497e-02
## Santander 1.603955e-02
## 
## $x
##                  LD1        LD2        LD3         LD4
## Amazonas  -4.5246418  0.2897888  1.3144617  0.26430343
## Bolívar    0.8044566 -0.3713467  0.3739298  0.02034283
## Risaralda  0.7397007 -0.3726405 -1.2291048  0.01109674
## Santander  1.6508297 -0.3301071  1.2629213 -0.89890237

precisión del modelo

mean(predictions$class==test.transformed$Region)

## [1] 0.25

plot(model,main="Gráfico de Discriminantes lineales")

# Haciendo predicciones :

predictions <- model %>% predict(test.transformed)
names(predictions)

## [1] "class"     "posterior" "x"

predictions$class

## [1] Orinoquia Andina    Caribe    Andina   
## Levels: Amazónica Andina Caribe Insular Orinoquia Pacifica

predictions$posterior

##              Amazónica       Andina       Caribe      Insular    Orinoquia
## Amazonas  0.4651333538 4.046352e-07 1.505022e-05 1.618766e-07 0.5348340999
## Bolívar   0.0067335007 5.646473e-01 3.569401e-01 1.070048e-02 0.0051825161
## Risaralda 0.0061467374 2.271803e-01 5.550421e-01 1.131924e-01 0.0031435535
## Santander 0.0003710739 8.732359e-01 1.086700e-01 1.316986e-03 0.0003665584
##               Pacifica
## Amazonas  1.692958e-05
## Bolívar   5.579611e-02
## Risaralda 9.529497e-02
## Santander 1.603955e-02

predictions$x

##                  LD1        LD2        LD3         LD4
## Amazonas  -4.5246418  0.2897888  1.3144617  0.26430343
## Bolívar    0.8044566 -0.3713467  0.3739298  0.02034283
## Risaralda  0.7397007 -0.3726405 -1.2291048  0.01109674
## Santander  1.6508297 -0.3301071  1.2629213 -0.89890237

Predicción de la clase

head(predictions$class, 6)

## [1] Orinoquia Andina    Caribe    Andina   
## Levels: Amazónica Andina Caribe Insular Orinoquia Pacifica

Probabilidades pronosticadas de pertenencia a una clase.

head(predictions$posterior, 6)

##              Amazónica       Andina       Caribe      Insular    Orinoquia
## Amazonas  0.4651333538 4.046352e-07 1.505022e-05 1.618766e-07 0.5348340999
## Bolívar   0.0067335007 5.646473e-01 3.569401e-01 1.070048e-02 0.0051825161
## Risaralda 0.0061467374 2.271803e-01 5.550421e-01 1.131924e-01 0.0031435535
## Santander 0.0003710739 8.732359e-01 1.086700e-01 1.316986e-03 0.0003665584
##               Pacifica
## Amazonas  1.692958e-05
## Bolívar   5.579611e-02
## Risaralda 9.529497e-02
## Santander 1.603955e-02

Discriminante lineal

head(predictions$x, 10)

##                  LD1        LD2        LD3         LD4
## Amazonas  -4.5246418  0.2897888  1.3144617  0.26430343
## Bolívar    0.8044566 -0.3713467  0.3739298  0.02034283
## Risaralda  0.7397007 -0.3726405 -1.2291048  0.01109674
## Santander  1.6508297 -0.3301071  1.2629213 -0.89890237

lda.data <- cbind(train.transformed, predict(model)$x)
ggplot(lda.data, aes(LD1, LD2)) +
  geom_point(aes(color = Region))+ggtitle("Gráfico LDA")

Precisión del modelo :

mean(predictions$class==test.transformed$Region)

## [1] 0.25

sum(predictions$posterior[ ,1] >=0.5)

## [1] 0

Predicción nuevos individuos

Realizar la predicción para los siguientes nuevos individuos:
- Municipios: 10, Superficie: 10000, Homicidios 2016: 1000, Población: 1000000

nuevo1 <- data.frame(Municipios=10, Superficie = 10000,
                     Homicidios_2016 = 1000,
                     Poblacion = 1000000)
nuevo1.transformed <- preproc.param %>% predict(nuevo1)

predict(model,nuevo1.transformed)$posterior

##     Amazónica     Andina     Caribe    Insular   Orinoquia  Pacifica
## 1 0.004429205 0.01976683 0.07534489 0.03659991 0.002426272 0.8614329

predict(model,nuevo1.transformed)$class

## [1] Pacifica
## Levels: Amazónica Andina Caribe Insular Orinoquia Pacifica

El resultado muestra que, según la función discriminarte, la probabilidad posterior de que el departamento pertenezca a la región pacifica es de 86.1%

Municipios: 125, Superficie: 100000, Homicidios 2016: 2000, Población: 8000000

nuevo2 <- data.frame(Municipios=125, Superficie = 100000,
                     Homicidios_2016 = 2000,
                     Poblacion = 8000000)

nuevo2.transformed <- preproc.param %>% predict(nuevo2)

predict(model,nuevo2.transformed)$posterior

##     Amazónica    Andina    Caribe     Insular  Orinoquia  Pacifica
## 1 0.004799777 0.8086395 0.0096608 1.10972e-06 0.01489489 0.1620039

predict(model,nuevo2.transformed)$class

## [1] Andina
## Levels: Amazónica Andina Caribe Insular Orinoquia Pacifica

El resultado muestra que, según la función discriminarte, la mayor probabilidad posterior de que el departamento pertenezca a la región Andina es de 80.8%

Municipios: 33, Superficie: 34000, Homicidios 2016: 300, Población: 1500000

nuevo3 <- data.frame(Municipios=33, Superficie = 34000,
                     Homicidios_2016 = 300,
                     Poblacion = 1500000)
nuevo3.transformed <- preproc.param %>% predict(nuevo3)

predict(model,nuevo3.transformed)$posterior

##    Amazónica    Andina    Caribe    Insular  Orinoquia Pacifica
## 1 0.06733474 0.2964337 0.4603972 0.01850987 0.05054046 0.106784

predict(model,nuevo3.transformed)$class

## [1] Caribe
## Levels: Amazónica Andina Caribe Insular Orinoquia Pacifica

El resultado muestra que, según la función discriminarte, la probabilidad posterior de que el departamento pertenezca a la región pacifica es de 46.03%

Minería de datos

Wilson Sandoval, John Gonzalez, Santiago Rodriguez

2021-10-21