library(swirl)
swirl()

Dataset of “Human Activity Recognition database” by University of California, Irvin

dim(ssd)
names(ssd[,562:563])
table(ssd$subject)
table(ssd$activity)
sum(table(ssd$activity))
sub1 <- subset(ssd, subject == 1) 
names(sub1[,1:12])

We’ll still focus on the 3 dimensions of mean acceleration

mdist <- dist(sub1[,1:3])

This will use the Euclidean distance as its default metric.

hclustering <- hclust(mdist)

AVERAGE ACceleration: is not helpfull

myplclust(hclustering,lab.col =unclass(sub1$activity) )

Max acceleration

 mdist<-dist(sub1[,10:12])
hclustering<- hclust(mdist)
myplclust(hclustering, lab.col=unclass(sub1$activity) )

Using SVD

svd1<-svd(scale(sub1[,-c(562,563)]))

To see LEFT singular vectors of sub1, which component of svd1 we would examine U component we’ll look at the RIGHT singular vectors (the columns of svd1$v)

maxCon <- which.max(svd1$v[,2])
mdist <- dist(sub1[,c(10:12,maxCon)])
hclustering<- hclust(mdist)
myplclust(hclustering, lab.col = unclass(sub1$activity))

Some of the activities asre still messed up. K-means

names(sub1[maxCon])
kClust<-kmeans(sub1[,-c(562,563)], centers=6)
table(kClust$cluster,sub1$activity )

| Your exact output will depend on the state of your random number | generator. We notice that when we just run with 1 random start, the | clusters tend to group the nonmoving activities together in one | cluster. The walking activities seem to cluster individually by | themselves. You could run the call to kmeans with one random start | again and you’ll probably get a slightly different result, but … instead call kmeans with 3 arguments, the last of which will tell | it to try more random starts and return the best one. The first 2 | arguments should be the same as before (sub1 with the last 2 columns | removed and centers set equal to 6). The third is nstart set equal to | 100. Put the result in kClust again.

kClust<-kmeans(sub1[,-c(562,563)], centers=6, nstart = 100)
table(kClust$cluster,sub1$activity )

We see that even with 100 random starts, the passive activities tend to cluster together. One of the clusters contains only laying, but in another cluster, standing and sitting group together.

dim(kClust$centers)
[1]   6 561

So the centers are a 6 by 561 array.

laying<-which( kClust$size==29)
plot(kClust$centers[laying,1:12], pch = 19, ylab = "Laying Cluster")

We see the first 3 columns dominate this cluster center.

names(sub1[,1:3])

So the 3 directions of mean body acceleration seem to have the biggest effect on laying.

walkdown<-which(kClust$size==49)
plot(kClust$centers[walkdown,1:12], pch=19, ylab = "Walkdown Cluster" )
LS0tCnRpdGxlOiAiQ2x1c3RlcmluZyIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKYGBge3J9CmxpYnJhcnkoc3dpcmwpCnN3aXJsKCkKYGBgCgpEYXRhc2V0IG9mICJIdW1hbiBBY3Rpdml0eSBSZWNvZ25pdGlvbiBkYXRhYmFzZSIgYnkgVW5pdmVyc2l0eSBvZiBDYWxpZm9ybmlhLCBJcnZpbgoKYGBge3J9CmRpbShzc2QpCm5hbWVzKHNzZFssNTYyOjU2M10pCnRhYmxlKHNzZCRzdWJqZWN0KQp0YWJsZShzc2QkYWN0aXZpdHkpCnN1bSh0YWJsZShzc2QkYWN0aXZpdHkpKQpgYGAKCmBgYHtyfQpzdWIxIDwtIHN1YnNldChzc2QsIHN1YmplY3QgPT0gMSkgCm5hbWVzKHN1YjFbLDE6MTJdKQpgYGAKV2UnbGwgc3RpbGwgZm9jdXMgb24gdGhlIDMgZGltZW5zaW9ucyBvZiBtZWFuIGFjY2VsZXJhdGlvbgpgYGB7cn0KbWRpc3QgPC0gZGlzdChzdWIxWywxOjNdKQpgYGAKVGhpcyB3aWxsIHVzZSB0aGUgRXVjbGlkZWFuIGRpc3RhbmNlIGFzIGl0cyBkZWZhdWx0IG1ldHJpYy4KYGBge3J9CmhjbHVzdGVyaW5nIDwtIGhjbHVzdChtZGlzdCkKYGBgCkFWRVJBR0UgQUNjZWxlcmF0aW9uOiBpcyBub3QgaGVscGZ1bGwKYGBge3J9Cm15cGxjbHVzdChoY2x1c3RlcmluZyxsYWIuY29sID11bmNsYXNzKHN1YjEkYWN0aXZpdHkpICkKYGBgCgpNYXggYWNjZWxlcmF0aW9uCmBgYHtyfQogbWRpc3Q8LWRpc3Qoc3ViMVssMTA6MTJdKQpoY2x1c3RlcmluZzwtIGhjbHVzdChtZGlzdCkKbXlwbGNsdXN0KGhjbHVzdGVyaW5nLCBsYWIuY29sPXVuY2xhc3Moc3ViMSRhY3Rpdml0eSkgKQoKYGBgCgpVc2luZyBTVkQKYGBge3J9CnN2ZDE8LXN2ZChzY2FsZShzdWIxWywtYyg1NjIsNTYzKV0pKQpgYGAKClRvIHNlZSBMRUZUIHNpbmd1bGFyIHZlY3RvcnMgb2Ygc3ViMSwgd2hpY2ggY29tcG9uZW50IG9mIHN2ZDEgd2Ugd291bGQgZXhhbWluZSBVIGNvbXBvbmVudAp3ZSdsbCBsb29rIGF0IHRoZSBSSUdIVCBzaW5ndWxhciB2ZWN0b3JzICh0aGUgY29sdW1ucyBvZiBzdmQxJHYpCgoKYGBge3J9Cm1heENvbiA8LSB3aGljaC5tYXgoc3ZkMSR2WywyXSkKbWRpc3QgPC0gZGlzdChzdWIxWyxjKDEwOjEyLG1heENvbildKQpoY2x1c3RlcmluZzwtIGhjbHVzdChtZGlzdCkKbXlwbGNsdXN0KGhjbHVzdGVyaW5nLCBsYWIuY29sID0gdW5jbGFzcyhzdWIxJGFjdGl2aXR5KSkKYGBgCgpTb21lIG9mIHRoZSBhY3Rpdml0aWVzIGFzcmUgc3RpbGwgbWVzc2VkIHVwLiBLLW1lYW5zCmBgYHtyfQpuYW1lcyhzdWIxW21heENvbl0pCmtDbHVzdDwta21lYW5zKHN1YjFbLC1jKDU2Miw1NjMpXSwgY2VudGVycz02KQp0YWJsZShrQ2x1c3QkY2x1c3RlcixzdWIxJGFjdGl2aXR5ICkKYGBgCnwgWW91ciBleGFjdCBvdXRwdXQgd2lsbCBkZXBlbmQgb24gdGhlIHN0YXRlIG9mIHlvdXIgcmFuZG9tIG51bWJlcgp8IGdlbmVyYXRvci4gV2Ugbm90aWNlIHRoYXQgd2hlbiB3ZSBqdXN0IHJ1biB3aXRoIDEgcmFuZG9tIHN0YXJ0LCB0aGUKfCBjbHVzdGVycyB0ZW5kIHRvIGdyb3VwIHRoZSBub25tb3ZpbmcgYWN0aXZpdGllcyB0b2dldGhlciBpbiBvbmUKfCBjbHVzdGVyLiBUaGUgd2Fsa2luZyBhY3Rpdml0aWVzIHNlZW0gdG8gY2x1c3RlciBpbmRpdmlkdWFsbHkgYnkKfCB0aGVtc2VsdmVzLiBZb3UgY291bGQgcnVuIHRoZSBjYWxsIHRvIGttZWFucyB3aXRoIG9uZSByYW5kb20gc3RhcnQKfCBhZ2FpbiBhbmQgeW91J2xsIHByb2JhYmx5IGdldCBhIHNsaWdodGx5IGRpZmZlcmVudCByZXN1bHQsIGJ1dAouLi4gaW5zdGVhZCBjYWxsIGttZWFucyB3aXRoIDMgYXJndW1lbnRzLCB0aGUgbGFzdCBvZiB3aGljaCB3aWxsIHRlbGwKfCBpdCB0byB0cnkgbW9yZSByYW5kb20gc3RhcnRzIGFuZCByZXR1cm4gdGhlIGJlc3Qgb25lLiBUaGUgZmlyc3QgMgp8IGFyZ3VtZW50cyBzaG91bGQgYmUgdGhlIHNhbWUgYXMgYmVmb3JlIChzdWIxIHdpdGggdGhlIGxhc3QgMiBjb2x1bW5zCnwgcmVtb3ZlZCBhbmQgY2VudGVycyBzZXQgZXF1YWwgdG8gNikuIFRoZSB0aGlyZCBpcyBuc3RhcnQgc2V0IGVxdWFsIHRvCnwgMTAwLiBQdXQgdGhlIHJlc3VsdCBpbiBrQ2x1c3QgYWdhaW4uCgoKYGBge3J9CmtDbHVzdDwta21lYW5zKHN1YjFbLC1jKDU2Miw1NjMpXSwgY2VudGVycz02LCBuc3RhcnQgPSAxMDApCnRhYmxlKGtDbHVzdCRjbHVzdGVyLHN1YjEkYWN0aXZpdHkgKQpgYGAKV2Ugc2VlIHRoYXQgZXZlbiB3aXRoIDEwMCByYW5kb20gc3RhcnRzLCB0aGUgcGFzc2l2ZSBhY3Rpdml0aWVzIHRlbmQKdG8gY2x1c3RlciB0b2dldGhlci4gT25lIG9mIHRoZSBjbHVzdGVycyBjb250YWlucyBvbmx5IGxheWluZywgYnV0IGluCmFub3RoZXIgY2x1c3Rlciwgc3RhbmRpbmcgYW5kIHNpdHRpbmcgZ3JvdXAgdG9nZXRoZXIuCmBgYHtyfQpkaW0oa0NsdXN0JGNlbnRlcnMpClsxXSAgIDYgNTYxCmBgYAoKU28gdGhlIGNlbnRlcnMgYXJlIGEgNiBieSA1NjEgYXJyYXkuCmBgYHtyfQpsYXlpbmc8LXdoaWNoKCBrQ2x1c3Qkc2l6ZT09MjkpCnBsb3Qoa0NsdXN0JGNlbnRlcnNbbGF5aW5nLDE6MTJdLCBwY2ggPSAxOSwgeWxhYiA9ICJMYXlpbmcgQ2x1c3RlciIpCmBgYApXZSBzZWUgdGhlIGZpcnN0IDMgY29sdW1ucyBkb21pbmF0ZSB0aGlzIGNsdXN0ZXIgY2VudGVyLgoKCmBgYHtyfQpuYW1lcyhzdWIxWywxOjNdKQpgYGAKCgpTbyB0aGUgMyBkaXJlY3Rpb25zIG9mIG1lYW4gYm9keSBhY2NlbGVyYXRpb24gc2VlbSB0byBoYXZlIHRoZSBiaWdnZXN0IGVmZmVjdCBvbiBsYXlpbmcuCgpgYGB7cn0Kd2Fsa2Rvd248LXdoaWNoKGtDbHVzdCRzaXplPT00OSkKcGxvdChrQ2x1c3QkY2VudGVyc1t3YWxrZG93biwxOjEyXSwgcGNoPTE5LCB5bGFiID0gIldhbGtkb3duIENsdXN0ZXIiICkKYGBgCgo=