# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# #
# # # # ---->TRABAJO SOBRE LA DATA-INCETIVOS<---
# #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
#-> UNIVERSIDAD NACIONAL DEL ALTIPLANO PUNO
# -> FACULTAD DE INGENIERIA ESTADISTIA E INFORMATICA
#
# -> JOSEFHJORDY QUISPE MORALES
# -> TECNICAS ESTADISTICAS MULTIVARIADAS
#
# Cargamos el paquete para visualización de tablas
if (!require("kableExtra")) install.packages("kableExtra")
## Loading required package: kableExtra
## Warning: package 'kableExtra' was built under R version 4.3.3
library(kableExtra)
# Enunciado del ejercicio
enunciado <- "
**Diseño de un plan de incentivos para vendedores**
El director de ventas de una cadena de tiendas de electrodomésticos a nivel nacional está revisando el plan de incentivos para sus vendedores. Reconociendo las variaciones en las condiciones de venta en diferentes regiones geográficas, busca ajustar los incentivos de manera que reflejen las dificultades particulares que enfrentan los vendedores en cada zona.
Para lograr esto, se propone segmentar las comunidades autónomas en grupos homogéneos basados en el equipamiento de los hogares de sus habitantes. El objetivo es identificar similitudes y diferencias en la penetración de diversos electrodomésticos y dispositivos tecnológicos en los hogares de distintas regiones.
A continuación se presentan los porcentajes de hogares que cuentan con varios electrodomésticos y dispositivos tecnológicos en cada comunidad autónoma:
"
# Creamos el data frame con los datos proporcionados
datos <- data.frame(
CCAA = c("España", "Andalucía", "Aragón", "Asturias", "Baleares", "Canarias", "Cantabria", "Cast. y León", "C.-La Mancha", "Cataluña", "Com. Valenciana", "Extremadura", "Galicia", "Madrid", "Murcia", "Navarra", "País Vasco", "La Rioja"),
Automóvil = c(69.0, 66.7, 67.2, 63.7, 71.9, 72.7, 63.4, 65.8, 61.5, 70.4, 72.7, 60.5, 65.5, 74.0, 69.0, 76.4, 71.3, 64.9),
TV_color = c(97.6, 98.0, 97.5, 95.2, 98.8, 96.8, 94.9, 97.1, 97.3, 98.1, 98.4, 97.7, 91.3, 99.4, 98.7, 99.3, 98.3, 98.6),
Video = c(62.4, 62.7, 56.8, 52.1, 62.4, 68.4, 48.9, 47.7, 53.6, 71.1, 68.2, 43.7, 42.7, 76.3, 59.3, 60.6, 61.6, 54.4),
Micro_ondas = c(32.3, 24.1, 43.4, 24.4, 29.8, 27.9, 36.5, 28.1, 21.7, 36.8, 26.6, 20.7, 13.5, 53.9, 19.5, 44.0, 45.7, 44.4),
Lava_vajillas = c(17.0, 12.7, 20.6, 13.3, 10.1, 5.8, 11.2, 14.0, 7.1, 19.8, 12.1, 11.7, 14.6, 32.3, 12.1, 20.6, 23.7, 17.6),
Teléfono = c(85.2, 74.7, 88.4, 88.1, 87.9, 75.4, 80.5, 85.0, 72.9, 92.2, 84.4, 67.1, 85.9, 95.7, 81.4, 87.4, 94.3, 83.4)
)
# Creamos la tabla con los datos
tabla_datos <- datos %>%
kable("html") %>%
kable_styling(full_width = FALSE)
# Mostramos el enunciado y la tabla con formato
cat(enunciado, tabla_datos)
##
## **Diseño de un plan de incentivos para vendedores**
##
## El director de ventas de una cadena de tiendas de electrodomésticos a nivel nacional está revisando el plan de incentivos para sus vendedores. Reconociendo las variaciones en las condiciones de venta en diferentes regiones geográficas, busca ajustar los incentivos de manera que reflejen las dificultades particulares que enfrentan los vendedores en cada zona.
##
## Para lograr esto, se propone segmentar las comunidades autónomas en grupos homogéneos basados en el equipamiento de los hogares de sus habitantes. El objetivo es identificar similitudes y diferencias en la penetración de diversos electrodomésticos y dispositivos tecnológicos en los hogares de distintas regiones.
##
## A continuación se presentan los porcentajes de hogares que cuentan con varios electrodomésticos y dispositivos tecnológicos en cada comunidad autónoma:
## <table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
## <thead>
## <tr>
## <th style="text-align:left;"> CCAA </th>
## <th style="text-align:right;"> Automóvil </th>
## <th style="text-align:right;"> TV_color </th>
## <th style="text-align:right;"> Video </th>
## <th style="text-align:right;"> Micro_ondas </th>
## <th style="text-align:right;"> Lava_vajillas </th>
## <th style="text-align:right;"> Teléfono </th>
## </tr>
## </thead>
## <tbody>
## <tr>
## <td style="text-align:left;"> España </td>
## <td style="text-align:right;"> 69.0 </td>
## <td style="text-align:right;"> 97.6 </td>
## <td style="text-align:right;"> 62.4 </td>
## <td style="text-align:right;"> 32.3 </td>
## <td style="text-align:right;"> 17.0 </td>
## <td style="text-align:right;"> 85.2 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Andalucía </td>
## <td style="text-align:right;"> 66.7 </td>
## <td style="text-align:right;"> 98.0 </td>
## <td style="text-align:right;"> 62.7 </td>
## <td style="text-align:right;"> 24.1 </td>
## <td style="text-align:right;"> 12.7 </td>
## <td style="text-align:right;"> 74.7 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Aragón </td>
## <td style="text-align:right;"> 67.2 </td>
## <td style="text-align:right;"> 97.5 </td>
## <td style="text-align:right;"> 56.8 </td>
## <td style="text-align:right;"> 43.4 </td>
## <td style="text-align:right;"> 20.6 </td>
## <td style="text-align:right;"> 88.4 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Asturias </td>
## <td style="text-align:right;"> 63.7 </td>
## <td style="text-align:right;"> 95.2 </td>
## <td style="text-align:right;"> 52.1 </td>
## <td style="text-align:right;"> 24.4 </td>
## <td style="text-align:right;"> 13.3 </td>
## <td style="text-align:right;"> 88.1 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Baleares </td>
## <td style="text-align:right;"> 71.9 </td>
## <td style="text-align:right;"> 98.8 </td>
## <td style="text-align:right;"> 62.4 </td>
## <td style="text-align:right;"> 29.8 </td>
## <td style="text-align:right;"> 10.1 </td>
## <td style="text-align:right;"> 87.9 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Canarias </td>
## <td style="text-align:right;"> 72.7 </td>
## <td style="text-align:right;"> 96.8 </td>
## <td style="text-align:right;"> 68.4 </td>
## <td style="text-align:right;"> 27.9 </td>
## <td style="text-align:right;"> 5.8 </td>
## <td style="text-align:right;"> 75.4 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Cantabria </td>
## <td style="text-align:right;"> 63.4 </td>
## <td style="text-align:right;"> 94.9 </td>
## <td style="text-align:right;"> 48.9 </td>
## <td style="text-align:right;"> 36.5 </td>
## <td style="text-align:right;"> 11.2 </td>
## <td style="text-align:right;"> 80.5 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Cast. y León </td>
## <td style="text-align:right;"> 65.8 </td>
## <td style="text-align:right;"> 97.1 </td>
## <td style="text-align:right;"> 47.7 </td>
## <td style="text-align:right;"> 28.1 </td>
## <td style="text-align:right;"> 14.0 </td>
## <td style="text-align:right;"> 85.0 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> C.-La Mancha </td>
## <td style="text-align:right;"> 61.5 </td>
## <td style="text-align:right;"> 97.3 </td>
## <td style="text-align:right;"> 53.6 </td>
## <td style="text-align:right;"> 21.7 </td>
## <td style="text-align:right;"> 7.1 </td>
## <td style="text-align:right;"> 72.9 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Cataluña </td>
## <td style="text-align:right;"> 70.4 </td>
## <td style="text-align:right;"> 98.1 </td>
## <td style="text-align:right;"> 71.1 </td>
## <td style="text-align:right;"> 36.8 </td>
## <td style="text-align:right;"> 19.8 </td>
## <td style="text-align:right;"> 92.2 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Com. Valenciana </td>
## <td style="text-align:right;"> 72.7 </td>
## <td style="text-align:right;"> 98.4 </td>
## <td style="text-align:right;"> 68.2 </td>
## <td style="text-align:right;"> 26.6 </td>
## <td style="text-align:right;"> 12.1 </td>
## <td style="text-align:right;"> 84.4 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Extremadura </td>
## <td style="text-align:right;"> 60.5 </td>
## <td style="text-align:right;"> 97.7 </td>
## <td style="text-align:right;"> 43.7 </td>
## <td style="text-align:right;"> 20.7 </td>
## <td style="text-align:right;"> 11.7 </td>
## <td style="text-align:right;"> 67.1 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Galicia </td>
## <td style="text-align:right;"> 65.5 </td>
## <td style="text-align:right;"> 91.3 </td>
## <td style="text-align:right;"> 42.7 </td>
## <td style="text-align:right;"> 13.5 </td>
## <td style="text-align:right;"> 14.6 </td>
## <td style="text-align:right;"> 85.9 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Madrid </td>
## <td style="text-align:right;"> 74.0 </td>
## <td style="text-align:right;"> 99.4 </td>
## <td style="text-align:right;"> 76.3 </td>
## <td style="text-align:right;"> 53.9 </td>
## <td style="text-align:right;"> 32.3 </td>
## <td style="text-align:right;"> 95.7 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Murcia </td>
## <td style="text-align:right;"> 69.0 </td>
## <td style="text-align:right;"> 98.7 </td>
## <td style="text-align:right;"> 59.3 </td>
## <td style="text-align:right;"> 19.5 </td>
## <td style="text-align:right;"> 12.1 </td>
## <td style="text-align:right;"> 81.4 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> Navarra </td>
## <td style="text-align:right;"> 76.4 </td>
## <td style="text-align:right;"> 99.3 </td>
## <td style="text-align:right;"> 60.6 </td>
## <td style="text-align:right;"> 44.0 </td>
## <td style="text-align:right;"> 20.6 </td>
## <td style="text-align:right;"> 87.4 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> País Vasco </td>
## <td style="text-align:right;"> 71.3 </td>
## <td style="text-align:right;"> 98.3 </td>
## <td style="text-align:right;"> 61.6 </td>
## <td style="text-align:right;"> 45.7 </td>
## <td style="text-align:right;"> 23.7 </td>
## <td style="text-align:right;"> 94.3 </td>
## </tr>
## <tr>
## <td style="text-align:left;"> La Rioja </td>
## <td style="text-align:right;"> 64.9 </td>
## <td style="text-align:right;"> 98.6 </td>
## <td style="text-align:right;"> 54.4 </td>
## <td style="text-align:right;"> 44.4 </td>
## <td style="text-align:right;"> 17.6 </td>
## <td style="text-align:right;"> 83.4 </td>
## </tr>
## </tbody>
## </table>
# Instalación de paquetes si no están instalados
if (!require("dplyr")) install.packages("dplyr") # Paquete para manipulación de datos
## Loading required package: dplyr
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following object is masked from 'package:kableExtra':
##
## group_rows
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
if (!require("tidyr")) install.packages("tidyr") # Paquete para manipulación de datos
## Loading required package: tidyr
## Warning: package 'tidyr' was built under R version 4.3.3
if (!require("cluster")) install.packages("cluster") # Paquete para análisis de clustering
## Loading required package: cluster
## Warning: package 'cluster' was built under R version 4.3.3
if (!require("factoextra")) install.packages("factoextra") # Paquete para visualización de resultados de clustering
## Loading required package: factoextra
## Warning: package 'factoextra' was built under R version 4.3.3
## Loading required package: ggplot2
## Warning: package 'ggplot2' was built under R version 4.3.3
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
if (!require("ggplot2")) install.packages("ggplot2") # Paquete para visualización de datos
if (!require("moments")) install.packages("moments") # Paquete para estadísticas descriptivas
## Loading required package: moments
if (!require("stats")) install.packages("stats") # Paquete base de R para estadísticas
if (!require("FactoMineR")) install.packages("FactoMineR") # Paquete para análisis de factores
## Loading required package: FactoMineR
## Warning: package 'FactoMineR' was built under R version 4.3.3
if (!require("psych")) install.packages("psych") # Paquete para análisis psicométrico
## Loading required package: psych
## Warning: package 'psych' was built under R version 4.3.3
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
if (!require("GGally")) install.packages("GGally") # Paquete para visualización de matrices de correlación
## Loading required package: GGally
## Warning: package 'GGally' was built under R version 4.3.3
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
if (!require("corrr")) install.packages("corrr") # Paquete para análisis de correlación
## Loading required package: corrr
## Warning: package 'corrr' was built under R version 4.3.3
if (!require("ade4")) install.packages("ade4") # Paquete para análisis multivariado
## Loading required package: ade4
## Warning: package 'ade4' was built under R version 4.3.3
##
## Attaching package: 'ade4'
## The following object is masked from 'package:FactoMineR':
##
## reconst
if (!require("scatterplot3d")) install.packages("scatterplot3d") # Paquete para visualización en 3D
## Loading required package: scatterplot3d
if (!require("nortest")) install.packages("nortest") # Paquete para pruebas de normalidad
## Loading required package: nortest
if (!require("network")) install.packages("network")
## Loading required package: network
## Warning: package 'network' was built under R version 4.3.3
##
## 'network' 1.18.2 (2023-12-04), part of the Statnet Project
## * 'news(package="network")' for changes since last version
## * 'citation("network")' for citation information
## * 'https://statnet.org' for help, support, and other information
#if (!require("rela")) install.packages("rela")
# Carga de librerías necesarias
library(stats) # Paquete base de R para estadísticas
library(FactoMineR) # Paquete para análisis de factores
library(factoextra) # Paquete para visualización de resultados de clustering
library(dplyr) # Paquete para manipulación de datos
library(tidyr) # Paquete para manipulación de datos
library(cluster) # Paquete para análisis de clustering
library(ggplot2) # Paquete para visualización de datos
library(moments) # Paquete para estadísticas descriptivas
library(psych) # Paquete para análisis psicométrico
library(GGally) # Paquete para visualización de matrices de correlación
library(corrr) # Paquete para análisis de correlación
library(ade4) # Paquete para análisis multivariado
library(scatterplot3d) # Paquete para visualización en 3D
library(nortest) # Paquete para pruebas de normalidad
library(MVN)
## Warning: package 'MVN' was built under R version 4.3.3
#library(rela)
library(ggcorrplot)
## Warning: package 'ggcorrplot' was built under R version 4.3.3
library(network)
# Normalizamos los datos (es recomendable para el clustering)
datos_normalizados <- datos %>%
select(-CCAA) %>%
scale()
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -FUNCIONES PARA ESTADISTICAS DESCRIPTIVAS
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Función para calcular estadísticas básicas
calcular_estadisticas <- function(columna) {
data.frame(
media = mean(columna),
mediana = median(columna),
desviacion_estandar = sd(columna),
minimo = min(columna),
maximo = max(columna)
)
}
# Aplicar la función a cada columna numérica usando reframe()
estadisticas_basicas <- datos %>%
select(-CCAA) %>%
reframe(across(everything(), calcular_estadisticas))
# Mostrar las estadísticas
print(estadisticas_basicas)
## Automóvil.media Automóvil.mediana Automóvil.desviacion_estandar
## 1 68.14444 68.1 4.507539
## Automóvil.minimo Automóvil.maximo TV_color.media TV_color.mediana
## 1 60.5 76.4 97.38889 97.85
## TV_color.desviacion_estandar TV_color.minimo TV_color.maximo Video.media
## 1 1.944189 91.3 99.4 58.49444
## Video.mediana Video.desviacion_estandar Video.minimo Video.maximo
## 1 59.95 9.37007 42.7 76.3
## Micro_ondas.media Micro_ondas.mediana Micro_ondas.desviacion_estandar
## 1 31.85 28.95 10.99857
## Micro_ondas.minimo Micro_ondas.maximo Lava_vajillas.media
## 1 13.5 53.9 15.35
## Lava_vajillas.mediana Lava_vajillas.desviacion_estandar Lava_vajillas.minimo
## 1 13.65 6.379402 5.8
## Lava_vajillas.maximo Teléfono.media Teléfono.mediana
## 1 32.3 83.88333 85.1
## Teléfono.desviacion_estandar Teléfono.minimo Teléfono.maximo
## 1 7.545022 67.1 95.7
# Función para calcular estadísticas intermedias
calcular_estadisticas_intermedias <- function(columna) {
data.frame(
media = mean(columna),
mediana = median(columna),
desviacion_estandar = sd(columna),
minimo = min(columna),
maximo = max(columna),
asimetria = skewness(columna),
curtosis = kurtosis(columna)
)
}
# Aplicar la función a cada columna numérica usando reframe()
estadisticas_intermedias <- datos %>%
select(-CCAA) %>%
reframe(across(everything(), calcular_estadisticas_intermedias))
# Mostrar las estadísticas
print(estadisticas_intermedias)
## Automóvil.media Automóvil.mediana Automóvil.desviacion_estandar
## 1 68.14444 68.1 4.507539
## Automóvil.minimo Automóvil.maximo Automóvil.asimetria Automóvil.curtosis
## 1 60.5 76.4 0.03012739 2.031233
## TV_color.media TV_color.mediana TV_color.desviacion_estandar TV_color.minimo
## 1 97.38889 97.85 1.944189 91.3
## TV_color.maximo TV_color.asimetria TV_color.curtosis Video.media
## 1 99.4 -1.873859 6.438271 58.49444
## Video.mediana Video.desviacion_estandar Video.minimo Video.maximo
## 1 59.95 9.37007 42.7 76.3
## Video.asimetria Video.curtosis Micro_ondas.media Micro_ondas.mediana
## 1 -0.0002878899 2.261381 31.85 28.95
## Micro_ondas.desviacion_estandar Micro_ondas.minimo Micro_ondas.maximo
## 1 10.99857 13.5 53.9
## Micro_ondas.asimetria Micro_ondas.curtosis Lava_vajillas.media
## 1 0.3307166 2.16761 15.35
## Lava_vajillas.mediana Lava_vajillas.desviacion_estandar Lava_vajillas.minimo
## 1 13.65 6.379402 5.8
## Lava_vajillas.maximo Lava_vajillas.asimetria Lava_vajillas.curtosis
## 1 32.3 0.9440683 3.904478
## Teléfono.media Teléfono.mediana Teléfono.desviacion_estandar Teléfono.minimo
## 1 83.88333 85.1 7.545022 67.1
## Teléfono.maximo Teléfono.asimetria Teléfono.curtosis
## 1 95.7 -0.5423679 2.759454
# Función para calcular estadísticas avanzadas
calcular_estadisticas_avanzadas <- function(columna) {
percentiles <- quantile(columna, probs = c(0.25, 0.75))
data.frame(
media = mean(columna),
mediana = median(columna),
desviacion_estandar = sd(columna),
minimo = min(columna),
maximo = max(columna),
asimetria = skewness(columna),
curtosis = kurtosis(columna),
percentil_25 = percentiles[1],
percentil_75 = percentiles[2],
rango_intercuartilico = IQR(columna)
)
}
# Aplicar la función a cada columna numérica usando reframe()
estadisticas_avanzadas <- datos %>%
select(-CCAA) %>%
reframe(across(everything(), calcular_estadisticas_avanzadas))
# Mostrar las estadísticas
print(estadisticas_avanzadas)
## Automóvil.media Automóvil.mediana Automóvil.desviacion_estandar
## 1 68.14444 68.1 4.507539
## Automóvil.minimo Automóvil.maximo Automóvil.asimetria Automóvil.curtosis
## 1 60.5 76.4 0.03012739 2.031233
## Automóvil.percentil_25 Automóvil.percentil_75 Automóvil.rango_intercuartilico
## 1 65.05 71.75 6.7
## TV_color.media TV_color.mediana TV_color.desviacion_estandar TV_color.minimo
## 1 97.38889 97.85 1.944189 91.3
## TV_color.maximo TV_color.asimetria TV_color.curtosis TV_color.percentil_25
## 1 99.4 -1.873859 6.438271 97.15
## TV_color.percentil_75 TV_color.rango_intercuartilico Video.media
## 1 98.55 1.4 58.49444
## Video.mediana Video.desviacion_estandar Video.minimo Video.maximo
## 1 59.95 9.37007 42.7 76.3
## Video.asimetria Video.curtosis Video.percentil_25 Video.percentil_75
## 1 -0.0002878899 2.261381 52.475 62.625
## Video.rango_intercuartilico Micro_ondas.media Micro_ondas.mediana
## 1 10.15 31.85 28.95
## Micro_ondas.desviacion_estandar Micro_ondas.minimo Micro_ondas.maximo
## 1 10.99857 13.5 53.9
## Micro_ondas.asimetria Micro_ondas.curtosis Micro_ondas.percentil_25
## 1 0.3307166 2.16761 24.175
## Micro_ondas.percentil_75 Micro_ondas.rango_intercuartilico
## 1 41.75 17.575
## Lava_vajillas.media Lava_vajillas.mediana Lava_vajillas.desviacion_estandar
## 1 15.35 13.65 6.379402
## Lava_vajillas.minimo Lava_vajillas.maximo Lava_vajillas.asimetria
## 1 5.8 32.3 0.9440683
## Lava_vajillas.curtosis Lava_vajillas.percentil_25 Lava_vajillas.percentil_75
## 1 3.904478 11.8 19.25
## Lava_vajillas.rango_intercuartilico Teléfono.media Teléfono.mediana
## 1 7.45 83.88333 85.1
## Teléfono.desviacion_estandar Teléfono.minimo Teléfono.maximo
## 1 7.545022 67.1 95.7
## Teléfono.asimetria Teléfono.curtosis Teléfono.percentil_25
## 1 -0.5423679 2.759454 80.725
## Teléfono.percentil_75 Teléfono.rango_intercuartilico
## 1 88.05 7.325
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -Graficas de Visualizacion
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Visualización de la media y mediana
ggplot(datos, aes(x = "", y = Automóvil)) +
geom_boxplot() +
labs(title = "Distribución del porcentaje de hogares con Automóvil", y = "Porcentaje de hogares") +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "red", fill = "red") +
stat_summary(fun = median, geom = "point", shape = 20, size = 3, color = "blue", fill = "blue")
# Visualización de la desviación estándar
ggplot(datos, aes(x = CCAA, y = Automóvil)) +
geom_bar(stat = "identity", fill = "orange") +
labs(title = "Porcentaje de hogares con Automóvil por CCAA", x = "CCAA", y = "Porcentaje de hogares") +
geom_errorbar(aes(ymin = Automóvil - sd(Automóvil), ymax = Automóvil + sd(Automóvil)), width = 0.2)
# Visualización de la asimetría y curtosis
ggplot(datos, aes(x = "", y = Automóvil)) +
geom_violin() +
labs(title = "Distribución de Automóvil con asimetría y curtosis", y = "Porcentaje de hogares") +
geom_jitter(width = 0.1, height = 0, alpha = 0.5)
# Visualización de la media y mediana para TV_color
ggplot(datos, aes(x = "", y = TV_color)) +
geom_boxplot() +
labs(title = "Distribución del porcentaje de hogares con TV color", y = "Porcentaje de hogares") +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "purple", fill = "purple") +
stat_summary(fun = median, geom = "point", shape = 20, size = 3, color = "green", fill = "green")
# Visualización de la desviación estándar para TV_color
ggplot(datos, aes(x = CCAA, y = TV_color)) +
geom_bar(stat = "identity", fill = "brown") +
labs(title = "Porcentaje de hogares con TV color por CCAA", x = "CCAA", y = "Porcentaje de hogares") +
geom_errorbar(aes(ymin = TV_color - sd(TV_color), ymax = TV_color + sd(TV_color)), width = 0.2)
# Visualización de la asimetría y curtosis para TV_color
ggplot(datos, aes(x = "", y = TV_color)) +
geom_violin() +
labs(title = "Distribución de TV color con asimetría y curtosis", y = "Porcentaje de hogares") +
geom_jitter(width = 0.1, height = 0, alpha = 0.5)
# Visualización de la media y mediana para Video
ggplot(datos, aes(x = "", y = Video)) +
geom_boxplot() +
labs(title = "Distribución del porcentaje de hogares con Video", y = "Porcentaje de hogares") +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "orange", fill = "orange") +
stat_summary(fun = median, geom = "point", shape = 20, size = 3, color = "pink", fill = "pink")
# Visualización de la desviación estándar para Video
ggplot(datos, aes(x = CCAA, y = Video)) +
geom_bar(stat = "identity", fill = "blue") +
labs(title = "Porcentaje de hogares con Video por CCAA", x = "CCAA", y = "Porcentaje de hogares") +
geom_errorbar(aes(ymin = Video - sd(Video), ymax = Video + sd(Video)), width = 0.2)
# Visualización de la asimetría y curtosis para Video
ggplot(datos, aes(x = "", y = Video)) +
geom_violin() +
labs(title = "Distribución de Video con asimetría y curtosis", y = "Porcentaje de hogares") +
geom_jitter(width = 0.1, height = 0, alpha = 0.5)
# Visualización de la media y mediana para Micro_ondas
ggplot(datos, aes(x = "", y = Micro_ondas)) +
geom_boxplot() +
labs(title = "Distribución del porcentaje de hogares con Micro_ondas", y = "Porcentaje de hogares") +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "green", fill = "green") +
stat_summary(fun = median, geom = "point", shape = 20, size = 3, color = "purple", fill = "purple")
# Visualización de la desviación estándar para Micro_ondas
ggplot(datos, aes(x = CCAA, y = Micro_ondas)) +
geom_bar(stat = "identity", fill = "pink") +
labs(title = "Porcentaje de hogares con Micro_ondas por CCAA", x = "CCAA", y = "Porcentaje de hogares") +
geom_errorbar(aes(ymin = Micro_ondas - sd(Micro_ondas), ymax = Micro_ondas + sd(Micro_ondas)), width = 0.2)
# Visualización de la asimetría y curtosis para Micro_ondas
ggplot(datos, aes(x = "", y = Micro_ondas)) +
geom_violin() +
labs(title = "Distribución de Micro_ondas con asimetría y curtosis", y = "Porcentaje de hogares") +
geom_jitter(width = 0.1, height = 0, alpha = 0.5)
# Visualización de la media y mediana para Lava_vajillas
ggplot(datos, aes(x = "", y = Lava_vajillas)) +
geom_boxplot() +
labs(title = "Distribución del porcentaje de hogares con Lava_vajillas", y = "Porcentaje de hogares") +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "blue", fill = "blue") +
stat_summary(fun = median, geom = "point", shape = 20, size = 3, color = "orange", fill = "orange")
# Visualización de la desviación estándar para Lava_vajillas
ggplot(datos, aes(x = CCAA, y = Lava_vajillas)) +
geom_bar(stat = "identity", fill = "red") +
labs(title = "Porcentaje de hogares con Lava_vajillas por CCAA", x = "CCAA", y = "Porcentaje de hogares") +
geom_errorbar(aes(ymin = Lava_vajillas - sd(Lava_vajillas), ymax = Lava_vajillas + sd(Lava_vajillas)), width = 0.2)
# Visualización de la asimetría y curtosis para Lava_vajillas
ggplot(datos, aes(x = "", y = Lava_vajillas)) +
geom_violin() +
labs(title = "Distribución de Lava_vajillas con asimetría y curtosis", y = "Porcentaje de hogares") +
geom_jitter(width = 0.1, height = 0, alpha = 0.5)
# Visualización de la media y mediana para Teléfono
ggplot(datos, aes(x = "", y = Teléfono)) +
geom_boxplot() +
labs(title = "Distribución del porcentaje de hogares con Teléfono", y = "Porcentaje de hogares") +
stat_summary(fun = mean, geom = "point", shape = 20, size = 3, color = "pink", fill = "pink") +
stat_summary(fun = median, geom = "point", shape = 20, size = 3, color = "green", fill = "green")
# Visualización de la desviación estándar para Teléfono
ggplot(datos, aes(x = CCAA, y = Teléfono)) +
geom_bar(stat = "identity", fill = "yellow") +
labs(title = "Porcentaje de hogares con Teléfono por CCAA", x = "CCAA", y = "Porcentaje de hogares") +
geom_errorbar(aes(ymin = Teléfono - sd(Teléfono), ymax = Teléfono + sd(Teléfono)), width = 0.2)
# Visualización de la asimetría y curtosis para Teléfono
ggplot(datos, aes(x = "", y = Teléfono)) +
geom_violin() +
labs(title = "Distribución de Teléfono con asimetría y curtosis", y = "Porcentaje de hogares") +
geom_jitter(width = 0.1, height = 0, alpha = 0.5)
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Normalizamos los datos (es recomendable para el clustering)
datos_normalizados <- datos %>%
select(-CCAA) %>%
scale()
# Realizamos el clustering k-means con un número predefinido de clusters, por ejemplo, 3
set.seed(123) # Para reproducibilidad
clusters <- kmeans(datos_normalizados, centers = 3)
# Añadimos los resultados de los clusters al data frame original
datos$cluster <- as.factor(clusters$cluster)
# Mostramos el data frame con los clusters
print(datos)
## CCAA Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## 1 España 69.0 97.6 62.4 32.3 17.0 85.2
## 2 Andalucía 66.7 98.0 62.7 24.1 12.7 74.7
## 3 Aragón 67.2 97.5 56.8 43.4 20.6 88.4
## 4 Asturias 63.7 95.2 52.1 24.4 13.3 88.1
## 5 Baleares 71.9 98.8 62.4 29.8 10.1 87.9
## 6 Canarias 72.7 96.8 68.4 27.9 5.8 75.4
## 7 Cantabria 63.4 94.9 48.9 36.5 11.2 80.5
## 8 Cast. y León 65.8 97.1 47.7 28.1 14.0 85.0
## 9 C.-La Mancha 61.5 97.3 53.6 21.7 7.1 72.9
## 10 Cataluña 70.4 98.1 71.1 36.8 19.8 92.2
## 11 Com. Valenciana 72.7 98.4 68.2 26.6 12.1 84.4
## 12 Extremadura 60.5 97.7 43.7 20.7 11.7 67.1
## 13 Galicia 65.5 91.3 42.7 13.5 14.6 85.9
## 14 Madrid 74.0 99.4 76.3 53.9 32.3 95.7
## 15 Murcia 69.0 98.7 59.3 19.5 12.1 81.4
## 16 Navarra 76.4 99.3 60.6 44.0 20.6 87.4
## 17 País Vasco 71.3 98.3 61.6 45.7 23.7 94.3
## 18 La Rioja 64.9 98.6 54.4 44.4 17.6 83.4
## cluster
## 1 3
## 2 1
## 3 3
## 4 1
## 5 3
## 6 1
## 7 1
## 8 1
## 9 1
## 10 3
## 11 3
## 12 1
## 13 1
## 14 2
## 15 1
## 16 3
## 17 3
## 18 3
# Visualizamos los clusters usando un par de variables
ggplot(datos, aes(x = Automóvil, y = TV_color, color = cluster)) +
geom_point(size = 4) +
labs(title = "Clusters de Comunidades Autónomas", x = "Porcentaje de hogares con Automóvil", y = "Porcentaje de hogares con TV color", color = "Cluster")
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -ESTADISTICAS PCA-
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Realizamos PCA con prcomp
pca_prcomp <- prcomp(datos_normalizados)
# Realizamos PCA con PCA de FactoMineR
pca_fmr <- PCA(datos_normalizados)
# Visualizamos los resultados de PCA con fviz_pca_ind
fviz_pca_ind(pca_fmr, geom.ind = "point", col.ind = "cos2", repel = TRUE)
# Visualizamos los resultados de PCA con fviz_pca_var
fviz_pca_var(pca_fmr, col.var = "contrib")
# Gráfico de barras de eigenvalores
fviz_screeplot(pca_fmr)
# Contribución de filas/columnas
fviz_contrib(pca_fmr, choice = "var", axes = 1:2)
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -Test de Normalidad Multivariante
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Test de normalidad multivariante
#library(MVN)
normalidad <- mvn(datos_normalizados, mvnTest = "mardia")
normalidad
## $multivariateNormality
## Test Statistic p value Result
## 1 Mardia Skewness 76.860308252602 0.0336194873113301 NO
## 2 Mardia Kurtosis 0.157432015144676 0.874904383606325 YES
## 3 MVN <NA> <NA> NO
##
## $univariateNormality
## Test Variable Statistic p value Normality
## 1 Anderson-Darling Automóvil 0.1795 0.9022 YES
## 2 Anderson-Darling TV_color 1.2023 0.0028 NO
## 3 Anderson-Darling Video 0.1770 0.9066 YES
## 4 Anderson-Darling Micro_ondas 0.3426 0.4503 YES
## 5 Anderson-Darling Lava_vajillas 0.4521 0.2415 YES
## 6 Anderson-Darling Teléfono 0.3601 0.4086 YES
##
## $Descriptives
## n Mean Std.Dev Median Min Max
## Automóvil 18 7.863477e-17 1 -0.009860024 -1.695924 1.831499
## TV_color 18 1.224347e-15 1 0.237174065 -3.131841 1.034422
## Video 18 -2.482522e-16 1 0.155340956 -1.685627 1.900259
## Micro_ondas 18 -1.842421e-16 1 -0.263670655 -1.668399 2.004806
## Lava_vajillas 18 3.469447e-17 1 -0.266482675 -1.497006 2.656989
## Teléfono 18 -5.389166e-16 1 0.161254230 -2.224425 1.566154
## 25th 75th Skew Kurtosis
## Automóvil -0.6865042 0.7998945 0.0276519735 -1.1881907
## TV_color -0.1228733 0.5972214 -1.7198931020 2.7427792
## Video -0.6424119 0.4408244 -0.0002642355 -0.9829037
## Micro_ondas -0.6978180 0.9001171 0.3035432825 -1.0665452
## Lava_vajillas -0.5564785 0.6113426 0.8664989674 0.4826976
## Teléfono -0.4185983 0.5522405 -0.4978042099 -0.5386352
# Mostrando las correlaciones entre las variables
cor <- cor(datos_normalizados)
cor
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## Automóvil 1.0000000 0.4844213 0.7846040 0.4806715 0.4251273 0.5687918
## TV_color 0.4844213 1.0000000 0.6245522 0.5184366 0.3176238 0.1232964
## Video 0.7846040 0.6245522 1.0000000 0.4918706 0.3902203 0.4278038
## Micro_ondas 0.4806715 0.5184366 0.4918706 1.0000000 0.7799216 0.6167669
## Lava_vajillas 0.4251273 0.3176238 0.3902203 0.7799216 1.0000000 0.7484758
## Teléfono 0.5687918 0.1232964 0.4278038 0.6167669 0.7484758 1.0000000
# Prueba de correlación
#library(psych)
correlation_test <- corr.test(datos_normalizados)
## Warning in abbreviate(rownames(r), minlength = minlength): abreviatura
## utilizada con caracteres no ASCII
## Warning in abbreviate(colnames(r), minlength = minlength): abreviatura
## utilizada con caracteres no ASCII
## Warning in abbreviate(dimnames(ans)[[2L]], minlength = abbr.colnames):
## abreviatura utilizada con caracteres no ASCII
## Warning in abbreviate(dimnames(ans)[[2L]], minlength = abbr.colnames):
## abreviatura utilizada con caracteres no ASCII
correlation_test
## Call:corr.test(x = datos_normalizados)
## Correlation matrix
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## Automóvil 1.00 0.48 0.78 0.48 0.43 0.57
## TV_color 0.48 1.00 0.62 0.52 0.32 0.12
## Video 0.78 0.62 1.00 0.49 0.39 0.43
## Micro_ondas 0.48 0.52 0.49 1.00 0.78 0.62
## Lava_vajillas 0.43 0.32 0.39 0.78 1.00 0.75
## Teléfono 0.57 0.12 0.43 0.62 0.75 1.00
## Sample Size
## [1] 18
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## Automóvil 0.00 0.31 0.00 0.31 0.38 0.14
## TV_color 0.04 0.00 0.07 0.25 0.40 0.63
## Video 0.00 0.01 0.00 0.31 0.38 0.38
## Micro_ondas 0.04 0.03 0.04 0.00 0.00 0.07
## Lava_vajillas 0.08 0.20 0.11 0.00 0.00 0.00
## Teléfono 0.01 0.63 0.08 0.01 0.00 0.00
##
## To see confidence intervals of the correlations, print with the short=FALSE option
# Para ver los intervalos de confianza de las correlaciones, imprimir con la opción short = FALSE
print(correlation_test, short = FALSE)
## Call:corr.test(x = datos_normalizados)
## Correlation matrix
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## Automóvil 1.00 0.48 0.78 0.48 0.43 0.57
## TV_color 0.48 1.00 0.62 0.52 0.32 0.12
## Video 0.78 0.62 1.00 0.49 0.39 0.43
## Micro_ondas 0.48 0.52 0.49 1.00 0.78 0.62
## Lava_vajillas 0.43 0.32 0.39 0.78 1.00 0.75
## Teléfono 0.57 0.12 0.43 0.62 0.75 1.00
## Sample Size
## [1] 18
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## Automóvil 0.00 0.31 0.00 0.31 0.38 0.14
## TV_color 0.04 0.00 0.07 0.25 0.40 0.63
## Video 0.00 0.01 0.00 0.31 0.38 0.38
## Micro_ondas 0.04 0.03 0.04 0.00 0.00 0.07
## Lava_vajillas 0.08 0.20 0.11 0.00 0.00 0.00
## Teléfono 0.01 0.63 0.08 0.01 0.00 0.00
##
## Confidence intervals based upon normal theory. To get bootstrapped values, try cor.ci
## raw.lower raw.r raw.upper raw.p lower.adj upper.adj
## Atmvl-TV_cl 0.02 0.48 0.78 0.04 -0.16 0.84
## Atmvl-Video 0.50 0.78 0.92 0.00 0.29 0.95
## Atmvl-Mcr_n 0.02 0.48 0.77 0.04 -0.16 0.84
## Atmvl-Lv_vj -0.05 0.43 0.74 0.08 -0.19 0.80
## Atmvl-Telfn 0.14 0.57 0.82 0.01 -0.08 0.88
## TV_cl-Video 0.22 0.62 0.85 0.01 -0.01 0.90
## TV_cl-Mcr_n 0.07 0.52 0.79 0.03 -0.14 0.86
## TV_cl-Lv_vj -0.18 0.32 0.68 0.20 -0.24 0.72
## TV_cl-Telfn -0.36 0.12 0.56 0.63 -0.36 0.56
## Video-Mcr_n 0.03 0.49 0.78 0.04 -0.17 0.85
## Video-Lv_vj -0.09 0.39 0.73 0.11 -0.20 0.77
## Video-Telfn -0.05 0.43 0.75 0.08 -0.20 0.81
## Mcr_n-Lv_vj 0.49 0.78 0.91 0.00 0.28 0.95
## Mcr_n-Telfn 0.21 0.62 0.84 0.01 -0.01 0.90
## Lv_vj-Telfn 0.43 0.75 0.90 0.00 0.22 0.94
# Gráfico de dispersión bi-variable
pairs(datos_normalizados)
# Gráfico de correlación con ggcorr
#library(ggcorr)
ggcorr(datos_normalizados)
# Gráfico de red de correlación
#library(network)
network_plot(cor)
# Gráfico de dispersión bi-variable
pairs(datos_normalizados)
plot(datos_normalizados, pch = '*', col = c("red", "green", "blue", "orange"))
ggcorr(datos_normalizados)
network_plot(cor)
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -# Prueba de Bartlett, Kaiser Meyer Olkin y MSA
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Cargamos las librerías necesarias
library(psych)
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.3.3
## corrplot 0.92 loaded
library(ggcorrplot)
library(MVN)
# Suponiendo que 'datos_normalizados' ya está definido
# Si no lo está, usa los datos adecuados para tu análisis
# Prueba de Bartlett
# Realizamos la Prueba de Esfericidad de Bartlett sobre la matriz de correlación de los datos
bartlett_test <- cortest.bartlett(cor(datos_normalizados), n = nrow(datos_normalizados))
print(bartlett_test)
## $chisq
## [1] 57.97254
##
## $p.value
## [1] 5.607915e-07
##
## $df
## [1] 15
# Prueba Kaiser Meyer Olkin y MSA
KMO_result <- KMO(datos_normalizados)
print(KMO_result)
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_normalizados)
## Overall MSA = 0.73
## MSA for each item =
## Automóvil TV_color Video Micro_ondas Lava_vajillas
## 0.74 0.67 0.76 0.79 0.73
## Teléfono
## 0.69
# Histogramas escalados
multi.hist(x = datos_normalizados, dcol = c("blue", "red"), dlty = c("dotted", "solid"), main = "")
# Prueba de normalidad con el test de Mardia
normalidad <- mvn(datos_normalizados, mvnTest = "mardia")
print(normalidad$multivariateNormality)
## Test Statistic p value Result
## 1 Mardia Skewness 76.860308252602 0.0336194873113301 NO
## 2 Mardia Kurtosis 0.157432015144676 0.874904383606325 YES
## 3 MVN <NA> <NA> NO
# Estudio de la correlación
correlation <- cor(datos_normalizados)
print(correlation)
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## Automóvil 1.0000000 0.4844213 0.7846040 0.4806715 0.4251273 0.5687918
## TV_color 0.4844213 1.0000000 0.6245522 0.5184366 0.3176238 0.1232964
## Video 0.7846040 0.6245522 1.0000000 0.4918706 0.3902203 0.4278038
## Micro_ondas 0.4806715 0.5184366 0.4918706 1.0000000 0.7799216 0.6167669
## Lava_vajillas 0.4251273 0.3176238 0.3902203 0.7799216 1.0000000 0.7484758
## Teléfono 0.5687918 0.1232964 0.4278038 0.6167669 0.7484758 1.0000000
# Gráfico de correlación (heatmap)
corrplot(correlation, method = "color", type = "lower", addCoef.col = "black", tl.col = "black", tl.srt = 45)
# Gráfico de correlación con ggcorrplot
ggcorrplot(correlation, hc.order = TRUE, type = "lower")
#install.packages(c("psych", "corrplot", "ggcorrplot", "MVN"))
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -Usando librería ade4
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Cargamos la librería ade4
#library(ade4)
# Realizamos el análisis de componentes principales (PCA)
acp <- dudi.pca(datos_normalizados, scannf = FALSE, nf = ncol(datos_normalizados))
acp$co
## Comp1 Comp2 Comp3 Comp4 Comp5
## Automóvil -0.8068065 -0.2714366 0.4359703 0.08787048 0.21950408
## TV_color -0.6388589 -0.5817640 -0.4386610 0.23650679 -0.03645527
## Video -0.7961377 -0.4506109 0.2295796 -0.24253170 -0.21790849
## Micro_ondas -0.8416096 0.2169261 -0.3684530 -0.21336765 0.24032273
## Lava_vajillas -0.7963584 0.4802264 -0.2034997 0.02794211 -0.18991195
## Teléfono -0.7619911 0.5044820 0.2859274 0.16853217 -0.04113214
## Comp6
## Automóvil -0.17149956
## TV_color 0.06100901
## Video 0.06404738
## Micro_ondas 0.07481942
## Lava_vajillas -0.23861354
## Teléfono 0.23025655
# Rotación de las componentes
facto <- principal(r = datos_normalizados, nfactors = 3, rotate = "varimax")
facto
## Principal Components Analysis
## Call: principal(r = datos_normalizados, nfactors = 3, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC3 RC2 h2 u2 com
## Automóvil 0.28 0.90 0.18 0.91 0.085 1.3
## TV_color 0.12 0.32 0.91 0.94 0.061 1.3
## Video 0.19 0.82 0.42 0.89 0.110 1.6
## Micro_ondas 0.81 0.17 0.46 0.89 0.109 1.7
## Lava_vajillas 0.92 0.15 0.17 0.91 0.094 1.1
## Teléfono 0.82 0.45 -0.20 0.92 0.083 1.7
##
## RC1 RC3 RC2
## SS loadings 2.31 1.84 1.31
## Proportion Var 0.38 0.31 0.22
## Cumulative Var 0.38 0.69 0.91
## Proportion Explained 0.42 0.34 0.24
## Cumulative Proportion 0.42 0.76 1.00
##
## Mean item complexity = 1.5
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.04
## with the empirical chi square 0.87 with prob < NA
##
## Fit based upon off diagonal values = 0.99
facto$values
## [1] 3.6160365 1.1473538 0.6941245 0.1971879 0.1925085 0.1527887
# Obtenemos las puntuaciones de las componentes
scores <- facto$scores
# Graficamos las puntuaciones para tres dimensiones
#library(scatterplot3d)
scatterplot3d(scores, angle = 35, col.grid = "lightblue", main = "Gráfica de las puntuaciones", pch = 20)
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -la Prueba de Shapiro-Wilk
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Prueba de Shapiro-Wilk
#library(nortest)
resultados_shapiro<-0
# Realizar la prueba de Shapiro-Wilk para cada variable
resultados_shapiro <- lapply(datos_normalizados[, 0], shapiro.test)
# Mostrar los resultados
for (i in seq_along(resultados_shapiro)) {
cat("Variable:", names(datos_normalizados)[i + 1], "\n")
cat("p-valor de la prueba de Shapiro-Wilk:", resultados_shapiro[[i]]$p.value, "\n")
if (resultados_shapiro[[i]]$p.value > 0.05) {
cat("No se rechaza la hipótesis nula de normalidad.\n")
} else {
cat("Se rechaza la hipótesis nula de normalidad.\n")
}
}
# Cargamos la biblioteca necesaria
#library(stats)
# Seleccionamos las columnas relevantes para el clustering
datos_clustering <- datos[, -1] # Excluimos la columna de nombres de CCAA
# Realizamos el clustering K-means con 3 clusters (puedes ajustar este número según lo necesites)
num_clusters <- 3
kmeans_result <- kmeans(datos_clustering, centers = num_clusters)
# Mostramos los resultados del clustering
kmeans_result
## K-means clustering with 3 clusters of sizes 6, 6, 6
##
## Cluster means:
## Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono cluster
## 1 70.70000 98.53333 63.46667 44.70 22.43333 90.23333 2.833333
## 2 70.33333 98.05000 63.90000 26.70 11.63333 81.50000 2.000000
## 3 63.40000 95.58333 48.11667 24.15 11.98333 79.91667 1.000000
##
## Clustering vector:
## [1] 2 2 1 3 2 2 3 3 3 1 2 3 3 1 2 1 1 1
##
## Within cluster sum of squares by cluster:
## [1] 849.1867 419.4217 825.6883
## (between_SS / total_SS = 62.8 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"
# Gráfico de los clusters
#library(cluster)
clusplot(datos_clustering, kmeans_result$cluster, color=TRUE, shade=TRUE, labels=2, lines=0)
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Agregamos los clusters asignados al conjunto de datos
datos_clusterizado <- cbind(datos, "Cluster" = kmeans_result$cluster)
# Graficamos los datos con los colores representando los clusters
ggplot(datos_clusterizado, aes(x = Automóvil, y = TV_color, color = factor(Cluster))) +
geom_point() +
labs(title = "Clustering K-means de Consumo de Automóviles vs. TV color",
x = "Automóvil", y = "TV color", color = "Cluster") +
theme_minimal()
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -# Visualización de los clusters con centroides
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#library(ggplot2)
# Creamos un dataframe con los datos clusterizados y los centroides
datos_clusterizado <- cbind(datos_clustering, Cluster = kmeans_result$cluster)
centroides <- as.data.frame(kmeans_result$centers)
centroides$Cluster <- row.names(centroides)
# Graficamos los puntos de datos y los centroides
ggplot(datos_clusterizado, aes(x = Automóvil, y = TV_color, color = factor(Cluster))) +
geom_point() +
geom_point(data = centroides, aes(x = Automóvil, y = TV_color), color = "black", shape = 4, size = 3) +
geom_text(data = centroides, aes(x = Automóvil, y = TV_color, label = paste("Cluster", Cluster)), vjust = -1) +
labs(title = "Clustering K-means de Consumo de Automóviles vs. TV color",
x = "Automóvil", y = "TV color", color = "Cluster") +
theme_minimal()
# Resumen de la asignación de datos a los clusters
summary(kmeans_result$cluster)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1 1 2 2 3 3
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -# * Distancias y Clustering Jerárquico:
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Creamos un dataframe con los datos clusterizados y los centroides
#datos_clusterizado <- cbind(datos_clustering, Cluster = kmeans_result$cluster)
#centroides <- as.data.frame(kmeans_result$centers)
#centroides$Cluster <- row.names(centroides)
# Graficamos los puntos de datos y los centroides utilizando ggplot2
#library(ggplot2)
ggplot(datos_clusterizado, aes(x = Automóvil, y = TV_color, color = factor(Cluster))) +
geom_point() + # Agregamos los puntos de datos
geom_point(data = centroides, aes(x = Automóvil, y = TV_color), color = "black", shape = 4, size = 3) + # Agregamos los centroides
geom_text(data = centroides, aes(x = Automóvil, y = TV_color, label = paste("Cluster", Cluster)), vjust = -1) + # Etiquetamos los centroides
labs(title = "Clustering K-means de Consumo de Automóviles vs. TV color",
x = "Porcentaje de hogares con Automóvil", y = "Porcentaje de hogares con TV color", color = "Cluster") # Etiquetas de los ejes y leyenda
# Aplicamos K-means clustering con 3 clusters, 25 configuraciones iniciales
set.seed(123)
kmeans_result <- kmeans(datos_normalizados, centers = 3, nstart = 25)
# Agregamos los resultados de los clusters al dataframe original
datos_clusterizado <- datos %>%
mutate(Cluster = kmeans_result$cluster)
# Definimos los centroides
centroides <- as.data.frame(kmeans_result$centers)
centroides$Cluster <- row.names(centroides)
# Graficamos los puntos de datos y los centroides utilizando ggplot2
ggplot(datos_clusterizado, aes(x = Automóvil, y = TV_color, color = factor(Cluster))) +
geom_point() + # Agregamos los puntos de datos
geom_point(data = centroides, aes(x = Automóvil, y = TV_color), color = "black", shape = 4, size = 3) + # Agregamos los centroides
geom_text(data = centroides, aes(x = Automóvil, y = TV_color, label = paste("Cluster", Cluster)), vjust = -1) + # Etiquetamos los centroides
labs(title = "Clustering K-means de Consumo de Automóviles vs. TV color",
x = "Porcentaje de hogares con Automóvil", y = "Porcentaje de hogares con TV color", color = "Cluster") # Etiquetas de los ejes y leyenda
# Visualizamos los clusters generados por K-means
fviz_cluster(kmeans_result, data = datos_normalizados, geom = "point", ellipse.type = "convex", palette = "jco")
# Resumen de la asignación de datos a los clusters
print(summary(kmeans_result$cluster))
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1 1 2 2 3 3
# Calculamos la matriz de distancias usando la distancia euclidiana
mat_dist <- dist(x = datos_normalizados, method = "euclidean")
# Aplicamos clustering jerárquico con enlace completo y enlace promedio
hc_complete <- hclust(d = mat_dist, method = "complete")
hc_average <- hclust(d = mat_dist, method = "average")
# Ajustamos el tamaño del gráfico dendrograma
par(mfrow = c(2, 1))
options(repr.plot.width = 10, repr.plot.height = 12) # Cambiar el tamaño del gráfico
# Visualizamos los dendrogramas
plot(hc_complete, main = "Dendrograma (Complete Linkage)", xlab = "", sub = "", cex = 0.6)
plot(hc_average, main = "Dendrograma (Average Linkage)", xlab = "", sub = "", cex = 0.6)
# Graficar las agrupaciones por colores
plot(hc_complete, main = "Agrupaciones por colores (Complete Linkage)", sub = "", cex = 0.6)
rect.hclust(hc_complete, k = 3, border = "red") # Cambiar el número de grupos (k) y el color del borde según sea necesario
# Graficar el corte realizado en el dendrograma
plot(hc_complete, main = "Corte en el dendrograma (Complete Linkage)", sub = "", cex = 0.6)
abline(h = 10, col = "red") # Cambiar la altura del corte (h) y el color según sea necesario
# Ejecutamos PAM clustering con 4 clusters y métrica de distancia Manhattan
pam_clusters <- pam(x = datos_normalizados, k = 4, metric = "manhattan")
# Ejecutamos K-means clustering con 3 clusters para reproducibilidad
set.seed(123)
km_clusters <- kmeans(datos_normalizados, centers = 3, nstart = 25)
# Visualizamos los clusters generados por PAM
fviz_cluster(pam_clusters, data = datos_normalizados, geom = "point", ellipse.type = "convex", palette = "jco")
# Calculamos el coeficiente de silueta para PAM
silhouette_pam <- silhouette(pam_clusters$clustering, dist(datos_normalizados))
# Calculamos el coeficiente de silueta para K-Means
silhouette_kmeans <- silhouette(km_clusters$cluster, dist(datos_normalizados))
# Calculamos el coeficiente de silueta para CLARA
clara_clusters <- clara(datos_normalizados, k = 3)
silhouette_clara <- silhouette(clara_clusters$clustering, dist(datos_normalizados))
# Gráficos de Silueta
fviz_silhouette(silhouette_pam)
## cluster size ave.sil.width
## 1 1 6 0.35
## 2 2 5 0.27
## 3 3 5 0.13
## 4 4 2 0.51
fviz_silhouette(silhouette_kmeans)
## cluster size ave.sil.width
## 1 1 6 0.22
## 2 2 6 0.38
## 3 3 6 0.18
fviz_silhouette(silhouette_clara)
## cluster size ave.sil.width
## 1 1 8 0.25
## 2 2 6 0.18
## 3 3 4 0.28
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -# * RESULTADO
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Crear una copia del dataframe original
datoo <- datos
# Normalizar los datos (excepto la columna de nombres)
datos_normalizados <- as.data.frame(scale(datoo[,0]))
# Aplicar K-means clustering con 4 clusters
#set.seed(123)
#kmeans_result1 <- kmeans(datos_normalizados2, centers = 4)
# Aplicar K-means clustering con 3 clusters
#set.seed(123)
#kmeans_result <- kmeans(datos_normalizados, centers = 3)
# Agregar los resultados de los clusters al dataframe original
#datos_clusterizado <- kmeans_result2 %>%
# mutate(Cluster = kmeans_result$cluster)
# Ver el dataframe con los clusters asignados
print(datos_clusterizado)
## CCAA Automóvil TV_color Video Micro_ondas Lava_vajillas Teléfono
## 1 España 69.0 97.6 62.4 32.3 17.0 85.2
## 2 Andalucía 66.7 98.0 62.7 24.1 12.7 74.7
## 3 Aragón 67.2 97.5 56.8 43.4 20.6 88.4
## 4 Asturias 63.7 95.2 52.1 24.4 13.3 88.1
## 5 Baleares 71.9 98.8 62.4 29.8 10.1 87.9
## 6 Canarias 72.7 96.8 68.4 27.9 5.8 75.4
## 7 Cantabria 63.4 94.9 48.9 36.5 11.2 80.5
## 8 Cast. y León 65.8 97.1 47.7 28.1 14.0 85.0
## 9 C.-La Mancha 61.5 97.3 53.6 21.7 7.1 72.9
## 10 Cataluña 70.4 98.1 71.1 36.8 19.8 92.2
## 11 Com. Valenciana 72.7 98.4 68.2 26.6 12.1 84.4
## 12 Extremadura 60.5 97.7 43.7 20.7 11.7 67.1
## 13 Galicia 65.5 91.3 42.7 13.5 14.6 85.9
## 14 Madrid 74.0 99.4 76.3 53.9 32.3 95.7
## 15 Murcia 69.0 98.7 59.3 19.5 12.1 81.4
## 16 Navarra 76.4 99.3 60.6 44.0 20.6 87.4
## 17 País Vasco 71.3 98.3 61.6 45.7 23.7 94.3
## 18 La Rioja 64.9 98.6 54.4 44.4 17.6 83.4
## cluster Cluster
## 1 3 2
## 2 1 2
## 3 3 1
## 4 1 3
## 5 3 2
## 6 1 2
## 7 1 3
## 8 1 3
## 9 1 3
## 10 3 1
## 11 3 2
## 12 1 3
## 13 1 3
## 14 2 1
## 15 1 2
## 16 3 1
## 17 3 1
## 18 3 1
#print(datos_clusterizado2)
# Graficar los puntos de datos
ggplot(datos_clusterizado, aes(x = Automóvil, y = TV_color, color = factor(Cluster))) +
geom_point() +
geom_text(aes(label = CCAA), vjust = -0.5, hjust = 0.5, size = 3) + # Agregar los nombres de las comunidades autónomas
labs(title = "Clustering K-means de Consumo de Automóviles vs. TV color",
x = "Porcentaje de hogares con Automóvil", y = "Porcentaje de hogares con TV color", color = "Cluster") +
theme_classic()
# Graficar los puntos de datos
#ggplot(datos_clusterizado2, aes(x = Automóvil, y = TV_color, color = factor(Cluster))) +
# geom_point() +
# geom_text(aes(label = CCAA), vjust = -0.5, hjust = 0.5, size = 3) + # Agregar los nombres de las comunidades autónomas
# labs(title = "Clustering K-means de Consumo de Automóviles vs. TV color",
# x = "Porcentaje de hogares con Automóvil", y = "Porcentaje de hogares con TV color", color = "Cluster") +
# theme_classic()
# Resumen de la asignación de datos a los clusters
summary(kmeans_result$cluster)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1 1 2 2 3 3
# Resumen de la asignación de datos a los clusters
#summary(kmeans_result$cluster)
# Graficar el histograma de las comunidades autónomas por clusters
ggplot(datos_clusterizado, aes(x = Cluster, fill = factor(Cluster))) +
geom_bar() +
scale_fill_manual(values = c("red", "blue", "green")) + # Puedes personalizar los colores aquí
labs(title = "Histograma de Comunidades Autónomas por Clusters",
x = "Cluster",
y = "Número de Comunidades Autónomas",
fill = "Cluster") +
theme_classic()
# Graficar el histograma de las comunidades autónomas por clusters
#ggplot(datos_clusterizado2, aes(x = Cluster, fill = factor(Cluster))) +
# geom_bar() +
# scale_fill_manual(values = c("red", "blue", "green")) + # Puedes personalizar los colores aquí
# labs(title = "Histograma de Comunidades Autónomas por Clusters",
# x = "Cluster",
# y = "Número de Comunidades Autónomas",
# fill = "Cluster") +
# theme_classic()
# Convertir a tabla para visualización
library(knitr)
## Warning: package 'knitr' was built under R version 4.3.3
kable(datos_clusterizado, caption = "Comunidades Autónomas y sus Clusters Asignados")
Comunidades Autónomas y sus Clusters Asignados
| España |
69.0 |
97.6 |
62.4 |
32.3 |
17.0 |
85.2 |
3 |
2 |
| Andalucía |
66.7 |
98.0 |
62.7 |
24.1 |
12.7 |
74.7 |
1 |
2 |
| Aragón |
67.2 |
97.5 |
56.8 |
43.4 |
20.6 |
88.4 |
3 |
1 |
| Asturias |
63.7 |
95.2 |
52.1 |
24.4 |
13.3 |
88.1 |
1 |
3 |
| Baleares |
71.9 |
98.8 |
62.4 |
29.8 |
10.1 |
87.9 |
3 |
2 |
| Canarias |
72.7 |
96.8 |
68.4 |
27.9 |
5.8 |
75.4 |
1 |
2 |
| Cantabria |
63.4 |
94.9 |
48.9 |
36.5 |
11.2 |
80.5 |
1 |
3 |
| Cast. y León |
65.8 |
97.1 |
47.7 |
28.1 |
14.0 |
85.0 |
1 |
3 |
| C.-La Mancha |
61.5 |
97.3 |
53.6 |
21.7 |
7.1 |
72.9 |
1 |
3 |
| Cataluña |
70.4 |
98.1 |
71.1 |
36.8 |
19.8 |
92.2 |
3 |
1 |
| Com. Valenciana |
72.7 |
98.4 |
68.2 |
26.6 |
12.1 |
84.4 |
3 |
2 |
| Extremadura |
60.5 |
97.7 |
43.7 |
20.7 |
11.7 |
67.1 |
1 |
3 |
| Galicia |
65.5 |
91.3 |
42.7 |
13.5 |
14.6 |
85.9 |
1 |
3 |
| Madrid |
74.0 |
99.4 |
76.3 |
53.9 |
32.3 |
95.7 |
2 |
1 |
| Murcia |
69.0 |
98.7 |
59.3 |
19.5 |
12.1 |
81.4 |
1 |
2 |
| Navarra |
76.4 |
99.3 |
60.6 |
44.0 |
20.6 |
87.4 |
3 |
1 |
| País Vasco |
71.3 |
98.3 |
61.6 |
45.7 |
23.7 |
94.3 |
3 |
1 |
| La Rioja |
64.9 |
98.6 |
54.4 |
44.4 |
17.6 |
83.4 |
3 |
1 |
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# -# * MAS INFORMACIONES
#
# # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# La visualización nos permite comprender mejor la distribución de los datos en los clusters identificados.
# 5. Visualización de Clusters con PCA:
# Visualizamos los clusters generados por K-Means, PAM y CLARA con PCA
# La visualización de clusters con PCA nos ayuda a reducir la dimensionalidad de los datos y visualizar las relaciones entre los clusters.
# 6. Comparación de Clusters:
# Comparamos los resultados de los diferentes algoritmos de clustering
# Comparar los resultados de varios algoritmos de clustering nos ayuda a seleccionar el método más adecuado para nuestros datos.
# 7. Evaluación de Clustering:
# Evaluamos la calidad de los clusters mediante el coeficiente de silueta
# El coeficiente de silueta nos proporciona una medida de la cohesión y separación de los clusters, ayudándonos a evaluar la calidad del clustering.