# 8 Unsupervised Learning

This chapter will cover the concepts seen in Unsupervised Learning. We will discuss more in detail how to implement several dimensionality reduction and clustering methods. Make sure that you go over the video and slides before going over this chapter. Note that some of the materials are already covered in data mining, however we repeat how to implement these methods in R for didactical reasons.

## 8.1 Dimensionality reduction

In a lot of cases, you are confronted with a large number of variables. If you want to visualize that relationship into one graph this often impossible. However, such a plot should reduce the number of variables to a minimum but maintain the variance as much as possible. Another problem , especially in parametric methods, is often the presence of multicollinearity. to solve both of these issues, you can make use of principal components analysis (PCA), one of the most well-known feature extraction methods.

We will show you how to implement PCA in R, making use of the football data set also used in Session 2. To perform PCA in R, you can make use of the stats package and the function princomp which is by default in R. However, a better package is the psych package, since this one has more option.

# load the packages
if (!require("pacman")) install.packages("pacman")
require("pacman", character.only = TRUE, quietly = TRUE)

# Set working directory
setwd("C:\\Users\\matbogae\\OneDrive - UGent\\PPA22\\PredictiveAnalytics\\Book_2022\\data codeBook_2022")

football <- read_csv("football_players.csv")
## Rows: 10390 Columns: 32
## -- Column specification --------------------------
## Delimiter: ","
## chr  (1): player_name
## dbl (31): overall_rating, potential, crossing,...
##
## i Use spec() to retrieve the full column specification for this data.
## i Specify the column types or set show_col_types = FALSE to quiet this message.
football %>%
glimpse()
## Rows: 10,390
## Columns: 32
## $player_name <chr> "Aaron Appindangoye",~ ##$ overall_rating     <dbl> 63.60000, 66.96970, 6~
## $potential <dbl> 67.60000, 74.48485, 7~ ##$ crossing           <dbl> 48.60000, 70.78788, 6~
## $finishing <dbl> 43.60000, 49.45455, 5~ ##$ heading_accuracy   <dbl> 70.60000, 52.93939, 5~
## $short_passing <dbl> 60.60000, 62.27273, 6~ ##$ volleys            <dbl> 43.60000, 29.15152, 5~
## $dribbling <dbl> 50.60000, 61.09091, 6~ ##$ curve              <dbl> 44.60000, 61.87879, 6~
## $free_kick_accuracy <dbl> 38.60000, 62.12121, 5~ ##$ long_passing       <dbl> 63.60000, 63.24242, 6~
## $ball_control <dbl> 48.60000, 61.78788, 6~ ##$ acceleration       <dbl> 60.00000, 76.00000, 7~
## $sprint_speed <dbl> 64.00000, 74.93939, 7~ ##$ agility            <dbl> 59.00000, 75.24242, 7~
## $reactions <dbl> 46.60000, 67.84848, 5~ ##$ balance            <dbl> 65.00000, 84.72727, 8~
## $shot_power <dbl> 54.60000, 65.90909, 6~ ##$ jumping            <dbl> 58.00000, 75.30303, 6~
## $stamina <dbl> 54.00000, 72.87879, 7~ ##$ strength           <dbl> 76.00000, 51.75758, 7~
## $long_shots <dbl> 34.60000, 54.12121, 5~ ##$ aggression         <dbl> 65.80000, 65.06061, 5~
## $interceptions <dbl> 52.20000, 57.87879, 4~ ##$ positioning        <dbl> 44.60000, 51.48485, 6~
## $vision <dbl> 53.60000, 57.45455, 6~ ##$ penalties          <dbl> 47.60000, 53.12121, 6~
## $marking <dbl> 63.80000, 69.39394, 2~ ##$ standing_tackle    <dbl> 66.00000, 68.78788, 2~
## $sliding_tackle <dbl> 67.80000, 71.51515, 2~ ##$ gk_reflexes        <dbl> 7.60000, 12.90909, 13~
# Since PCA can only be applied to numeric data, select the
# numerics
nums <- football %>%
select_if(is.numeric)

# Before applying PCA, you should always check the mean and
# the variance If the differences in mean and variances are
# large, you should scale the data
nums %>%
summarize_all(mean)
## # A tibble: 1 x 31
##   overall_rating potential crossing finishing
##            <dbl>     <dbl>    <dbl>     <dbl>
## 1           66.9      72.1     53.0      47.9
## # ... with 27 more variables:
## #   heading_accuracy <dbl>, short_passing <dbl>,
## #   volleys <dbl>, dribbling <dbl>, curve <dbl>,
## #   free_kick_accuracy <dbl>, long_passing <dbl>,
## #   ball_control <dbl>, acceleration <dbl>,
## #   sprint_speed <dbl>, agility <dbl>,
## #   reactions <dbl>, balance <dbl>, ...
nums %>%
summarize_all(var)
## # A tibble: 1 x 31
##   overall_rating potential crossing finishing
##            <dbl>     <dbl>    <dbl>     <dbl>
## 1           37.9      32.7     259.      327.
## # ... with 27 more variables:
## #   heading_accuracy <dbl>, short_passing <dbl>,
## #   volleys <dbl>, dribbling <dbl>, curve <dbl>,
## #   free_kick_accuracy <dbl>, long_passing <dbl>,
## #   ball_control <dbl>, acceleration <dbl>,
## #   sprint_speed <dbl>, agility <dbl>,
## #   reactions <dbl>, balance <dbl>, ...
# We notice a huge difference in variance for several
# variable the difference in mean is acceptable, however
# gkreflexes has a much lower mean so it is best to scale
football_sc <- nums %>%
scale()
describe(football_sc)
## [322090 obs.]
## matrix: -0.529293869002172 0.0178629575440086 0.0227834326028726 0.361654410570158 1.03600765672507 1.68863759975536 -1.02106020488565 2.09619592279377 -3.06235442930767 0.0313295208630174 -0.788725518174457 0.414587954646997 0.363458539411657 -0.232478575249716 0.448695959774505 1.40440273422724 0.679401659053123 1.72806392850139 -2.66633034347231 -0.470447320605076 -0.272007786831898 1.10726772574523 0.941136217417357 0.263679149355763 -0.490823197294831 1.30003727066063 -0.335947354824312 1.55798910093393 -2.54719074789534 0.678766110903274 -0.238247687132312 0.0857380576376712 0.55437964497217 -1.19778094743271 -0.501662183967035 1.37847620878451 -0.903898966648627 0.999221515030812 -1.82094823534094 -0.102521066693366 0.935947814191637 -0.202261987107591 0.168508007824898 0.849642090545631 1.09320356779598 0.608451010996183 -0.612671492380447 -1.6509390783288 -2.58297191810236 0.0492641646623795 0.00791916448861004 0.132978661754365 0.34550661174821 0.314125806895916 0.318936696819091 1.32819301968068 0.23007454472467 1.17941086818164 -2.80320083926766 0.632000397125428 -0.206093397482575 -1.0434602263044 0.412245482260651 0.0363111048862791 -0.873738895898907 1.76825179748702 -0.787302648336076 1.23030737435064 -1.92157141424676 0.698619937816604 -0.38695617156069 0.238103190669443 0.71162669765154 -0.0911233138885098 -0.38695617156069 1.29411207531525 -0.209915342050594 1.67408978707402 -2.50804149434509 0.753236943998757 -0.340369386633345 0.664065094670231 0.566028191664115 -0.736671658914407 -0.289214042303188 1.59259644415855 0.297411529690698 0.675582906357198 -2.11918022356837 1.18817188294481 -0.536034900247331 0.913370920103573 0.512473882801592 -0.425652538386924 -1.2902786505129 1.30301621922737 -0.476174285146887 0.434262332528953 -1.805432061642 1.05184667925914 0.650167367699465 0.622598429046503 0.408193319444292 0.436299853182366 0.128974246114541 0.792373248999753 0.647964522722354 -0.0870231763720679 -2.8655732157728 0.218409752185327 -0.874509418752489 0.0363907727010471 0.507973539380804 0.132125567439012 -0.0760484696814999 1.15873664789374 0.090511352616059 1.49090723367234 -2.71179845381203 0.7126698307667 -0.563974981127427 0.815126891143998 0.775345106366935 -1.40717585411947 -1.32937652023807 0.923667316276474 0.32259050818992 2.31688926647802 -4.44269899689081 0.656348715060116 -0.261186510746804 0.715859578351005 0.944558732170304 -1.25917854755742 -1.14718597813478 0.790739380193226 0.00675687656810907 2.1983963779388 -3.65513608340236 0.716571814893577 -0.447829292967689 0.892948676463125 1.08883156579731 -0.131993859545638 -1.12802396731028 1.15421138194923 -0.365281395596016 2.26990148203817 -2.75917041937454 0.364615802216676 -2.1879498336109 0.464969755389464 -1.72023437094443 -0.737493239451223 0.658679799537815 1.65842204561766 -0.443586562170143 1.6891904595812 -2.38771331663888 0.516742587912666 0.0450617448661233 1.80455605200356 1.4481040858465 -1.82019258874722 -0.0298586578894064 0.583510847562385 1.38292607978629 2.02784529764524 -3.61176743724901 0.857168867466784 -0.328325961855968 0.417024238579914 0.212619827317662 0.348512039951843 -0.823947895779249 1.11137959679233 -0.462023368043478 0.222759392250629 -2.21327108289398 0.405671807028177 -0.841760377684083 0.972775425949681 0.134319571650367 0.498727429127371 1.23882260192204 0.323440663761999 0.521524840807835 -0.260952473947886 -2.93912225228703 -0.0524899880308662 -1.01473710876829 0.6582878610437 0.484974124820427 -0.887587678094464 0.0912317573109561 0.829857213218101 0.225933093564197 1.32685747640318 -4.20503191476609 0.986193405519819 0.852472778518433 -1.35353172593797 0.313486485650767 1.09777088809005 0.652277869739013 -0.0743555028677695 -0.694487880231625 -1.4714681205993 -2.05945316736403 -0.0766614871085391 -0.9463487875562 0.188674751220707 0.416435725704812 -1.13796817931251 -1.54638544754668 1.37033022054656 -0.773580756994157 0.326984822307308 -2.26038255846557 0.582508389775714 0.427689254301564 0.377913527721286 -0.0223165814937412 0.663600654084585 0.688889419520381 -0.336762546539305 1.01817858215265 -0.470251044051779 -2.58823017915281 0.884045484363742 0.0857187277449564 0.411416581003319 -0.197077704812883 0.622845886700712 1.49890676638657 0.411995908383714 0.188954866931438 -0.417667745809642 -1.81841450613904 0.71117276398586 -0.545799658456469 -0.131012642846777 0.49090105522592 -1.06915711190123 -0.818113176274875 1.31469699146967 -0.5991607144133 1.30422682747116 -2.38933807554567 0.546878942384502 -0.164322328623037 0.111393339042496 0.9647513380218 -0.151260327140111 -0.67361598644295 1.72142062620538 0.293469723349918 1.61402371942575 -2.92538064208492 0.63606081487573 -0.421504466525904 -0.0202857437808091 0.518715343686425 -0.847405618212843 -0.0320008019860981 1.61267788324735 -0.859592276855854 0.731131234221917 -0.901117187787605 0.0741718387014968 0.887512168933577 1.16804242843979 -1.20678567681835 1.2289611950479 1.57956785787794 -0.722083805406695 0.274261993223046 -1.14699268251156 -1.55975722385519 0.82627764573179 0.820643741927127 0.958248694114398 -1.39478448285715 1.05026712858745 1.31620105452155 -0.881303498833549 0.383470244760734 -1.14609459644177 -1.69662945949871 0.750503002568514 1.00938079076002 1.19077562528086 -1.25876028008667 1.02126878473813 1.34139547971986 -0.722303665383463 0.461138048065832 -1.28129521372648 -1.71509268629279 0.71334292568128 -0.544579889436886 -0.225185651767604 -0.189636635588659 -0.389733606254754 -0.284689235771744 -0.108309399145089 -0.125179628231231 -0.212775048486198 2.18667836898845 -0.14689146228847 ...
## min: -4.72187984569954 - max: 4.4700190235591 - NAs: 0 (0%) - 322059 unique values [322090 obs.]
## array: -0.529293869002172 0.0178629575440086 0.0227834326028726 0.361654410570158 1.03600765672507 1.68863759975536 -1.02106020488565 2.09619592279377 -3.06235442930767 0.0313295208630174 -0.788725518174457 0.414587954646997 0.363458539411657 -0.232478575249716 0.448695959774505 1.40440273422724 0.679401659053123 1.72806392850139 -2.66633034347231 -0.470447320605076 -0.272007786831898 1.10726772574523 0.941136217417357 0.263679149355763 -0.490823197294831 1.30003727066063 -0.335947354824312 1.55798910093393 -2.54719074789534 0.678766110903274 -0.238247687132312 0.0857380576376712 0.55437964497217 -1.19778094743271 -0.501662183967035 1.37847620878451 -0.903898966648627 0.999221515030812 -1.82094823534094 -0.102521066693366 0.935947814191637 -0.202261987107591 0.168508007824898 0.849642090545631 1.09320356779598 0.608451010996183 -0.612671492380447 -1.6509390783288 -2.58297191810236 0.0492641646623795 0.00791916448861004 0.132978661754365 0.34550661174821 0.314125806895916 0.318936696819091 1.32819301968068 0.23007454472467 1.17941086818164 -2.80320083926766 0.632000397125428 -0.206093397482575 -1.0434602263044 0.412245482260651 0.0363111048862791 -0.873738895898907 1.76825179748702 -0.787302648336076 1.23030737435064 -1.92157141424676 0.698619937816604 -0.38695617156069 0.238103190669443 0.71162669765154 -0.0911233138885098 -0.38695617156069 1.29411207531525 -0.209915342050594 1.67408978707402 -2.50804149434509 0.753236943998757 -0.340369386633345 0.664065094670231 0.566028191664115 -0.736671658914407 -0.289214042303188 1.59259644415855 0.297411529690698 0.675582906357198 -2.11918022356837 1.18817188294481 -0.536034900247331 0.913370920103573 0.512473882801592 -0.425652538386924 -1.2902786505129 1.30301621922737 -0.476174285146887 0.434262332528953 -1.805432061642 1.05184667925914 0.650167367699465 0.622598429046503 0.408193319444292 0.436299853182366 0.128974246114541 0.792373248999753 0.647964522722354 -0.0870231763720679 -2.8655732157728 0.218409752185327 -0.874509418752489 0.0363907727010471 0.507973539380804 0.132125567439012 -0.0760484696814999 1.15873664789374 0.090511352616059 1.49090723367234 -2.71179845381203 0.7126698307667 -0.563974981127427 0.815126891143998 0.775345106366935 -1.40717585411947 -1.32937652023807 0.923667316276474 0.32259050818992 2.31688926647802 -4.44269899689081 0.656348715060116 -0.261186510746804 0.715859578351005 0.944558732170304 -1.25917854755742 -1.14718597813478 0.790739380193226 0.00675687656810907 2.1983963779388 -3.65513608340236 0.716571814893577 -0.447829292967689 0.892948676463125 1.08883156579731 -0.131993859545638 -1.12802396731028 1.15421138194923 -0.365281395596016 2.26990148203817 -2.75917041937454 0.364615802216676 -2.1879498336109 0.464969755389464 -1.72023437094443 -0.737493239451223 0.658679799537815 1.65842204561766 -0.443586562170143 1.6891904595812 -2.38771331663888 0.516742587912666 0.0450617448661233 1.80455605200356 1.4481040858465 -1.82019258874722 -0.0298586578894064 0.583510847562385 1.38292607978629 2.02784529764524 -3.61176743724901 0.857168867466784 -0.328325961855968 0.417024238579914 0.212619827317662 0.348512039951843 -0.823947895779249 1.11137959679233 -0.462023368043478 0.222759392250629 -2.21327108289398 0.405671807028177 -0.841760377684083 0.972775425949681 0.134319571650367 0.498727429127371 1.23882260192204 0.323440663761999 0.521524840807835 -0.260952473947886 -2.93912225228703 -0.0524899880308662 -1.01473710876829 0.6582878610437 0.484974124820427 -0.887587678094464 0.0912317573109561 0.829857213218101 0.225933093564197 1.32685747640318 -4.20503191476609 0.986193405519819 0.852472778518433 -1.35353172593797 0.313486485650767 1.09777088809005 0.652277869739013 -0.0743555028677695 -0.694487880231625 -1.4714681205993 -2.05945316736403 -0.0766614871085391 -0.9463487875562 0.188674751220707 0.416435725704812 -1.13796817931251 -1.54638544754668 1.37033022054656 -0.773580756994157 0.326984822307308 -2.26038255846557 0.582508389775714 0.427689254301564 0.377913527721286 -0.0223165814937412 0.663600654084585 0.688889419520381 -0.336762546539305 1.01817858215265 -0.470251044051779 -2.58823017915281 0.884045484363742 0.0857187277449564 0.411416581003319 -0.197077704812883 0.622845886700712 1.49890676638657 0.411995908383714 0.188954866931438 -0.417667745809642 -1.81841450613904 0.71117276398586 -0.545799658456469 -0.131012642846777 0.49090105522592 -1.06915711190123 -0.818113176274875 1.31469699146967 -0.5991607144133 1.30422682747116 -2.38933807554567 0.546878942384502 -0.164322328623037 0.111393339042496 0.9647513380218 -0.151260327140111 -0.67361598644295 1.72142062620538 0.293469723349918 1.61402371942575 -2.92538064208492 0.63606081487573 -0.421504466525904 -0.0202857437808091 0.518715343686425 -0.847405618212843 -0.0320008019860981 1.61267788324735 -0.859592276855854 0.731131234221917 -0.901117187787605 0.0741718387014968 0.887512168933577 1.16804242843979 -1.20678567681835 1.2289611950479 1.57956785787794 -0.722083805406695 0.274261993223046 -1.14699268251156 -1.55975722385519 0.82627764573179 0.820643741927127 0.958248694114398 -1.39478448285715 1.05026712858745 1.31620105452155 -0.881303498833549 0.383470244760734 -1.14609459644177 -1.69662945949871 0.750503002568514 1.00938079076002 1.19077562528086 -1.25876028008667 1.02126878473813 1.34139547971986 -0.722303665383463 0.461138048065832 -1.28129521372648 -1.71509268629279 0.71334292568128 -0.544579889436886 -0.225185651767604 -0.189636635588659 -0.389733606254754 -0.284689235771744 -0.108309399145089 -0.125179628231231 -0.212775048486198 2.18667836898845 -0.14689146228847 ...
## min: -4.72187984569954 - max: 4.4700190235591 - NAs: 0 (0%) - 322059 unique values
# Another thing that you should od is check the
# correlations, some correlation should be present for PCA.
# Correlation should be more than 0.30 for several
# variables. Since we notice that moderate to high
# correlation between several variables, PCA is advisable

corr <- cor(nums, use = "complete.obs")
corrplot(corr, method = "circle")

Now that the data is prepared, we can perform a pca analysis. Let’s perform pca with and without rotation. We will use the the raw data, because the principal function uses the correlation matrix to make your principal components and hence should not be scaled. Question: why should this not be scaled?

# Perform Principal Components Analysis (PCA)
pca <- principal(nums, nfactors = 10, rotate = "none")

# Check output
print(pca, sort = TRUE)  #with sort=TRUE, the variables are automatically sorted 
## Principal Components Analysis
## Call: principal(r = nums, nfactors = 10, rotate = "none")
##                    item   PC1   PC2   PC3   PC4
## ball_control         12  0.95 -0.02 -0.06 -0.06
## short_passing         6  0.91  0.18 -0.06 -0.04
## dribbling             8  0.91 -0.25 -0.14 -0.02
## positioning          25  0.87 -0.27  0.06 -0.14
## long_shots           22  0.87 -0.23  0.08 -0.21
## crossing              3  0.87  0.02 -0.19  0.08
## curve                 9  0.86 -0.18 -0.05 -0.03
## vision               26  0.86 -0.08  0.10 -0.02
## shot_power           18  0.85 -0.08  0.13 -0.26
## free_kick_accuracy   10  0.82 -0.10  0.01 -0.11
## volleys               7  0.81 -0.36  0.12 -0.22
## penalties            27  0.80 -0.20  0.19 -0.25
## finishing             4  0.76 -0.48  0.12 -0.27
## long_passing         11  0.75  0.31 -0.02  0.11
## stamina              20  0.72  0.37 -0.11  0.07
## gk_reflexes          31 -0.71 -0.21  0.44  0.29
## acceleration         13  0.71 -0.26 -0.29  0.36
## sprint_speed         14  0.71 -0.20 -0.26  0.30
## agility              15  0.70 -0.36 -0.23  0.40
## balance              17  0.63 -0.16 -0.32  0.40
## heading_accuracy      5  0.58  0.44  0.12 -0.39
## marking              28  0.22  0.92 -0.19  0.06
## standing_tackle      29  0.27  0.91 -0.19  0.05
## sliding_tackle       30  0.25  0.90 -0.22  0.09
## interceptions        24  0.34  0.86 -0.05  0.08
## aggression           23  0.45  0.73  0.09 -0.07
## strength             21  0.03  0.55  0.50 -0.38
## overall_rating        1  0.50  0.12  0.74  0.31
## reactions            16  0.55  0.10  0.61  0.30
## potential             2  0.45  0.01  0.59  0.43
## jumping              19  0.14  0.29  0.26  0.29
##                      PC5   PC6   PC7   PC8   PC9
## ball_control       -0.01 -0.09 -0.10 -0.01 -0.08
## short_passing      -0.17 -0.04 -0.10  0.00 -0.18
## dribbling           0.01 -0.09 -0.03  0.04 -0.05
## positioning         0.05  0.03  0.03 -0.12 -0.01
## long_shots         -0.08  0.08  0.04  0.07  0.01
## crossing           -0.16 -0.02  0.10  0.15  0.05
## curve              -0.18  0.05  0.05  0.20  0.12
## vision             -0.25  0.13  0.03 -0.14 -0.18
## shot_power          0.07  0.01  0.01  0.05  0.00
## free_kick_accuracy -0.29  0.16  0.05  0.20  0.16
## volleys             0.03  0.04 -0.01  0.02  0.07
## penalties           0.00  0.12 -0.09 -0.11  0.13
## finishing           0.12  0.02 -0.03 -0.04  0.01
## long_passing       -0.40  0.07 -0.02  0.06 -0.28
## stamina             0.21  0.00  0.34 -0.10 -0.15
## gk_reflexes        -0.22  0.12  0.16  0.03  0.00
## acceleration        0.32 -0.20  0.07  0.05  0.05
## sprint_speed        0.38 -0.26  0.10  0.08  0.04
## agility             0.10  0.04  0.07  0.00 -0.03
## balance             0.04  0.27 -0.13 -0.32  0.07
## heading_accuracy    0.37 -0.09 -0.25 -0.07  0.06
## marking            -0.07 -0.03 -0.07  0.03  0.08
## standing_tackle    -0.09 -0.02 -0.06  0.03  0.06
## sliding_tackle     -0.08 -0.02 -0.06  0.05  0.08
## interceptions      -0.14  0.04  0.02 -0.02  0.07
## aggression          0.12  0.06  0.18 -0.17  0.05
## strength            0.30 -0.10  0.23  0.05 -0.10
## overall_rating     -0.09 -0.10 -0.03 -0.01  0.03
## reactions          -0.06  0.03  0.15 -0.11  0.20
## potential          -0.05 -0.32 -0.27  0.03 -0.07
## jumping             0.61  0.52 -0.14  0.24 -0.10
##                     PC10   h2     u2 com
## ball_control       -0.07 0.95 0.0517 1.1
## short_passing      -0.06 0.94 0.0629 1.3
## dribbling          -0.06 0.92 0.0791 1.3
## positioning        -0.08 0.88 0.1192 1.3
## long_shots          0.09 0.89 0.1120 1.4
## crossing           -0.07 0.86 0.1377 1.3
## curve              -0.01 0.88 0.1244 1.4
## vision             -0.05 0.89 0.1131 1.4
## shot_power          0.17 0.85 0.1453 1.4
## free_kick_accuracy  0.12 0.89 0.1071 1.7
## volleys            -0.03 0.86 0.1355 1.6
## penalties           0.11 0.83 0.1657 1.7
## finishing          -0.04 0.92 0.0818 2.1
## long_passing        0.01 0.92 0.0841 2.3
## stamina            -0.04 0.86 0.1415 2.5
## gk_reflexes         0.08 0.93 0.0706 2.8
## acceleration        0.06 0.94 0.0599 3.0
## sprint_speed        0.06 0.93 0.0660 3.0
## agility            -0.04 0.85 0.1466 2.5
## balance             0.21 0.94 0.0641 4.1
## heading_accuracy   -0.13 0.93 0.0738 4.4
## marking             0.01 0.96 0.0435 1.3
## standing_tackle     0.01 0.96 0.0359 1.3
## sliding_tackle      0.00 0.95 0.0495 1.4
## interceptions      -0.03 0.90 0.1023 1.4
## aggression          0.13 0.84 0.1605 2.2
## strength            0.17 0.90 0.1035 4.2
## overall_rating      0.02 0.93 0.0726 2.3
## reactions          -0.29 0.94 0.0598 3.6
## potential           0.14 0.94 0.0576 4.1
## jumping            -0.06 0.99 0.0068 4.2
##
##                         PC1  PC2  PC3  PC4  PC5
## Proportion Var         0.47 0.18 0.08 0.06 0.05
## Cumulative Var         0.47 0.65 0.73 0.79 0.84
## Proportion Explained   0.52 0.20 0.09 0.06 0.05
## Cumulative Proportion  0.52 0.72 0.81 0.87 0.92
##                        PC6  PC7  PC8  PC9 PC10
## Proportion Var        0.02 0.02 0.01 0.01 0.01
## Cumulative Var        0.86 0.87 0.89 0.90 0.91
## Proportion Explained  0.02 0.02 0.01 0.01 0.01
## Cumulative Proportion 0.94 0.96 0.98 0.99 1.00
##
## Mean item complexity =  2.2
## Test of the hypothesis that 10 components are sufficient.
##
## The root mean square of the residuals (RMSR) is  0.01
##  with the empirical chi square  1939.19  with prob <  4.6e-282
##
## Fit based upon off diagonal values = 1
# based on the highest loadings for the first PC.

pca$loadings ## ## Loadings: ## PC1 PC2 PC3 PC4 ## overall_rating 0.497 0.122 0.741 0.310 ## potential 0.448 0.594 0.425 ## crossing 0.868 -0.190 ## finishing 0.761 -0.485 0.123 -0.265 ## heading_accuracy 0.578 0.438 0.120 -0.392 ## short_passing 0.910 0.177 ## volleys 0.812 -0.361 0.123 -0.223 ## dribbling 0.906 -0.249 -0.145 ## curve 0.864 -0.182 ## free_kick_accuracy 0.822 -0.103 -0.114 ## long_passing 0.750 0.308 0.108 ## ball_control 0.955 ## acceleration 0.712 -0.261 -0.292 0.357 ## sprint_speed 0.707 -0.199 -0.256 0.302 ## agility 0.702 -0.357 -0.228 0.402 ## reactions 0.549 0.104 0.612 0.300 ## balance 0.633 -0.164 -0.324 0.399 ## shot_power 0.854 0.129 -0.258 ## jumping 0.136 0.288 0.264 0.293 ## stamina 0.716 0.367 -0.111 ## strength 0.555 0.499 -0.380 ## long_shots 0.871 -0.230 -0.206 ## aggression 0.447 0.727 ## interceptions 0.345 0.861 ## positioning 0.872 -0.266 -0.141 ## vision 0.860 ## penalties 0.797 -0.200 0.185 -0.248 ## marking 0.219 0.921 -0.193 ## standing_tackle 0.273 0.913 -0.188 ## sliding_tackle 0.252 0.901 -0.219 ## gk_reflexes -0.713 -0.211 0.441 0.291 ## PC5 PC6 PC7 PC8 ## overall_rating ## potential -0.325 -0.272 ## crossing -0.158 0.150 ## finishing 0.117 ## heading_accuracy 0.371 -0.247 ## short_passing -0.165 ## volleys ## dribbling ## curve -0.183 0.203 ## free_kick_accuracy -0.286 0.164 0.204 ## long_passing -0.401 ## ball_control ## acceleration 0.315 -0.198 ## sprint_speed 0.383 -0.263 0.104 ## agility 0.100 ## reactions 0.154 -0.111 ## balance 0.271 -0.130 -0.322 ## shot_power ## jumping 0.613 0.518 -0.145 0.238 ## stamina 0.210 0.340 -0.101 ## strength 0.300 -0.103 0.225 ## long_shots ## aggression 0.115 0.184 -0.171 ## interceptions -0.145 ## positioning -0.122 ## vision -0.248 0.126 -0.135 ## penalties 0.115 -0.109 ## marking ## standing_tackle ## sliding_tackle ## gk_reflexes -0.221 0.122 0.161 ## PC9 PC10 ## overall_rating ## potential 0.143 ## crossing ## finishing ## heading_accuracy -0.128 ## short_passing -0.175 ## volleys ## dribbling ## curve 0.115 ## free_kick_accuracy 0.163 0.121 ## long_passing -0.276 ## ball_control ## acceleration ## sprint_speed ## agility ## reactions 0.199 -0.289 ## balance 0.210 ## shot_power 0.169 ## jumping -0.103 ## stamina -0.153 ## strength -0.103 0.171 ## long_shots ## aggression 0.126 ## interceptions ## positioning ## vision -0.179 ## penalties 0.134 0.106 ## marking ## standing_tackle ## sliding_tackle ## gk_reflexes ## ## PC1 PC2 PC3 PC4 PC5 ## SS loadings 14.688 5.588 2.425 1.756 1.440 ## Proportion Var 0.474 0.180 0.078 0.057 0.046 ## Cumulative Var 0.474 0.654 0.732 0.789 0.835 ## PC6 PC7 PC8 PC9 PC10 ## SS loadings 0.702 0.505 0.401 0.340 0.322 ## Proportion Var 0.023 0.016 0.013 0.011 0.010 ## Cumulative Var 0.858 0.874 0.887 0.898 0.909 We can actually see that the first PC loads high on dribbling, ball_control,long shots, shot_power, vision So we can maybe say that this PC is about ball handling and football intelligence. Looking at PC2, we see that it loads on sliding tackles, interception, and agression, so this can be your defensive skills. As an exercise, try to interpret the other PCs. # Check the score to see which instances score high on # certain PCs head(pca$scores)
##             PC1        PC2        PC3         PC4
## [1,] -0.3916228  0.7864349 -0.9646160 -1.04977239
## [2,]  0.5358301  0.4865027 -0.9412600  1.77302473
## [3,]  0.5546452 -0.9598542 -0.4630592  0.09590248
## [4,] -0.3624813  1.3420597  0.2677645 -0.84453112
## [5,] -0.3246658  1.7466316  0.7398201  0.29588598
## [6,]  1.4602375 -0.8321987  1.2660571  0.33471345
##             PC5        PC6        PC7        PC8
## [1,] -0.1857767 -0.5709827 -1.2941700 -0.2079504
## [2,] -0.1457836  1.1401279 -0.4622942  0.4218186
## [3,]  0.5638614  0.2841281  0.1767969 -0.2646224
## [4,] -0.3313796 -0.3017848 -1.1603707  1.7917709
## [5,]  0.2321783  0.3631449 -1.9867849 -0.8659367
## [6,] -0.3264924  0.1431034  0.1072922  0.2416088
##               PC9       PC10
## [1,] -0.791041954  1.7251407
## [2,]  1.288064235  0.7615998
## [3,] -2.230868898  2.4339190
## [4,] -1.274688621 -0.8312371
## [5,]  0.179336223 -1.5820336
## [6,]  0.008017534 -0.8480305
# How many PCs to keep? Check eigenvalues We should go for
# 5 in this case
pca$values #based on Kaiser criterion: eigenvalues > 1 ## [1] 14.68817338 5.58781625 2.42484785 ## [4] 1.75561797 1.44033982 0.70155485 ## [7] 0.50497148 0.40075652 0.33988059 ## [10] 0.32209933 0.26697913 0.25997298 ## [13] 0.23301811 0.22980121 0.21847876 ## [16] 0.18690795 0.16991019 0.15128742 ## [19] 0.14675786 0.13845947 0.11959460 ## [22] 0.11392462 0.10610977 0.10095204 ## [25] 0.08096761 0.07461259 0.06823503 ## [28] 0.06325777 0.04192702 0.03764140 ## [31] 0.02514642 # Make Cattell's Scree plot of eigenvalues This makes us # choose for 5 or 6 plot(pca$values, type = "b", ylab = "Eigenvalues", xlab = "Number of Principal Components",
main = "Cattell's Scree plot")

# Check cumulative PVE We want at least 70%, so we could go
# for 3
cumsum(prop.table(pca$values)) ## [1] 0.4738120 0.6540642 0.7322851 0.7889179 ## [5] 0.8353805 0.8580113 0.8743007 0.8872283 ## [9] 0.8981922 0.9085825 0.9171947 0.9255810 ## [13] 0.9330977 0.9405106 0.9475583 0.9535876 ## [17] 0.9590686 0.9639488 0.9686830 0.9731494 ## [21] 0.9770073 0.9806823 0.9841052 0.9873617 ## [25] 0.9899735 0.9923804 0.9945815 0.9966221 ## [29] 0.9979746 0.9991888 1.0000000 # Plot cumulative PVE Not so clear cut, maybe 4 or 5 plot(cumsum(prop.table(pca$values)), type = "b", ylab = "Cumulative Proportion of Variance Explained (%)",
xlab = "Number of Principal Components", main = "Selecting the optimal number of PCs")

# MORE ADVANCED METHODS

# Horn's Parallel Analysis By default, fa.parallel takes
# the mean of the eigenvalues of the random matrices.  By
# specifying quant=0.95, the 95th percentile (as originally
# in Horn (1965)) are used instead.
hpa <- fa.parallel(x = nums, fm = "ml", fa = "pc", n.iter = 50)

## Parallel analysis suggests that the number of factors =  NA  and the number of components =  5

Since most methods give around approximately around 5 PCs, 5 PCs would be a good final choice. It is always advisable to try out different methods and check for consistency. Remember that you can also apply a varimax rotation to increase interpretabiliy.

# Rotations
pca2 <- principal(nums, nfactors = 5, rotate = "varimax")

# Check interpretation You can see that the the first PC is
# now clearly ball handling or even striking skills
# Especially PC2 is more clear since it loads very high on
# marking and tackles, which are defensive skills
pca2$loadings ## ## Loadings: ## RC1 RC2 RC4 RC3 ## overall_rating 0.294 0.119 0.893 ## potential 0.215 0.152 0.814 ## crossing 0.706 0.329 0.422 0.124 ## finishing 0.870 -0.293 0.197 ## heading_accuracy 0.514 0.462 ## short_passing 0.767 0.453 0.254 0.180 ## volleys 0.876 -0.150 0.188 0.144 ## dribbling 0.829 0.458 ## curve 0.810 0.110 0.313 0.168 ## free_kick_accuracy 0.811 0.170 0.159 0.178 ## long_passing 0.566 0.564 0.168 0.297 ## ball_control 0.837 0.263 0.357 0.142 ## acceleration 0.446 0.819 ## sprint_speed 0.444 0.772 ## agility 0.473 0.762 0.161 ## reactions 0.337 0.140 0.792 ## balance 0.374 0.113 0.718 ## shot_power 0.855 0.110 0.130 0.152 ## jumping -0.163 0.170 0.270 0.320 ## stamina 0.452 0.534 0.364 0.105 ## strength 0.343 -0.506 0.188 ## long_shots 0.900 0.179 0.156 ## aggression 0.221 0.754 0.169 ## interceptions 0.927 0.157 ## positioning 0.861 0.285 0.153 ## vision 0.794 0.185 0.199 0.304 ## penalties 0.842 0.191 ## marking 0.966 ## standing_tackle 0.975 ## sliding_tackle 0.966 ## gk_reflexes -0.634 -0.441 -0.318 0.359 ## RC5 ## overall_rating 0.129 ## potential ## crossing -0.148 ## finishing 0.157 ## heading_accuracy 0.591 ## short_passing ## volleys ## dribbling ## curve -0.148 ## free_kick_accuracy -0.191 ## long_passing -0.274 ## ball_control ## acceleration 0.119 ## sprint_speed 0.216 ## agility ## reactions 0.119 ## balance -0.133 ## shot_power 0.203 ## jumping 0.635 ## stamina 0.272 ## strength 0.618 ## long_shots ## aggression 0.329 ## interceptions ## positioning 0.102 ## vision -0.142 ## penalties 0.128 ## marking ## standing_tackle ## sliding_tackle ## gk_reflexes -0.234 ## ## RC1 RC2 RC4 RC3 RC5 ## SS loadings 11.217 6.038 3.945 2.907 1.790 ## Proportion Var 0.362 0.195 0.127 0.094 0.058 ## Cumulative Var 0.362 0.557 0.684 0.778 0.835 # Make a biplot to check the differences between rotation # and no rotation Do make good biplot, only select the # first two PCs pca <- principal(nums, nfactors = 2, rotate = "none") pca2 <- principal(nums, nfactors = 2, rotate = "varimax") biplot(pca) biplot(pca2) If there are nonlinear relationhsip, it can be good to also try out kernel PCA. If you do not have a response variable, it is of course hard to tell whether there are nonlinearities in the data. Let’s make a synthetic data set to show the power of kpca when the data in highly nonlinear. # Load the following github directory to make a special # data set p_load_current_gh("elbamos/clusteringdatasets") # Make moons data set synt <- data.frame(make_moons(n_samples = 1000, noise = 0.02)) ggplot(synt, aes(samples.1, samples.2, col = as.factor(labels))) + geom_point() # As you can see this data is no lineary separable So let's # perform PCA and see what happens As you can see the data # is no linearly separable pca3 <- principal(synt[, 1:2], nfactors = 2, rotate = "varimax") scores <- as.data.frame(cbind(pca3$scores, synt$labels)) ggplot(scores, aes(RC1, RC2, col = as.factor(V3))) + geom_point() # Perform kernel PCA # As you can see that the data is now linearly separable # Note that this is highly dependent upon your choice for # sigma p_load(kernlab) pcak <- kpca(data.matrix(synt[, 1:2]), kernel = "rbfdot", kpar = list(sigma = 15), features = 2) # Plot the scores for kPC2 and kPC2 scoresk <- as.data.frame(cbind(rotated(pcak), synt$labels))
ggplot(scoresk, aes(V1, V2, col = as.factor(V3))) + geom_point()

## 8.2 Clustering

Clustering is often used in market segmentation and can be very handy to get more insight into your target population. Recall that there are two broad categories: hierarchical and nonhierarchical methods.

We will not discuss all the distance metrics in detail but mention them along the road.

### 8.2.1 Partitional clustering

Probably the most popular partitional clustering method is k-means. The algorithm is simple and intuitive and works well in a lot of cases. Recall that k-means works with Euclidean distances, so scaling the data is crucial.K-means is built in R by default in the stats package, so we don’t need to load any other packages.

#We will just use the football data set to see whether we can come up with a
#good clustering solution

#Cluster the scaled dataset in 4 groups (one for each position:
#goalie, defender, midfielder and attacker)
km <- kmeans(x=football_sc,
centers=4,
nstart=50)

#Plot
plot(x=football_sc,
col=(km$cluster+1), pch = 20 , cex = 1.5,main="k-means clustering") points(km$centers, col = 2:max(km$cluster+1),cex=5,pch=10)  #adds the center, although not clear #To make a cluster plot based on the PCs, use the cluster package p_load(cluster) clusplot(x=football_sc, clus= km$cluster, shade=TRUE, color= TRUE, lines = 0)

#An even nicer plot package is the fviz_cluster function of the factoextra package
#This use a ggplot style theme

fviz_cluster(km, data = football_sc,
geom = "point",
ellipse.type = "convex")

We have succesfully created clusters, however how do we know what all these clusters mean? A good solution can be to build a decision tree with the clusters as a dependent variable and the others as independent.

p_load(rpart)

# Use the unscaled data for better interpretation Can you
# guess the interpretation of each cluster?
tree_data <- data.frame(nums, cluster = as.factor(km$cluster)) dt <- rpart(cluster ~ ., tree_data) rpart.plot(dt) # You can also just have a look at the mean scores per # cluster Can you guess the interpration now? tree_data %>% group_by(cluster) %>% summarise_all(mean) ## # A tibble: 4 x 32 ## cluster overall_rating potential crossing ## <fct> <dbl> <dbl> <dbl> ## 1 1 66.5 71.2 18.9 ## 2 2 65.2 71.4 54.9 ## 3 3 64.1 69.7 48.1 ## 4 4 71.7 75.8 66.3 ## # ... with 28 more variables: finishing <dbl>, ## # heading_accuracy <dbl>, short_passing <dbl>, ## # volleys <dbl>, dribbling <dbl>, curve <dbl>, ## # free_kick_accuracy <dbl>, long_passing <dbl>, ## # ball_control <dbl>, acceleration <dbl>, ## # sprint_speed <dbl>, agility <dbl>, ## # reactions <dbl>, balance <dbl>, ... Whereas k-means uses the Euclidean distance by default, k-medoids allows you to set the distance measure yourself. Because the cluster center in the case of k-medoids is also a true data point (and not a fictional as in k-means), it can easily work with any type of data. To calculate the distances, you can just use the dist function of the stats package, check ?dist to see the various options. # To implement kmedoids we use the cluster package p_load(cluster) # Use a random subsample becasue distance measures can # takje a while random <- sample(1:nrow(nums), 1000, replace = FALSE) # Calculate dissimilarity matrix with cityblock distance ds <- stats::dist(football_sc[random, ], method = "manhattan") # Perform k-medoids kmd <- pam(x = ds, k = 4, diss = TRUE) #diss=TRUE means we supply a dissimilarity matrix to x # Plot clusplot(x = football_sc[random, ], clus = kmd$cluster, shade = TRUE,
color = TRUE, lines = 0)

# Have a look at the medoids What is the difference?
nums[random, ][kmd$medoids, ] %>% as_tibble() ## # A tibble: 4 x 31 ## overall_rating potential crossing finishing ## <dbl> <dbl> <dbl> <dbl> ## 1 64.3 74.1 63.3 64 ## 2 63.9 67.7 58.4 32 ## 3 70.8 74.3 66.7 60.6 ## 4 65.2 75.2 22 17.7 ## # ... with 27 more variables: ## # heading_accuracy <dbl>, short_passing <dbl>, ## # volleys <dbl>, dribbling <dbl>, curve <dbl>, ## # free_kick_accuracy <dbl>, long_passing <dbl>, ## # ball_control <dbl>, acceleration <dbl>, ## # sprint_speed <dbl>, agility <dbl>, ## # reactions <dbl>, balance <dbl>, ... As an exercise you can also build a decision tree and see what this says about the clusters. ### 8.2.2 Hierarchical clustering One of the downsides of partitional clustering is that you have to specificy the clusters upfront. Hierarchical clustering solves this issue and allows you to make the ‘cut’ yourself. We will focus on agglomorative clustering which applies a bootum-up approach. Again, hierarchical clustering is included in the stats package of R, so no need to load a new package. # Calculate dissimilarity ds <- stats::dist(football_sc, method = "euclidean") # Perform Hierarchical clustering with ward's method (you # can experiment with others as well) hclustering <- hclust(ds, method = "ward.D") # Plot the dendogram plot(hclustering) abline(h = 3000, col = "red", lwd = 3) # plot a red line across the dendrogram, which gives you 4 # clusters # Show the 4 clusters plot(hclustering, cex = 0.6) rect.hclust(hclustering, k = 4, border = 2:5) # Cut the tree cluster_memberships <- cutree(hclustering, 7) # We can also plot the total distance against the number of # clusters and look for a elbow The elbow is around 3 or 5 data.frame(distance = hclustering$height, clusters = cluster_memberships[-1]) %>%
group_by(clusters) %>%
dplyr::summarise(means = sum(distance)) %>%
mutate(cumul = cumsum(means)) %>%
ggplot(aes(clusters, cumul)) + geom_line()

# So let's keep it in the middle and pick 4 just like
# before
cluster_memberships <- cutree(hclustering, 4)

# Plot the cluster memberships
fviz_cluster(list(data = football_sc, cluster = cluster_memberships),
geom = "point", ellipse.type = "convex")

Whern the data is highly nonlinear, the traditional methods like k-means or k-medoids often fall short. The main reason for this is because these traditional methods are based on compactness and not on connectivity. To make the example more clear, we will use the moon data example again from kernel PCA and perform k-means, spectral clustering and DBSCAN.

# Remember the moon data
ggplot(synt, aes(samples.1, samples.2, col = as.factor(labels))) +
geom_point()

# Using Kmeans on this example would give us As you can
# see, this is not really what we want
km_synt <- kmeans(x = synt[, 1:2], centers = 2, nstart = 50)

ggplot(synt, aes(samples.1, samples.2, col = as.factor(km_synt$cluster))) + geom_point() # Let's try spectral clustering We can just use the kernel # package from kernel PCA specc_synt <- specc(x = data.matrix(synt[, 1:2]), centers = 2, iterations = 200, kernel = "rbfdot", kpar = list(sigma = 15)) # also an option to chose kpar automatically # If we plot this you nicely see that this is the solution # that we want ggplot(synt, aes(samples.1, samples.2, col = as.factor(specc_synt@.Data))) + geom_point() # Let us now do the same with DBSCAN p_load(dbscan) # Note that in DBSCAN you should not even set the number of # clusters! db_synt <- dbscan(synt[, 1:2], eps = 0.15) # And plot it ... ggplot(synt, aes(samples.1, samples.2, col = as.factor(db_synt$cluster))) +
geom_point()

# Let's try another dataset for fun
data("face")
qplot(x = face$x, y = face$y)

# Spectral
specc_face <- specc(x = data.matrix(face), centers = 5, iterations = 200,
kernel = "rbfdot")
ggplot(face, aes(x, y, col = as.factor(specc_face@.Data))) +
geom_point()

# DBSCAN
db_face <- dbscan(face, eps = 0.15)
ggplot(face, aes(x, y, col = as.factor(db_face$cluster))) + geom_point() ### 8.2.4 Cluster evaluation The question now of course arises: how to pick the best clustering solution. We have tried out several methods, however, we should know which one to pick. In theory, we proposed several methods: silhouette index, Davies-Bouldin index, and the Dunn index. A decision tree can also be build (cf. supra), however this is mainly good for interpretation purposes. # Lets rebuild our football cluster for kmeans Since we # don't know the optimal number, let's make a loop and # decide upon the aforementioned metrics Check cluster # validity for multiple values of k kms <- list() for (k in 2:6) { kms[[k]] <- kmeans(x = football_sc, centers = k, nstart = 50) } kms[[1]] <- NULL # Silhouette index (maximize) ds <- dist(football_sc, method = "euclidean") sapply(kms, function(km) summary(silhouette(km$cluster, ds))$avg.width) ## [1] 0.4286009 0.2482518 0.2307827 0.2111661 ## [5] 0.1759047 # Dunn index (maximize) p_load(clValid) sapply(kms, function(km) dunn(ds, km$cluster))
## [1] 0.08765093 0.09559838 0.09472543 0.02668480
## [5] 0.08928985
# Davies-Bouldin index (minimize)
sapply(kms, function(km) index.DB(football_sc, km$cluster)$DB)
## [1] 0.9744974 1.3988414 1.4341121 1.4800272
## [5] 1.6716166
# Choose optimal number of clusters k using all cluster
# validation measures (24 measures)
nbc <- NbClust(data = football_sc[random, ], min.nc = 2, max.nc = 5,
method = "kmeans", index = "all")

## *** : The Hubert index is a graphical method of determining the number of clusters.
##                 In the plot of Hubert index, we seek a significant knee that corresponds to a
##                 significant increase of the value of the measure i.e the significant peak in Hubert
##                 index second differences plot.
## 

## *** : The D index is a graphical method of determining the number of clusters.
##                 In the plot of D index, we seek a significant knee (the significant peak in Dindex
##                 second differences plot) that corresponds to a significant increase of the value of
##                 the measure.
##
## *******************************************************************
## * Among all indices:
## * 8 proposed 2 as the best number of clusters
## * 11 proposed 3 as the best number of clusters
## * 2 proposed 4 as the best number of clusters
## * 3 proposed 5 as the best number of clusters
##
##                    ***** Conclusion *****
##
## * According to the majority rule, the best number of clusters is  3
##
##
## *******************************************************************
# Plot, optimal number of clusters was suggested as 3
fviz_cluster(list(data = football_sc, cluster = kms[[2]]$cluster), geom = "point", ellipse.type = "convex") # Also much evidence for 2: compare fviz_cluster(list(data = football_sc, cluster = kms[[1]]$cluster),
geom = "point", ellipse.type = "convex")

Looking at the plot, it seems as if both options yield suboptimal results. Therefore, always check your results, as an alternative solution might be required. We could try the spectral clustering approach, with the suggested number of clusters (i.e., 3). However, spectral clustring mostly produces high-quality clusterings on small data sets, and has limited applicability to large scale problems due to its computational complexity. If you don’t believe me: try running this line of code:

# spectral3 <- specc(x=football_sc, centers=3,
# iterations=200, kernel='rbfdot', kpar = list(sigma = 15))

# fviz_cluster(list(data = football_sc, cluster =
# kms[[1]]$cluster), geom = 'point', ellipse.type = # 'convex' ) Some may have experienced issues due to limited working memory (Error: cannot allocate vector of size …). This can be countered by fitting your clusters on a more limited sample size as is done in the example below (with 1000 samples). Note that the determination of optimal number of clusters with the NbClust method was also based on a limited sample size. # Lets rebuild our football cluster for kmeans Since we # don't know the optimal number, let's make a loop and # decide upon the aforementioned metrics Check cluster # validity for multiple values of k kms <- list() smaller_sample <- football_sc[random, ] for (k in 2:6) { kms[[k]] <- kmeans(x = smaller_sample, centers = k, nstart = 50) } kms[[1]] <- NULL # Silhouette index (maximize) ds <- dist(smaller_sample, method = "euclidean") sapply(kms, function(km) summary(silhouette(km$cluster, ds))$avg.width) ## [1] 0.4363922 0.2315783 0.2269328 0.2138149 ## [5] 0.1822053 # Dunn index (maximize) p_load(clValid) sapply(kms, function(km) dunn(ds, km$cluster))
## [1] 0.1286129 0.1227784 0.1430272 0.1506762
## [5] 0.1585677
# Davies-Bouldin index (minimize)
sapply(kms, function(km) index.DB(smaller_sample, km$cluster)$DB)
## [1] 0.9631697 1.4681063 1.4323039 1.4379298
## [5] 1.6415087
# Choose optimal number of clusters k using all cluster
# validation measures (24 measures)
nbc <- NbClust(data = smaller_sample, min.nc = 2, max.nc = 5,
method = "kmeans", index = "all")

## *** : The Hubert index is a graphical method of determining the number of clusters.
##                 In the plot of Hubert index, we seek a significant knee that corresponds to a
##                 significant increase of the value of the measure i.e the significant peak in Hubert
##                 index second differences plot.
## 

## *** : The D index is a graphical method of determining the number of clusters.
##                 In the plot of D index, we seek a significant knee (the significant peak in Dindex
##                 second differences plot) that corresponds to a significant increase of the value of
##                 the measure.
##
## *******************************************************************
## * Among all indices:
## * 8 proposed 2 as the best number of clusters
## * 11 proposed 3 as the best number of clusters
## * 2 proposed 4 as the best number of clusters
## * 3 proposed 5 as the best number of clusters
##
##                    ***** Conclusion *****
##
## * According to the majority rule, the best number of clusters is  3
##
##
## *******************************************************************
# If we determine our number clusters on our full dataset,
# We can directly deploy the detected algorithms from this
# model Plot
fviz_cluster(list(data = smaller_sample, cluster = nbc\$Best.partition),
geom = "point", ellipse.type = "convex")