Executive Summary

After downloading and cleaning the data to select only acceleration predictors, two different models, random trees and generalized boosted regression, were run on 60% of the training set. The models were then run on the remaining of the 40% testing set to test for accuracy. The model with the best performance, random trees, was then chosen to run on the given testing set. The results are given below.

Introduction

Six participants were asked to perform barbell lifts correctly and incorrectly in 5 different ways. The goal of the project is to use data from accelerometers on the belt, forearm, arm, and dumbell to predict whether or not the barbell lift was perfomed correctly. The report describes the building of the model including dealing with missing data and deciding which model method to use.

Data Preparation

Data is downloaded from the given urls.

Then, data is saved into r for processing.

training <- read.csv("trainingdata.csv", stringsAsFactors = FALSE)
testing <- read.csv("testingdata.csv", stringsAsFactors = FALSE)

Data Cleaning

The dataset is very large, so we are able to break the data into two pieces, one to train the models and the other to test the models for accuracy.

set.seed(23846)
inTrain <- createDataPartition(y = training$classe, p=0.6, list = FALSE )
trainset <- training[inTrain,]
testset <- training[-inTrain,]

Select only predictors that indicate acceleration. After working with the first selection, it becomes clear that predictors that measure the variance of the acceleration need to be excluded.

dim(trainset)
[1] 11776    17

This leaves us with 16 predictors.

names(trainset)
 [1] "classe"               "total_accel_belt"    
 [3] "accel_belt_x"         "accel_belt_y"        
 [5] "accel_belt_z"         "total_accel_arm"     
 [7] "accel_arm_x"          "accel_arm_y"         
 [9] "accel_arm_z"          "total_accel_dumbbell"
[11] "accel_dumbbell_x"     "accel_dumbbell_y"    
[13] "accel_dumbbell_z"     "total_accel_forearm" 
[15] "accel_forearm_x"      "accel_forearm_y"     
[17] "accel_forearm_z"     

Remove predictors with minimal variance or missing values

Remove predictors with minimal variance (this turns out to have little effect).

nsv <- nearZeroVar(trainset, saveMetrics = TRUE)
trainset <- trainset[, nsv$nzv==FALSE]
dim(trainset)
[1] 11776    17

Remove predictors with missing values (this turns out to have little effect).

dim(trainset)
[1] 11776    17

Model Building

Random Forest

Training

model1$finalModel

Call:
 randomForest(x = x, y = y, mtry = param$mtry) 
               Type of random forest: classification
                     Number of trees: 500
No. of variables tried at each split: 2

        OOB estimate of  error rate: 6.06%
Confusion matrix:
     A    B    C    D    E class.error
A 3213   22   52   59    2  0.04032258
B  100 2049   87   24   19  0.10092146
C   41   60 1931   15    7  0.05988315
D   44    7   89 1779   11  0.07823834
E    3   25   25   22 2090  0.03464203

Validation

We then validate the model obtained model \(model1\) on the test data to find out how well it performs by looking at the Accuracy variable.

cmrf$overall
      Accuracy          Kappa  AccuracyLower  AccuracyUpper 
  9.418812e-01   9.264350e-01   9.364741e-01   9.469571e-01 
  AccuracyNull AccuracyPValue  McnemarPValue 
  2.844762e-01   0.000000e+00   1.687764e-12 

We see the accuracy of the “rt” model is 94%. ## Generalized Boosted Regression ### Training

model2$finalModel
A gradient boosted model with multinomial loss function.
150 iterations were performed.
There were 16 predictors of which 16 had non-zero influence.
# print model summary
print(model2)
Stochastic Gradient Boosting 

11776 samples
   16 predictor
    5 classes: 'A', 'B', 'C', 'D', 'E' 

No pre-processing
Resampling: Cross-Validated (5 fold, repeated 1 times) 
Summary of sample sizes: 9420, 9422, 9420, 9421, 9421 
Resampling results across tuning parameters:

  interaction.depth  n.trees  Accuracy   Kappa    
  1                   50      0.5454308  0.4166360
  1                  100      0.6046194  0.4948253
  1                  150      0.6370584  0.5369123
  2                   50      0.6560795  0.5608886
  2                  100      0.7314882  0.6585172
  2                  150      0.7676625  0.7050553
  3                   50      0.7324214  0.6594103
  3                  100      0.7896571  0.7330953
  3                  150      0.8202283  0.7720946

Tuning parameter 'shrinkage' was held constant at a value
 of 0.1
Tuning parameter 'n.minobsinnode' was held constant
 at a value of 10
Accuracy was used to select the optimal model using
 the largest value.
The final values used for the model were n.trees =
 150, interaction.depth = 3, shrinkage = 0.1
 and n.minobsinnode = 10.

Validation

We then validate the model obtained model \(model1\) on the test data to find out how well it performs by looking at the Accuracy variable.

cmgbm$overall
      Accuracy          Kappa  AccuracyLower  AccuracyUpper 
  8.202906e-01   7.721739e-01   8.116128e-01   8.287298e-01 
  AccuracyNull AccuracyPValue  McnemarPValue 
  2.844762e-01   0.000000e+00   3.239876e-36 

We see that the accuracy of the “gbm” model on the testset is 82%. # Running Best Model on Testing data Because the random trees model had significantly better accuracy on the testset data, we will use it to predict our answers for the quiz.

Results
 [1] B A C A A E D B A A B C B A E E A B B B
Levels: A B C D E

Bibliography

Data comes from :

Velloso, E.; Bulling, A.; Gellersen, H.; Ugulino, W.; Fuks, H. Qualitative Activity Recognition of Weight Lifting Exercises. Proceedings of 4th International Conference in Cooperation with SIGCHI (Augmented Human ’13) . Stuttgart, Germany: ACM SIGCHI, 2013.

LS0tDQp0aXRsZTogIlByYWN0aWNhbCBNYWNoaW5lIExlYXJuaW5nIEZpbmFsIFByb2plY3QiDQphdXRob3I6ICJNYXJpYWggQmlyZ2VuIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0KcmVxdWlyZShkcGx5cik7IHJlcXVpcmUoZ2dwbG90Mik7IHJlcXVpcmUoY2FyZXQpOyByZXF1aXJlKGtuaXRyKQ0KcmVxdWlyZShSQU5OKQ0KYGBgDQojIEV4ZWN1dGl2ZSBTdW1tYXJ5DQpBZnRlciBkb3dubG9hZGluZyBhbmQgY2xlYW5pbmcgdGhlIGRhdGEgdG8gc2VsZWN0IG9ubHkgYWNjZWxlcmF0aW9uIHByZWRpY3RvcnMsIHR3byBkaWZmZXJlbnQgbW9kZWxzLCByYW5kb20gdHJlZXMgYW5kIGdlbmVyYWxpemVkIGJvb3N0ZWQgcmVncmVzc2lvbiwgd2VyZSBydW4gb24gNjAlIG9mIHRoZSB0cmFpbmluZyBzZXQuIFRoZSBtb2RlbHMgd2VyZSB0aGVuIHJ1biBvbiB0aGUgcmVtYWluaW5nIG9mIHRoZSA0MCUgdGVzdGluZyBzZXQgdG8gdGVzdCBmb3IgYWNjdXJhY3kuIFRoZSBtb2RlbCB3aXRoIHRoZSBiZXN0IHBlcmZvcm1hbmNlLCByYW5kb20gdHJlZXMsIHdhcyB0aGVuIGNob3NlbiB0byBydW4gb24gdGhlIGdpdmVuIHRlc3Rpbmcgc2V0LiBUaGUgcmVzdWx0cyBhcmUgZ2l2ZW4gYmVsb3cuDQoNCiMgSW50cm9kdWN0aW9uDQpTaXggcGFydGljaXBhbnRzIHdlcmUgYXNrZWQgdG8gcGVyZm9ybSBiYXJiZWxsIGxpZnRzIGNvcnJlY3RseSBhbmQgaW5jb3JyZWN0bHkgaW4gNSBkaWZmZXJlbnQgd2F5cy4gVGhlIGdvYWwgb2YgdGhlIHByb2plY3QgaXMgdG8gdXNlIGRhdGEgZnJvbSBhY2NlbGVyb21ldGVycyBvbiB0aGUgYmVsdCwgZm9yZWFybSwgYXJtLCBhbmQgZHVtYmVsbCB0byBwcmVkaWN0IHdoZXRoZXIgb3Igbm90IHRoZSBiYXJiZWxsIGxpZnQgd2FzIHBlcmZvbWVkIGNvcnJlY3RseS4gVGhlIHJlcG9ydCBkZXNjcmliZXMgdGhlIGJ1aWxkaW5nIG9mIHRoZSBtb2RlbCBpbmNsdWRpbmcgZGVhbGluZyB3aXRoIG1pc3NpbmcgZGF0YSBhbmQgZGVjaWRpbmcgd2hpY2ggbW9kZWwgbWV0aG9kIHRvIHVzZS4NCg0KIyBEYXRhIFByZXBhcmF0aW9uDQpEYXRhIGlzIGRvd25sb2FkZWQgZnJvbSB0aGUgZ2l2ZW4gdXJscy4NCmBgYHtyIGRvd25sb2FkcywgZWNobz1GQUxTRSwgY2FjaGU9VFJVRX0NCnVybDEgPC0gImh0dHA6Ly9kMzk2cXVzemE0MG9yYy5jbG91ZGZyb250Lm5ldC9wcmVkbWFjaGxlYXJuL3BtbC10cmFpbmluZy5jc3YiDQp1cmwyIDwtICJodHRwOi8vZDM5NnF1c3phNDBvcmMuY2xvdWRmcm9udC5uZXQvcHJlZG1hY2hsZWFybi9wbWwtdGVzdGluZy5jc3YiDQpkb3dubG9hZC5maWxlKHVybDEsICJ0cmFpbmluZ2RhdGEuY3N2IikNCmRvd25sb2FkLmZpbGUodXJsMiwgInRlc3RpbmdkYXRhLmNzdiIpDQpgYGANClRoZW4sIGRhdGEgaXMgc2F2ZWQgaW50byByIGZvciBwcm9jZXNzaW5nLg0KYGBge3Igc2F2ZSBmaWxlc30NCnRyYWluaW5nIDwtIHJlYWQuY3N2KCJ0cmFpbmluZ2RhdGEuY3N2Iiwgc3RyaW5nc0FzRmFjdG9ycyA9IEZBTFNFKQ0KdGVzdGluZyA8LSByZWFkLmNzdigidGVzdGluZ2RhdGEuY3N2Iiwgc3RyaW5nc0FzRmFjdG9ycyA9IEZBTFNFKQ0KYGBgDQoNCiMgRGF0YSBDbGVhbmluZw0KVGhlIGRhdGFzZXQgaXMgdmVyeSBsYXJnZSwgc28gd2UgYXJlIGFibGUgdG8gYnJlYWsgdGhlIGRhdGEgaW50byB0d28gcGllY2VzLCBvbmUgdG8gdHJhaW4gdGhlIG1vZGVscyBhbmQgdGhlIG90aGVyIHRvIHRlc3QgdGhlIG1vZGVscyBmb3IgYWNjdXJhY3kuDQpgYGB7cn0NCnNldC5zZWVkKDIzODQ2KQ0KaW5UcmFpbiA8LSBjcmVhdGVEYXRhUGFydGl0aW9uKHkgPSB0cmFpbmluZyRjbGFzc2UsIHA9MC42LCBsaXN0ID0gRkFMU0UgKQ0KdHJhaW5zZXQgPC0gdHJhaW5pbmdbaW5UcmFpbixdDQp0ZXN0c2V0IDwtIHRyYWluaW5nWy1pblRyYWluLF0NCmBgYA0KU2VsZWN0IG9ubHkgcHJlZGljdG9ycyB0aGF0IGluZGljYXRlIGFjY2VsZXJhdGlvbi4gQWZ0ZXIgd29ya2luZyB3aXRoIHRoZSBmaXJzdCBzZWxlY3Rpb24sIGl0IGJlY29tZXMgY2xlYXIgdGhhdCBwcmVkaWN0b3JzIHRoYXQgbWVhc3VyZSB0aGUgdmFyaWFuY2Ugb2YgdGhlIGFjY2VsZXJhdGlvbiBuZWVkIHRvIGJlIGV4Y2x1ZGVkLg0KYGBge3J9DQp0cmFpbnkgPC0gdHJhaW5zZXRbLDE2MF0NCnRyYWludXNlcjwtIHRyYWluc2V0WywyXQ0KdHJhaW5zZXQgPC0gdHJhaW5zZXRbLCBncmVwbCgiYWNjZWwiLCBuYW1lcyAodHJhaW5zZXQpKV0NCnRyYWluc2V0IDwtIHRyYWluc2V0WywgIWdyZXBsKCJ2YXIiLCBuYW1lcyh0cmFpbnNldCkpXQ0KdHJhaW5zZXQgPC0gY2JpbmQoY2xhc3NlPXRyYWlueSwgdHJhaW5zZXQpDQpkaW0odHJhaW5zZXQpDQpgYGANClRoaXMgbGVhdmVzIHVzIHdpdGggMTYgcHJlZGljdG9ycy4NCmBgYHtyfQ0KbmFtZXModHJhaW5zZXQpDQpgYGANCg0KIyMgUmVtb3ZlIHByZWRpY3RvcnMgd2l0aCBtaW5pbWFsIHZhcmlhbmNlIG9yIG1pc3NpbmcgdmFsdWVzDQpSZW1vdmUgcHJlZGljdG9ycyB3aXRoIG1pbmltYWwgdmFyaWFuY2UgKHRoaXMgdHVybnMgb3V0IHRvIGhhdmUgbGl0dGxlIGVmZmVjdCkuDQpgYGB7ciBuZWFyemVyb30NCm5zdiA8LSBuZWFyWmVyb1Zhcih0cmFpbnNldCwgc2F2ZU1ldHJpY3MgPSBUUlVFKQ0KdHJhaW5zZXQgPC0gdHJhaW5zZXRbLCBuc3Ykbnp2PT1GQUxTRV0NCmRpbSh0cmFpbnNldCkNCmBgYA0KDQpSZW1vdmUgcHJlZGljdG9ycyB3aXRoIG1pc3NpbmcgdmFsdWVzICh0aGlzIHR1cm5zIG91dCB0byBoYXZlIGxpdHRsZSBlZmZlY3QpLg0KYGBge3J9DQp0cmFpbnNldDwtIHRyYWluc2V0WywgY29sU3Vtcyhpcy5uYSh0cmFpbnNldCkpID09IDBdDQpkaW0odHJhaW5zZXQpDQpgYGANCg0KDQojIE1vZGVsIEJ1aWxkaW5nDQojIyBSYW5kb20gRm9yZXN0DQojIyMgVHJhaW5pbmcNCmBgYHtyIGJ1aWxkIHJhbmRvbSBmb3Jlc3QsIGNhY2hlPVRSVUV9DQpjb250cm9sUkYgPC0gdHJhaW5Db250cm9sKG1ldGhvZD0iY3YiLCBudW1iZXI9MywgdmVyYm9zZUl0ZXI9RkFMU0UpDQptb2RlbDEgPC0gdHJhaW4oY2xhc3Nlfi4sIGRhdGEgPSB0cmFpbnNldCwgbWV0aG9kID0gInJmIiwgdHJDb250cm9sPWNvbnRyb2xSRikNCm1vZGVsMSRmaW5hbE1vZGVsDQpgYGANCiMjIyBWYWxpZGF0aW9uDQpXZSB0aGVuIHZhbGlkYXRlIHRoZSBtb2RlbCBvYnRhaW5lZCBtb2RlbCAkbW9kZWwxJCBvbiB0aGUgdGVzdCBkYXRhIHRvIGZpbmQgb3V0IGhvdyB3ZWxsIGl0IHBlcmZvcm1zIGJ5IGxvb2tpbmcgYXQgdGhlIEFjY3VyYWN5IHZhcmlhYmxlLg0KYGBge3J9DQpwcmVkcmYgPC0gcHJlZGljdChtb2RlbDEsIG5ld2RhdGEgPSB0ZXN0c2V0KQ0KY21yZiA8LSBjb25mdXNpb25NYXRyaXgocHJlZHJmLCBmYWN0b3IodGVzdHNldCRjbGFzc2UpKQ0KY21yZiRvdmVyYWxsDQpgYGANCldlIHNlZSB0aGUgYWNjdXJhY3kgb2YgdGhlICJydCIgbW9kZWwgaXMgOTQlLg0KIyMgR2VuZXJhbGl6ZWQgQm9vc3RlZCBSZWdyZXNzaW9uDQojIyMgVHJhaW5pbmcNCmBgYHtyIGJ1aWxkIGdiciwgY2FjaGUgPSBUUlVFfQ0Kc2V0LnNlZWQoMjM4NDYpDQpjb250cm9sR0JNIDwtIHRyYWluQ29udHJvbChtZXRob2QgPSAicmVwZWF0ZWRjdiIsIG51bWJlciA9IDUsIHJlcGVhdHMgPSAxKQ0KbW9kZWwyIDwtIHRyYWluKGNsYXNzZSB+IC4sIGRhdGE9dHJhaW5zZXQsIG1ldGhvZCA9ICJnYm0iLCB0ckNvbnRyb2wgPSBjb250cm9sR0JNLCB2ZXJib3NlID0gRkFMU0UpDQptb2RlbDIkZmluYWxNb2RlbA0KYGBgDQpgYGB7cn0NCiMgcHJpbnQgbW9kZWwgc3VtbWFyeQ0KcHJpbnQobW9kZWwyKQ0KYGBgDQoNCiMjIyBWYWxpZGF0aW9uDQpXZSB0aGVuIHZhbGlkYXRlIHRoZSBtb2RlbCBvYnRhaW5lZCBtb2RlbCAkbW9kZWwxJCBvbiB0aGUgdGVzdCBkYXRhIHRvIGZpbmQgb3V0IGhvdyB3ZWxsIGl0IHBlcmZvcm1zIGJ5IGxvb2tpbmcgYXQgdGhlIEFjY3VyYWN5IHZhcmlhYmxlLg0KYGBge3J9DQpwcmVkZ2JtIDwtIHByZWRpY3QobW9kZWwyLCBuZXdkYXRhID0gdGVzdHNldCkNCnRhYmxlKHByZWRnYm0sIHRlc3RzZXQkY2xhc3NlKQ0KY21nYm0gPC0gY29uZnVzaW9uTWF0cml4KHByZWRnYm0sIGZhY3Rvcih0ZXN0c2V0JGNsYXNzZSkpDQpjbWdibSRvdmVyYWxsDQpgYGANCldlIHNlZSB0aGF0IHRoZSBhY2N1cmFjeSBvZiB0aGUgImdibSIgbW9kZWwgb24gdGhlIHRlc3RzZXQgaXMgODIlLg0KIyBSdW5uaW5nIEJlc3QgTW9kZWwgb24gVGVzdGluZyBkYXRhDQpCZWNhdXNlIHRoZSByYW5kb20gdHJlZXMgbW9kZWwgaGFkIHNpZ25pZmljYW50bHkgYmV0dGVyIGFjY3VyYWN5IG9uIHRoZSB0ZXN0c2V0IGRhdGEsIHdlIHdpbGwgdXNlIGl0IHRvIHByZWRpY3Qgb3VyIGFuc3dlcnMgZm9yIHRoZSBxdWl6Lg0KYGBge3J9DQpSZXN1bHRzIDwtIHByZWRpY3QobW9kZWwxLCBuZXdkYXRhID0gdGVzdGluZykNClJlc3VsdHMNCmBgYA0KDQojIEJpYmxpb2dyYXBoeQ0KRGF0YSBjb21lcyBmcm9tIDoNCg0KVmVsbG9zbywgRS47IEJ1bGxpbmcsIEEuOyBHZWxsZXJzZW4sIEguOyBVZ3VsaW5vLCBXLjsgRnVrcywgSC4gUXVhbGl0YXRpdmUgQWN0aXZpdHkgUmVjb2duaXRpb24gb2YgV2VpZ2h0IExpZnRpbmcgRXhlcmNpc2VzLiBQcm9jZWVkaW5ncyBvZiA0dGggSW50ZXJuYXRpb25hbCBDb25mZXJlbmNlIGluIENvb3BlcmF0aW9uIHdpdGggU0lHQ0hJIChBdWdtZW50ZWQgSHVtYW4gJzEzKSAuIFN0dXR0Z2FydCwgR2VybWFueTogQUNNIFNJR0NISSwgMjAxMy4=