K-MEANS

Para saber si los datos son parecidos o diferentes el algoritmo K-medias utiliza la distancia entre los datos. Las observaciones que se parecen tendrán una menor distancia entre ellas. En general, como medida se utiliza la distancia euclideana aunque también se pueden utilizar otras funciones.

Funcionamiento:

Los algoritmos de clustering son considerados de aprendizaje no supervisado. Este tipo de algoritmos de aprendizaje no supervisado busca patrones en los datos sin tener una predicción específica como objetivo (no hay variable dependiente). En lugar de tener una salida, los datos solo tienen una entrada que serían las múltiples variables que describen los datos.

Etapas de k-MEANS.

El algoritmo consta de tres pasos:

1. Inicialización: una vez escogido el número de grupos, k, se establecen k centroides en el espacio de los datos, por ejemplo, escogiéndolos aleatoriamente.
2. Asignación objetos a los centroides: cada objeto de los datos es asignado a su centroide más cercano.
3. Actualización centroides: se actualiza la posición del centroide de cada grupo tomando como nuevo centroide la posición del promedio de los objetos pertenecientes a dicho grupo.

Clasificaciòn de algoritmos

1. Clasificación supervisada: disponemos de un conjunto de datos (por ejemplo, imágenes de letras escritas a mano) que vamos a llamar datos de entrenamiento y cada dato está asociado a una etiqueta (a qué letra corresponde cada imagen). Construímos un modelo en la fase de entrenamiento (training) utilizando dichas etiquetas, que nos dicen si una imagen está clasificada correcta o incorrectamente por el modelo. Una vez construído el modelo podemos utilizarlo para clasificar nuevos datos que, en esta fase, ya no necesitan etiqueta para su clasificación, aunque sí la necesitan para evaluar el porcentaje de objetos bien clasificados.

2. Clasificación no supervisada: los datos no tienen etiquetas (o no queremos utilizarlas) y estos se clasifican a partir de su estructura interna (propiedades, características).

3. Clasificación semisupervisada: algunos datos de entrenamiento tienen etiquetas, pero no todos. Este último caso es muy típico en clasificación de imágenes, donde es habitual disponer de muchas imágenes mayormente no etiquetadas. Estos se pueden considerar algoritmos supervisados que no necesitan todas las etiquetas de los datos de entrenamiento.

Objetivo

Nuestro plantamiento es acerca de cuales estados estan en el grupo de datos que menos producen miel y quienes son los que producen mas, ya que podemos relacionar como la cantidad de abejas que producen los apicultores con la cantidad de miel que se produce entre los años 2003 a 2019 con el fin de entender en que estados se estan extinguiendo las abejas y en cuales mantienen su desarrollo. Tambien debemos saber cuantas observaciones fueron de cada cluster y cuantos clusters son los optimos en el modelo de K-means entre los datos que se usaran y se definira que tan ventajoso en usar este metodo para el analisis de nuestro problema.

Mètodo

Importar datos

library(readr)
setwd("~/sexto semestre/Estadistica aplicada/EAMJ1130/UNIDAD 1/U1A10")
df_raw <- read_csv("ent_ton_miel_03_19.csv")

## 
## -- Column specification --------------------------------------------------------
## cols(
##   Estado = col_character(),
##   `2003` = col_double(),
##   `2004` = col_double(),
##   `2005` = col_double(),
##   `2006` = col_double(),
##   `2007` = col_double(),
##   `2008` = col_double(),
##   `2009` = col_double(),
##   `2010` = col_double(),
##   `2011` = col_double(),
##   `2012` = col_double(),
##   `2013` = col_double(),
##   `2014` = col_double(),
##   `2015` = col_double(),
##   `2016` = col_double(),
##   `2017` = col_double(),
##   `2018` = col_double(),
##   `2019` = col_double()
## )

View(df_raw)

dim(df_raw)

## [1] 32 18

df_raw[1:32,]

## # A tibble: 32 x 18
##    Estado `2003` `2004` `2005` `2006` `2007` `2008` `2009` `2010` `2011` `2012`
##    <chr>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##  1 AGUAS~    300    305    272    430    197    331    396    270    217    326
##  2 BAJA ~    152    161    153    110     97    153    143     85     91     80
##  3 BAJA ~    296    203    196    214    312    301    271    279    266    228
##  4 CAMPE~   6412   5323   5853   6016   8206   8817   7006   5435   8344   7716
##  5 COAHU~    316    317    237    234    235    234    245    280    289    257
##  6 COLIMA    357    367    390    374    380    379    363    299    332    401
##  7 CHIAP~   3372   3377   3381   3182   3487   3780   4270   4574   4708   4945
##  8 CHIHU~    918   1164    598    646    518    570    581    612    238    379
##  9 DISTR~     84     96     77     81     92     84     91     91     79     87
## 10 DURAN~    506    685    648    692    713    854    895    510    508    485
## # ... with 22 more rows, and 7 more variables: `2013` <dbl>, `2014` <dbl>,
## #   `2015` <dbl>, `2016` <dbl>, `2017` <dbl>, `2018` <dbl>, `2019` <dbl>

library(prettydoc) #formato de documentos 
library(DT)
library(readxl)
library(dplyr)

## 
## Attaching package: 'dplyr'

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

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

Visualizar tabla

Observamos nuestros datos de los primeros 10 estados y cuanto producen en toneladas de miel entre los años 2003 a 2019 para darnos una idea.

is.factor(df_raw$Estado)

## [1] FALSE

head.matrix(df_raw, n=10L) %>% 
  datatable(rownames = FALSE,
            options = list(paging=FALSE,
                         searching=FALSE))

Me quedo con las variables numericas de producciòn y escalamos

data <- df_raw %>% 
  select(-c(1,2)) %>%
  scale()

Aplicamos el K-Means

set.seed(1234)
result <- kmeans(data,centers = 3)

str(result)

## List of 9
##  $ cluster     : int [1:32] 3 3 3 2 3 3 1 3 3 3 ...
##  $ centers     : num [1:3, 1:16] 0.843 2.302 -0.52 0.854 2.411 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:3] "1" "2" "3"
##   .. ..$ : chr [1:16] "2004" "2005" "2006" "2007" ...
##  $ totss       : num 496
##  $ withinss    : num [1:3] 19.9 21.2 19.7
##  $ tot.withinss: num 60.8
##  $ betweenss   : num 435
##  $ size        : int [1:3] 6 3 23
##  $ iter        : int 3
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Al utilizar centers = 3, hicimos del conjunto de datos de producciòn entre 2003 a 2019 tres centros, es decir, que kmeans creara tres clústeres.

A continuación mostramos los valores de dichos centros.

result$centers

##         2004       2005       2006       2007       2008       2009       2010
## 1  0.8431493  0.8543439  0.8345353  0.6474772  0.6170621  0.8196733  0.8790793
## 2  2.3022742  2.4113257  2.3965633  2.6037479  2.6091181  2.4325497  2.3458642
## 3 -0.5202486 -0.5373931 -0.5303001 -0.5085264 -0.5012925 -0.5311169 -0.5353073
##         2011       2012       2013       2014       2015       2016       2017
## 1  0.6839825  0.6730235  0.8253785  0.6627166  0.6621038  0.9376133  1.1838819
## 2  2.5302828  2.5104451  2.3696922  2.5450081  2.4142439  2.1410540  1.7873515
## 3 -0.5084671 -0.5030207 -0.5244064 -0.5048402 -0.4876241 -0.5238627 -0.5419716
##         2018       2019
## 1  0.6825185  0.7613513
## 2  2.4312727  2.3950790
## 3 -0.4951708 -0.5110150

Observamos que el cluster 1 y 3 de los valores medios son menores al clúster 2

por lo que lo divide en quienes produce mas (cluster 2), quienes produce menos miel (cluster 3) y quienes producen mas o menos (cluster 1) de los 32 estaods

En result$clusters indica a qué clúster a quedado asignada cada observación. ¿Cuántas observaciones quedaron en cada clúster?

result$cluster %>%
  table()

## .
##  1  2  3 
##  6  3 23

Observamos que 3 estados se agrupan de los que mas producen miel en ton, luego le sigue 6 estados quienes producen regular a comparacion del alto y del menor y por ultimo 23 estados que tienen baja produccion de miel entre los años 2003 a 2019

Realizaremos el mismo experimento pero con k=2

set.seed(1234)
result <- kmeans(data,centers = 2)
result$centers

##         2004       2005       2006      2007      2008       2009       2010
## 1 -0.3794353 -0.3899388 -0.3883326 -0.379674 -0.384556 -0.3994806 -0.4086691
## 2  1.6442195  1.6897346  1.6827747  1.645254  1.666409  1.7310825  1.7708995
##         2011       2012      2013      2014       2015       2016       2017
## 1 -0.4034596 -0.4114976 -0.420352 -0.413208 -0.3971515 -0.4244079 -0.4163642
## 2  1.7483251  1.7831563  1.821525  1.790568  1.7209898  1.8391008  1.8042448
##         2018      2019
## 1 -0.4077608 -0.421201
## 2  1.7669636  1.825204

aqui vemos 2 cluster asignados. lo cual se define como el que produce mas miel y el que produce menos de los 32 estados entre 2003 a 2019

ahora observaremos a que cluster se le asigna a cada observacion

cbind(data,result$cluster)

##               2004        2005       2006        2007       2008        2009
##  [1,] -0.675902988 -0.72438423 -0.6285408 -0.69228097 -0.6272319 -0.64343664
##  [2,] -0.741945417 -0.79017609 -0.7810190 -0.73734768 -0.7000048 -0.76347128
##  [3,] -0.722683042 -0.76640256 -0.7314636 -0.64045426 -0.6394970 -0.70274229
##  [4,]  1.625492224  2.36119853  2.0331569  2.91711170  2.8421549  2.49264610
##  [5,] -0.670399452 -0.74373478 -0.7219337 -0.67515563 -0.6668890 -0.71507787
##  [6,] -0.647468053 -0.65914525 -0.6552245 -0.60980890 -0.6076077 -0.65909334
##  [7,]  0.733002172  0.99449712  0.6827718  0.79041373  0.7828453  1.19456404
##  [8,] -0.281941552 -0.54414772 -0.5256180 -0.54761684 -0.5295200 -0.55566428
##  [9,] -0.771756236 -0.83219441 -0.7948373 -0.73960102 -0.7282145 -0.78814243
## [10,] -0.501624355 -0.51650408 -0.5036992 -0.45973676 -0.4134104 -0.40668849
## [11,] -0.529142034 -0.58727179 -0.4765391 -0.62197691 -0.5798069 -0.56942319
## [12,]  1.070093738  1.41468040  1.1206702  1.05405398  0.9443357  0.94880143
## [13,] -0.465851372 -0.43965477 -0.4193597 -0.28893393 -0.3561733 -0.43325742
## [14,]  1.797477717  2.07425758  1.9793131  1.85218538  1.7517879  1.66379034
## [15,] -0.259468781 -0.25720676 -0.2630696 -0.21277120 -0.2609144 -0.26435493
## [16,] -0.001261227  0.02973419  0.0533227  0.05627705 -0.0352366 -0.02808123
## [17,] -0.388801872 -0.36335833 -0.4612912 -0.42278206 -0.3561733 -0.35212729
## [18,] -0.622702142 -0.71166816 -0.6361647 -0.58817688 -0.5875748 -0.62493328
## [19,] -0.603898395 -0.66633259 -0.6414061 -0.57555820 -0.5675418 -0.59219656
## [20,]  0.394534721  0.71695500  0.5498299  0.52632282  0.4386049  0.83493459
## [21,]  0.666042486  0.66885507  0.5550713  0.50018413  0.4549584  0.68216323
## [22,] -0.777259772 -0.83661740 -0.7915019 -0.73239035 -0.7265792 -0.78814243
## [23,]  0.364265274  0.13809724  0.4245118  0.27034392  0.1319775  0.19822913
## [24,] -0.329180234 -0.32963309 -0.3521740 -0.32543797 -0.3500407 -0.40099515
## [25,] -0.319090418 -0.33460895 -0.4474729 -0.56113685 -0.5246139 -0.58460544
## [26,] -0.608484675 -0.46398117 -0.6533185 -0.61476624 -0.6043371 -0.67000557
## [27,] -0.729103834 -0.78243587 -0.7509998 -0.70895566 -0.7045020 -0.75682905
## [28,] -0.590598183 -0.60054074 -0.5642140 -0.51021147 -0.5017191 -0.52150423
## [29,] -0.587846416 -0.32908022 -0.3254903 -0.30245395 -0.3177426 -0.30942723
## [30,]  1.830957560  1.19297843  1.6743566  0.74354436  0.9496506  1.05934716
## [31,]  3.483852806  2.79852087  3.1772200  3.04194649  3.2334115  3.14121268
## [32,] -0.139308249 -0.11069549 -0.1248862 -0.18482984 -0.1443960 -0.08548909
##               2010        2011        2012        2013        2014        2015
##  [1,] -0.720722947 -0.63940290 -0.61058234 -0.66143960 -0.55116675 -0.51288677
##  [2,] -0.811416535 -0.69011143 -0.71036652 -0.79350721 -0.74699272 -0.71876146
##  [3,] -0.716310827 -0.61968292 -0.65033376 -0.70420883 -0.66899780 -0.65299053
##  [4,]  1.811343983  2.63129744  2.38699933  1.85019498  2.18410686  2.25805418
##  [5,] -0.715820591 -0.61042660 -0.63857058 -0.73193833 -0.68451292 -0.64909875
##  [6,] -0.706506115 -0.59312130 -0.58016033 -0.63277012 -0.59519615 -0.59383561
##  [7,]  1.389251122  1.16799407  1.26300761  1.56162020  1.36348284  1.24930714
##  [8,] -0.553062368 -0.63095148 -0.58908412 -0.51245229 -0.49707350 -0.52572961
##  [9,] -0.808475122 -0.69494082 -0.70752713 -0.79209724 -0.74992801 -0.71837228
## [10,] -0.603066401 -0.52229034 -0.54608768 -0.62384028 -0.58974489 -0.57282004
## [11,] -0.547669777 -0.53999808 -0.55825649 -0.63324011 -0.61029194 -0.44011065
## [12,]  0.705372445  0.49188031  0.20797244  0.10323657  0.03379518  0.05647933
## [13,] -0.415796397 -0.35446924 -0.35382061 -0.29155629 -0.28992569 -0.23890609
## [14,]  2.009399170  1.58332110  1.66660622  2.28258716  2.18494552  1.21155696
## [15,] -0.232938515 -0.24299096 -0.24998016 -0.28356643 -0.29076434 -0.32569258
## [16,]  0.001394108 -0.03130296 -0.05690183  0.09571671  0.03840778 -0.01123749
## [17,] -0.331966108 -0.40839736 -0.32015359 -0.18909814 -0.12471063 -0.10853176
## [18,] -0.666306795 -0.57098663 -0.59516852 -0.64357992 -0.60316337 -0.61329446
## [19,] -0.381970140 -0.60801190 -0.67913326 -0.68493918 -0.67444905 -0.71486968
## [20,]  0.894603391  0.73012992  0.79126370  0.94922127  0.79780998  0.73637172
## [21,]  0.721550220  0.52689334  0.52963445  0.36643181  0.21117073  0.23121984
## [22,] -0.799650881 -0.70339224 -0.68197264 -0.77047763 -0.70799526 -0.70008095
## [23,]  0.259748274  0.18601932  0.13293149  0.66252646  0.62295039  0.60171644
## [24,] -0.384911554 -0.33515171 -0.38099760 -0.37850472 -0.40607942 -0.34087049
## [25,] -0.614832055 -0.58990171 -0.62031738 -0.75355793 -0.70086669 -0.67789786
## [26,] -0.668267737 -0.62612209 -0.53351326 -0.64310993 -0.60106673 -0.54791271
## [27,] -0.758471089 -0.63215882 -0.63045805 -0.70796876 -0.65222469 -0.61991047
## [28,] -0.533452944 -0.48003323 -0.48686618 -0.54582169 -0.51468526 -0.49342791
## [29,] -0.300591029 -0.49733852 -0.31041854 -0.26852671 -0.27105595 -0.32919518
## [30,]  1.303950126  1.00097788  1.11333134  1.30923476  0.94709059  1.09752807
## [31,]  3.216849480  3.37622992  3.47772965  2.97629461  3.26597194  3.77312062
## [32,] -0.041256391 -0.07356007 -0.07880567  0.08913683 -0.11884005 -0.10892094
##              2016        2017         2018         2019  
##  [1,] -0.54394670 -0.55114207 -0.574721020 -0.557409566 1
##  [2,] -0.83972716 -0.88627277 -0.720428847 -0.747459220 1
##  [3,] -0.76976865 -0.81537974 -0.676671946 -0.706734294 1
##  [4,]  1.98021804  1.27332823  2.297172924  2.296626141 2
##  [5,] -0.76411024 -0.82241045 -0.674151313 -0.704677480 1
##  [6,] -0.65660047 -0.66246171 -0.576398746 -0.596077678 1
##  [7,]  1.79606255  2.18556338  1.304864594  1.465673110 2
##  [8,] -0.52079866 -0.67769492 -0.590816019 -0.533139156 1
##  [9,] -0.83612635 -0.87455492 -0.721912849 -0.756097841 1
## [10,] -0.64065405 -0.64840028 -0.575315061 -0.605127661 1
## [11,] -0.52028426 -0.61266082 -0.533278161 -0.564402736 1
## [12,]  0.17261362  0.29723076  0.003562343  0.037832530 1
## [13,] -0.30269272 -0.21015244 -0.231709025 -0.238191966 1
## [14,]  1.47559085  2.47323676  1.399022032  1.649963683 2
## [15,] -0.33664318 -0.37596011 -0.385809896 -0.414666645 1
## [16,]  0.18701684  0.06287363 -0.067861607  0.041123434 1
## [17,]  0.07796387  0.19352773 -0.042144309 -0.003715121 1
## [18,] -0.69157973 -0.73511242 -0.594701919 -0.623227628 1
## [19,] -0.83458315 -0.83588599 -0.676604675 -0.719486544 1
## [20,]  1.24925450  1.45554090  0.909789040  1.123419188 2
## [21,]  0.24308653  0.49291897  0.171153032  0.222123104 1
## [22,] -0.86956241 -0.90443545 -0.714515266 -0.765147824 1
## [23,]  0.59853748  0.84972771  0.612432233  0.542163429 1
## [24,] -0.32738396 -0.32615922 -0.313865058 -0.333628156 1
## [25,] -0.78571508 -0.85522045 -0.687183836 -0.723600173 1
## [26,] -0.58561316 -0.61734796 -0.563277263 -0.562757284 1
## [27,] -0.70392535 -0.71050492 -0.609326519 -0.632688975 1
## [28,] -0.47398819 -0.52712046 -0.432391069 -0.546714131 1
## [29,] -0.41688970 -0.35662565 -0.363569360 -0.489123327 1
## [30,]  1.56612539  1.82230982  1.093309676  1.176896364 2
## [31,]  2.96735318  1.61548965  3.597623078  3.238647151 2
## [32,]  0.10677032  0.28375523 -0.062275189  0.029605273 1

aqui observamos que cada estado es asignado a un cluster, es decir, a un grupo segun los datos de producciòn que tiene cada estado

¿Cuántas observaciones fueron a cada clúster?

table(result$cluster)

## 
##  1  2 
## 26  6

Observamos que 26 estados tienen baja produccion de miel en toneladas y 6 estados tienen alta producciòn de miel entre 2003 a 2019, por lo que se explica como concentra la cantidad de abejas en esos 6 estados si lo relacionamos con la producciòn de miel

Total withings vs número K

¿Cuál es la cantidad “ideal” de clústeres? ¿Cómo elegimos k? Depende mucho del problema con el que trabajemos. No hay una única respuesta.

Una alternativa es correr kmeans para distintos valores de k y analizar la variación de tot.within

library(purrr)
set.seed(1234)
max_k <- 10

my_x <- 2:max_k

# uso data ya previamente cargada
# función que llama a kmeans y regresa tot.withinss
kmean_withinss <- function( k) {
    cluster <- kmeans(scale(data), k)
    return (cluster$tot.withinss)
}

wss <- map_dbl(my_x,kmean_withinss)

visualizamos la grafica (elbow)

library(ggplot2)
elbow <-data.frame(clusters=my_x, wss)

ggplot(elbow, aes(x = clusters , y = wss)) +
    geom_point() +
    geom_line() +
    scale_x_continuous(breaks = seq(1, 20, by = 1))

Observamos en el gráfico que a medida que aumenta el número de clústers (eje x), la distancia entre los elementos de un mismo clúster disminuye. Esto es esperable ya que los clústers serán cada vez más pequeños. Este es el método de Elbow que informalmente podríamos resumir en la regla del codo, cuando ya no haya más variación en la disminución de wss, no tiene sentido aumentar k.

También podemos usar la librería factoextra para calcular el número de clusters

library(factoextra)

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

set.seed(1234)

usamos el metodo “WSS”

fviz_nbclust(data, kmeans, method = "wss")

Usamos ahora el metodo “silhoutte”

fviz_nbclust(data, kmeans, method = "silhouette")

Observamos que el numero optimo de clusters son 2, tiene sentido ya que la mayoria se agrupan en un clusters y en el segundo solo 6 que estan muy alejados del primer cluster

fviz_cluster(result,data=data)

Observamos aqui la distribucion de datos y vemos 2 centroides remarcados de forma que las sumas de las distancias sean minimas entre cada objeto y el centroide uniformemente.