IKEA

1. Llamar Librerias

library (ggplot2)
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library (cluster)
library (data.table)
library (dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:data.table':
## 
##     between, first, last
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

2. Crear Bases de datos

df<-  data.frame(x=c(2,2,8,5,7,6,1,4),
                 y=c(10,5,4,8,5,4,2,9))

3. Determinar el número de grupos

grupos <- 3

4. Realizar la clasificación

segmentos <- kmeans(df,grupos)
segmentos
## K-means clustering with 3 clusters of sizes 2, 3, 3
## 
## Cluster means:
##          x        y
## 1 1.500000 3.500000
## 2 3.666667 9.000000
## 3 7.000000 4.333333
## 
## Clustering vector:
## [1] 2 1 3 2 3 3 1 2
## 
## Within cluster sum of squares by cluster:
## [1] 5.000000 6.666667 2.666667
##  (between_SS / total_SS =  85.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

5. Asignasión de grupos

asignación <- cbind(df,cluster=segmentos$cluster)
asignación
##   x  y cluster
## 1 2 10       2
## 2 2  5       1
## 3 8  4       3
## 4 5  8       2
## 5 7  5       3
## 6 6  4       3
## 7 1  2       1
## 8 4  9       2

6. Graficar resultados

fviz_cluster(segmentos,data=df,palette=c("red","blue","darkgreen"),
             ellipse.type="euclid",
             star.plot= T,
             repel=T,
             ggtheme=theme())
## Too few points to calculate an ellipse
## Too few points to calculate an ellipse
## Too few points to calculate an ellipse

7. Optimizar la cantidad de grupos

set.seed (123)
optimización <- clusGap(df,FUN=kmeans, nstart=1, K.max=7)
plot(optimización, xlab="Número de clusters k")

LS0tCnRpdGxlOiAiSUtFQSBDbHVzdGVycyIKYXV0aG9yOiAiUGF0cmljaW8gU2FuY2hleiAtIEEwMDgyNDMxMyIKZGF0ZTogIjA4LTEwLTIwMjMiCm91dHB1dDogCiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogVFJVRQogICAgdG9jX2Zsb2F0OiBUUlVFCiAgICBjb2RlX2Rvd25sb2FkOiBUUlVFCiAgICB0aGVtZTogInNpbXBsZXgiCiAgICBoaWdobGlnaHQ6ICJweWdtZW50cyIKLS0tCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+SUtFQTwvc3Bhbj4KCiFbXShpa2VhLnBuZykKCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij4xLiBMbGFtYXIgTGlicmVyaWFzPC9zcGFuPgpgYGB7cn0KbGlicmFyeSAoZ2dwbG90MikKbGlicmFyeShmYWN0b2V4dHJhKQpsaWJyYXJ5IChjbHVzdGVyKQpsaWJyYXJ5IChkYXRhLnRhYmxlKQpsaWJyYXJ5IChkcGx5cikKYGBgCgoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+Mi4gQ3JlYXIgQmFzZXMgZGUgZGF0b3M8L3NwYW4+ICAKYGBge3J9CmRmPC0gIGRhdGEuZnJhbWUoeD1jKDIsMiw4LDUsNyw2LDEsNCksCiAgICAgICAgICAgICAgICAgeT1jKDEwLDUsNCw4LDUsNCwyLDkpKQpgYGAKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPjMuIERldGVybWluYXIgZWwgbsO6bWVybyBkZSBncnVwb3M8L3NwYW4+ICAKYGBge3J9CmdydXBvcyA8LSAzCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+NC4gUmVhbGl6YXIgbGEgY2xhc2lmaWNhY2nDs248L3NwYW4+ICAKYGBge3J9CnNlZ21lbnRvcyA8LSBrbWVhbnMoZGYsZ3J1cG9zKQpzZWdtZW50b3MKYGBgCgojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsdWU7Ij41LiBBc2lnbmFzacOzbiBkZSBncnVwb3M8L3NwYW4+ICAKYGBge3J9CmFzaWduYWNpw7NuIDwtIGNiaW5kKGRmLGNsdXN0ZXI9c2VnbWVudG9zJGNsdXN0ZXIpCmFzaWduYWNpw7NuCmBgYAoKIyMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibHVlOyI+Ni4gR3JhZmljYXIgcmVzdWx0YWRvczwvc3Bhbj4gIApgYGB7ciB3YXJuaW5nPUZBTFNFfQpmdml6X2NsdXN0ZXIoc2VnbWVudG9zLGRhdGE9ZGYscGFsZXR0ZT1jKCJyZWQiLCJibHVlIiwiZGFya2dyZWVuIiksCiAgICAgICAgICAgICBlbGxpcHNlLnR5cGU9ImV1Y2xpZCIsCiAgICAgICAgICAgICBzdGFyLnBsb3Q9IFQsCiAgICAgICAgICAgICByZXBlbD1ULAogICAgICAgICAgICAgZ2d0aGVtZT10aGVtZSgpKQpgYGAKCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmx1ZTsiPjcuIE9wdGltaXphciBsYSBjYW50aWRhZCBkZSBncnVwb3M8L3NwYW4+ICAKYGBge3J9CnNldC5zZWVkICgxMjMpCm9wdGltaXphY2nDs24gPC0gY2x1c0dhcChkZixGVU49a21lYW5zLCBuc3RhcnQ9MSwgSy5tYXg9NykKcGxvdChvcHRpbWl6YWNpw7NuLCB4bGFiPSJOw7ptZXJvIGRlIGNsdXN0ZXJzIGsiKQpgYGAK