Clustering

Back to Homepage

Unsupervised methods typically require more effort to interpret results. No response variable exists in the data nor so we don’t know exactly what the outcome will uncover.

Clustering is a familiar unsupervised method that groups data into clusters based on the analyst’s selected features and the variance of the features. Clustering requires data of different units be normalized and has a few tuning parameters:

K-means Clustering

The k in K-means clustering represents the number of expected clusters. We define k before the analysis.

Create some random data: - Create a matrix with 100 rows and two columns

set.seed(101)
x <- matrix(rnorm(100*2),100,2)
head(x)
           [,1]       [,2]
[1,] -0.3260365  0.2680658
[2,]  0.5524619 -0.5922083
[3,] -0.6749438  2.1334864
[4,]  0.2143595  1.1727487
[5,]  0.3107692  0.7467610
[6,]  1.1739663 -0.2305087
  • Create some artificial clustering attribute by creating a table (x_mean) and applying values from that table to the x matrix
x_mean <- matrix(rnorm(8, sd=4), 4, 2)
which <- sample(1:4, 100, replace = TRUE)
x <- x+x_mean[which,]

Plot the randomly selected points. They are col indicates the points will be colored by the value of which. The which variable is just the numbers one through four repeated 100 times.

plot(x, col=which, pch=19)

Use K-means to find the clusters (we already know the clusters)

km.out <- kmeans(x, 4, nstart=15)
km.out
K-means clustering with 4 clusters of sizes 21, 30, 32, 17

Cluster means:
        [,1]       [,2]
1 -3.1068542  1.1213302
2  1.7226318 -0.2584919
3 -5.5818142  3.3684991
4 -0.6148368  4.8861032

Clustering vector:
  [1] 2 3 3 4 1 1 4 3 2 3 2 1 1 3 1 1 2 3 3 2 2 3 1 3 1 1 2 2 3 1
 [31] 1 4 3 1 3 3 1 2 2 3 2 2 3 3 1 3 1 3 4 2 1 2 2 4 3 3 2 2 3 2
 [61] 1 2 3 4 2 4 3 4 4 2 2 4 3 2 3 4 4 2 2 1 2 4 4 3 3 2 3 3 1 2
 [91] 3 2 4 4 4 2 3 3 1 1

Within cluster sum of squares by cluster:
[1] 30.82790 54.48008 71.98228 21.04952
 (between_SS / total_SS =  87.6 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"    
[5] "tot.withinss" "betweenss"    "size"         "iter"        
[9] "ifault"      

total_SS = the percent of variation explained by the clusters. In this case it is 87.6%.

Create a plot of the results of the kmeans function. We overlay the first plot with the kmeans plot using a different marker to show a comparison of the two plots.

plot(x, col=km.out$cluster, cex=2, pch=1, lwd=2)
points(x, col=c(4,3,2,1)[which],pch=19)

We see the kmeans function was able to detect our manually created our clusters, mislabeling only two data points.

Hierarchical Clustering

Use the same data but with the hierarchical clustering method. We do not provide a k or number of clusters before hand. This method groups based on a distance parameter, making small groups and then large groups until all the data is in one group. The groupings are plotted in a dendrogram. We then select the number of groupings to be interpreted.

We use the complete as he linkage method.

hc.complete <- hclust(dist(x), method="complete")
plot(hc.complete)

An analyst would select the cutoff height from which to interpret groupings.

hc.single <- hclust(dist(x), method="single")
plot(hc.single)

Compare the results at cutoff point 4 with our manually generated clusters to see if the function found the clusters.

hc.cut <- cutree(hc.complete, 4)
table(hc.cut,which)
      which
hc.cut  1  2  3  4
     1  0  0 30  0
     2  1 31  0  2
     3 17  0  0  0
     4  0  0  0 19

The smaller numbers indicate misclassifications. There are three misclassifications (1+2)

Compare the results at cutoff point 4 with our kmeans clusters to see if the function found the clusters.

table(hc.cut, km.out$cluster)
      
hc.cut  1  2  3  4
     1  0 30  0  0
     2  2  0 32  0
     3  0  0  0 17
     4 19  0  0  0

In this case there were two misclassifications.

plot(hc.complete, labels=which)

LS0tDQp0aXRsZTogIlVuc3VwZXJ2aXNlZCBNZXRob2RzIg0Kb3V0cHV0Og0KICBodG1sX25vdGVib29rOg0KICAgIGZpZ19oZWlnaHQ6IDYNCiAgaHRtbF9kb2N1bWVudDogZGVmYXVsdA0KICBwZGZfZG9jdW1lbnQ6IGRlZmF1bHQNCiAgd29yZF9kb2N1bWVudDogZGVmYXVsdA0KLS0tDQoNCiMgQ2x1c3RlcmluZw0KW0JhY2sgdG8gSG9tZXBhZ2VdKGh0dHBzOi8vYWxleGlzaWRsZXR0ZXdpbHNvbi5naXRodWIuaW8vKQ0KDQpVbnN1cGVydmlzZWQgbWV0aG9kcyB0eXBpY2FsbHkgcmVxdWlyZSBtb3JlIGVmZm9ydCB0byBpbnRlcnByZXQgcmVzdWx0cy4gTm8gcmVzcG9uc2UgdmFyaWFibGUgZXhpc3RzIGluIHRoZSBkYXRhIG5vciBzbyB3ZSBkb24ndCBrbm93IGV4YWN0bHkgd2hhdCB0aGUgb3V0Y29tZSB3aWxsIHVuY292ZXIuDQoNCkNsdXN0ZXJpbmcgaXMgYSBmYW1pbGlhciB1bnN1cGVydmlzZWQgbWV0aG9kIHRoYXQgZ3JvdXBzIGRhdGEgaW50byBjbHVzdGVycyBiYXNlZCBvbiB0aGUgYW5hbHlzdCdzIHNlbGVjdGVkIGZlYXR1cmVzIGFuZCB0aGUgdmFyaWFuY2Ugb2YgdGhlIGZlYXR1cmVzLiBDbHVzdGVyaW5nIHJlcXVpcmVzIGRhdGEgb2YgZGlmZmVyZW50IHVuaXRzIGJlIG5vcm1hbGl6ZWQgYW5kIGhhcyBhIGZldyB0dW5pbmcgcGFyYW1ldGVyczoNCg0KLSBXaGF0IGRpc3NpbWlsYXJpdHkgbWVhc3VyZSBzaG91bGQgYmUgdXNlZCAoaG93IGRvIHdlIGRlZmluZSAiZGlmZmVyZW50IikNCi0gV2hhdCAibGlua2FnZSIgc2hvdWxkIGJlIHVzZWQgKGhvdyB3aWxsIHdlIG1lYXN1cmUgdGhlIGRpc3RhbmNlIGJldHdlZW4gcGxvdHRlZCBvYnNlcnZhdGlvbnMpDQotIFdoYXQgZmVhdHVyZXMgd2lsbCBiZSB1c2VkIHRvIGdlbmVyYXRlIHRoZSBjbHVzdGVycw0KDQojIyBLLW1lYW5zIENsdXN0ZXJpbmcNCg0KVGhlIGBrYCBpbiBLLW1lYW5zIGNsdXN0ZXJpbmcgcmVwcmVzZW50cyB0aGUgbnVtYmVyIG9mIGV4cGVjdGVkIGNsdXN0ZXJzLiBXZSBkZWZpbmUgYGtgIGJlZm9yZSB0aGUgYW5hbHlzaXMuDQoNCkNyZWF0ZSBzb21lIHJhbmRvbSBkYXRhOg0KLSBDcmVhdGUgYSBtYXRyaXggd2l0aCAxMDAgcm93cyBhbmQgdHdvIGNvbHVtbnMNCmBgYHtyfQ0Kc2V0LnNlZWQoMTAxKQ0KeCA8LSBtYXRyaXgocm5vcm0oMTAwKjIpLDEwMCwyKQ0KaGVhZCh4KQ0KYGBgDQoNCi0gQ3JlYXRlIHNvbWUgYXJ0aWZpY2lhbCBjbHVzdGVyaW5nIGF0dHJpYnV0ZSBieSBjcmVhdGluZyBhIHRhYmxlICh4X21lYW4pIGFuZCBhcHBseWluZyB2YWx1ZXMgZnJvbSB0aGF0IHRhYmxlIHRvIHRoZSB4IG1hdHJpeA0KYGBge3J9DQp4X21lYW4gPC0gbWF0cml4KHJub3JtKDgsIHNkPTQpLCA0LCAyKQ0Kd2hpY2ggPC0gc2FtcGxlKDE6NCwgMTAwLCByZXBsYWNlID0gVFJVRSkNCnggPC0geCt4X21lYW5bd2hpY2gsXQ0KDQpgYGANCg0KUGxvdCB0aGUgcmFuZG9tbHkgc2VsZWN0ZWQgcG9pbnRzLiBUaGV5IGFyZSAqY29sKiBpbmRpY2F0ZXMgdGhlIHBvaW50cyB3aWxsIGJlIGNvbG9yZWQgYnkgdGhlIHZhbHVlIG9mIGB3aGljaGAuIFRoZSBgd2hpY2hgIHZhcmlhYmxlIGlzIGp1c3QgdGhlIG51bWJlcnMgb25lIHRocm91Z2ggZm91ciByZXBlYXRlZCAxMDAgdGltZXMuDQpgYGB7cn0NCnBsb3QoeCwgY29sPXdoaWNoLCBwY2g9MTkpDQpgYGANCg0KVXNlIEstbWVhbnMgdG8gZmluZCB0aGUgY2x1c3RlcnMgKHdlIGFscmVhZHkga25vdyB0aGUgY2x1c3RlcnMpDQpgYGB7cn0NCmttLm91dCA8LSBrbWVhbnMoeCwgNCwgbnN0YXJ0PTE1KQ0Ka20ub3V0DQpgYGANCg0KdG90YWxfU1MgPSB0aGUgcGVyY2VudCBvZiB2YXJpYXRpb24gZXhwbGFpbmVkIGJ5IHRoZSBjbHVzdGVycy4gSW4gdGhpcyBjYXNlIGl0IGlzIDg3LjYlLiANCg0KQ3JlYXRlIGEgcGxvdCBvZiB0aGUgcmVzdWx0cyBvZiB0aGUgKmttZWFucyogZnVuY3Rpb24uIFdlIG92ZXJsYXkgdGhlIGZpcnN0IHBsb3Qgd2l0aCB0aGUgKmttZWFucyogcGxvdCB1c2luZyBhIGRpZmZlcmVudCBtYXJrZXIgdG8gc2hvdyBhIGNvbXBhcmlzb24gb2YgdGhlIHR3byBwbG90cy4NCmBgYHtyfQ0KcGxvdCh4LCBjb2w9a20ub3V0JGNsdXN0ZXIsIGNleD0yLCBwY2g9MSwgbHdkPTIpDQpwb2ludHMoeCwgY29sPWMoNCwzLDIsMSlbd2hpY2hdLHBjaD0xOSkNCmBgYA0KDQpXZSBzZWUgdGhlICprbWVhbnMqIGZ1bmN0aW9uIHdhcyBhYmxlIHRvIGRldGVjdCBvdXIgbWFudWFsbHkgY3JlYXRlZCBvdXIgY2x1c3RlcnMsIG1pc2xhYmVsaW5nIG9ubHkgdHdvIGRhdGEgcG9pbnRzLg0KDQojIyBIaWVyYXJjaGljYWwgQ2x1c3RlcmluZw0KDQpVc2UgdGhlIHNhbWUgZGF0YSBidXQgd2l0aCB0aGUgaGllcmFyY2hpY2FsIGNsdXN0ZXJpbmcgbWV0aG9kLiBXZSBkbyBub3QgcHJvdmlkZSBhIGBrYCBvciBudW1iZXIgb2YgY2x1c3RlcnMgYmVmb3JlIGhhbmQuIFRoaXMgbWV0aG9kIGdyb3VwcyBiYXNlZCBvbiBhIGRpc3RhbmNlIHBhcmFtZXRlciwgbWFraW5nIHNtYWxsIGdyb3VwcyBhbmQgdGhlbiBsYXJnZSBncm91cHMgdW50aWwgYWxsIHRoZSBkYXRhIGlzIGluIG9uZSBncm91cC4gVGhlIGdyb3VwaW5ncyBhcmUgcGxvdHRlZCBpbiBhIGRlbmRyb2dyYW0uIFdlIHRoZW4gc2VsZWN0IHRoZSBudW1iZXIgb2YgZ3JvdXBpbmdzIHRvIGJlIGludGVycHJldGVkLg0KDQpXZSB1c2UgdGhlIGBjb21wbGV0ZWAgYXMgaGUgbGlua2FnZSBtZXRob2QuIA0KDQpgYGB7cn0NCmhjLmNvbXBsZXRlIDwtIGhjbHVzdChkaXN0KHgpLCBtZXRob2Q9ImNvbXBsZXRlIikNCnBsb3QoaGMuY29tcGxldGUpDQpgYGANCg0KQW4gYW5hbHlzdCB3b3VsZCBzZWxlY3QgdGhlIGN1dG9mZiBoZWlnaHQgZnJvbSB3aGljaCB0byBpbnRlcnByZXQgZ3JvdXBpbmdzLg0KDQpgYGB7cn0NCmhjLnNpbmdsZSA8LSBoY2x1c3QoZGlzdCh4KSwgbWV0aG9kPSJzaW5nbGUiKQ0KcGxvdChoYy5zaW5nbGUpDQpgYGANCg0KQ29tcGFyZSB0aGUgcmVzdWx0cyBhdCBjdXRvZmYgcG9pbnQgYDRgIHdpdGggb3VyIG1hbnVhbGx5IGdlbmVyYXRlZCBjbHVzdGVycyB0byBzZWUgaWYgdGhlIGZ1bmN0aW9uIGZvdW5kIHRoZSBjbHVzdGVycy4NCg0KYGBge3J9DQpoYy5jdXQgPC0gY3V0cmVlKGhjLmNvbXBsZXRlLCA0KQ0KdGFibGUoaGMuY3V0LHdoaWNoKQ0KYGBgDQpUaGUgc21hbGxlciBudW1iZXJzIGluZGljYXRlIG1pc2NsYXNzaWZpY2F0aW9ucy4gVGhlcmUgYXJlIHRocmVlIG1pc2NsYXNzaWZpY2F0aW9ucyAoMSsyKQ0KDQpDb21wYXJlIHRoZSByZXN1bHRzIGF0IGN1dG9mZiBwb2ludCBgNGAgd2l0aCBvdXIgYGttZWFuc2AgY2x1c3RlcnMgdG8gc2VlIGlmIHRoZSBmdW5jdGlvbiBmb3VuZCB0aGUgY2x1c3RlcnMuDQpgYGB7cn0NCnRhYmxlKGhjLmN1dCwga20ub3V0JGNsdXN0ZXIpDQpgYGANCg0KSW4gdGhpcyBjYXNlIHRoZXJlIHdlcmUgdHdvIG1pc2NsYXNzaWZpY2F0aW9ucy4NCg0KYGBge3J9DQpwbG90KGhjLmNvbXBsZXRlLCBsYWJlbHM9d2hpY2gpDQpgYGANCg0K