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=