WriteUp Project

Practical Machine Learning

Executive Summary

Submission for the predicted answers

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 B A B A A E D B A A B C B A E E A B B B Levels: A B C D E

Background

Using devices such as Jawbone Up, Nike FuelBand, and Fitbit it is now possible to collect a large amount of data about personal activity relatively inexpensively. These type of devices are part of the quantified self movement - a group of enthusiasts who take measurements about themselves regularly to improve their health, to find patterns in their behavior, or because they are tech geeks. One thing that people regularly do is quantify how much of a particular activity they do, but they rarely quantify how well they do it. In this project, your goal will be to use data from accelerometers on the belt, forearm, arm, and dumbell of 6 participants. They were asked to perform barbell lifts correctly and incorrectly in 5 different ways. More information is available from the website here: http://groupware.les.inf.puc-rio.br/har (see the section on the Weight Lifting Exercise Dataset).

Data Processing

The training data for this project are available here: https://d396qusza40orc.cloudfront.net/predmachlearn/pml-training.csv The test data are available here: https://d396qusza40orc.cloudfront.net/predmachlearn/pml-testing.csv

setInternet2(TRUE)
download.file(url = "https://d396qusza40orc.cloudfront.net/predmachlearn/pml-training.csv", destfile = "pml-training.csv")
download.file(url = "https://d396qusza40orc.cloudfront.net/predmachlearn/pml-testing.csv", destfile = "pml-testing.csv")
pmltrain <- read.csv("pml-training.csv")
pmltest <- read.csv("pml-testing.csv")

Exploratory Data Analysis

Create training, test and validation sets

library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
library(RANN)
library(randomForest)
## randomForest 4.6-10
## Type rfNews() to see new features/changes/bug fixes.
library(rpart)
library(rpart.plot)
trainidx <- createDataPartition(pmltrain$classe,p=.9,list=FALSE)
traindata = pmltrain[trainidx,]
testdata = pmltrain[-trainidx,]
set.seed(32768)
nzv <- nearZeroVar(traindata)
trainnzv <- traindata[-nzv]
testnzv <- testdata[-nzv]
pmltestnzv <- pmltest[-nzv]

dim(trainnzv)
## [1] 17662   102
dim(testnzv)
## [1] 1960  102
dim(pmltestnzv)
## [1]  20 102
ftridx <- which(lapply(trainnzv,class) %in% c('numeric'))
trainnzv1 <- preProcess(trainnzv[,ftridx], method=c('knnImpute'))
ftridx
##  [1]   7   8   9  11  13  15  17  18  19  20  21  22  23  24  25  26  27
## [18]  28  29  36  37  38  40  41  42  43  50  52  53  56  57  58  59  60
## [35]  61  62  63  64  66  67  68  69  70  71  72  73  74  75  76  77  78
## [52]  84  85  86  87  88  89  90  92  93  94  95 100 101
trainnzv1
## 
## Call:
## preProcess.default(x = trainnzv[, ftridx], method = c("knnImpute"))
## 
## Created from 368 samples and 64 variables
## Pre-processing: 5 nearest neighbor imputation, scaled, centered
pred1 <- predict(trainnzv1, trainnzv[,ftridx])
predtrain <- cbind(trainnzv$classe,pred1)
names(predtrain)[1] <- 'classe'
predtrain[is.na(predtrain)] <- 0

pred2 <- predict(trainnzv1, testnzv[,ftridx])
predtest <- cbind(testnzv$classe, pred2)
names(predtest)[1] <- 'classe'
predtest[is.na(predtest)] <- 0

predpmltest <- predict(trainnzv1,pmltestnzv[,ftridx] )


dim(predtrain)
## [1] 17662    65
dim(predtest)
## [1] 1960   65
dim(predpmltest)
## [1] 20 64

Modeling

model <- randomForest(classe~.,data=predtrain)

predtrain1 <- predict(model, predtrain) 
print(table(predtrain1, predtrain$classe))
##           
## predtrain1    A    B    C    D    E
##          A 5022    0    0    0    0
##          B    0 3418    0    0    0
##          C    0    0 3080    0    0
##          D    0    0    0 2895    0
##          E    0    0    0    0 3247
training <- as.data.frame(table(predtrain1, predtrain$classe))
#qplot(training)

predtest1 <- predict(model, predtest) 
print(table(predtest1, predtest$classe))
##          
## predtest1   A   B   C   D   E
##         A 556   1   0   0   0
##         B   2 378   5   0   0
##         C   0   0 335   3   0
##         D   0   0   2 318   2
##         E   0   0   0   0 358
str(predpmltest)
## 'data.frame':    20 obs. of  64 variables:
##  $ roll_belt               : num  0.932 -1.012 -1.015 0.964 -1.007 ...
##  $ pitch_belt              : num  1.1932 0.205 0.0689 -1.8699 0.1363 ...
##  $ yaw_belt                : num  0.0648 -0.818 -0.8138 1.8141 -0.8149 ...
##  $ max_roll_belt           : num  0.0211 -0.8734 -0.8723 1.7935 -0.8896 ...
##  $ min_roll_belt           : num  0.0482 -0.8428 -0.8422 1.8326 -0.8602 ...
##  $ amplitude_roll_belt     : num  -0.0944 -0.1392 -0.1377 -0.0759 -0.1354 ...
##  $ var_total_accel_belt    : num  -0.321 -0.338 -0.347 -0.382 -0.38 ...
##  $ avg_roll_belt           : num  0.848 -1.085 -1.09 0.886 -1.076 ...
##  $ stddev_roll_belt        : num  -0.413 -0.477 -0.437 -0.421 -0.445 ...
##  $ var_roll_belt           : num  -0.329 -0.333 -0.332 -0.327 -0.332 ...
##  $ avg_pitch_belt          : num  1.113 0.199 0.192 -1.855 0.171 ...
##  $ stddev_pitch_belt       : num  -0.5452 -0.0739 -0.1996 -0.4195 -0.1493 ...
##  $ var_pitch_belt          : num  -0.401 -0.226 -0.284 -0.342 -0.259 ...
##  $ avg_yaw_belt            : num  0.0385 -0.8616 -0.8602 1.8249 -0.8777 ...
##  $ stddev_yaw_belt         : num  -0.0902 -0.1235 -0.1216 -0.0643 -0.1196 ...
##  $ var_yaw_belt            : num  -0.068 -0.0682 -0.0682 -0.0677 -0.0682 ...
##  $ gyros_belt_x            : num  -2.38 -0.263 0.266 0.555 0.17 ...
##  $ gyros_belt_y            : num  -0.766 -0.766 -0.255 0.895 -0.255 ...
##  $ gyros_belt_z            : num  -1.358 0.248 0.66 -0.123 0.536 ...
##  $ roll_arm                : num  0.314 -0.246 -0.246 -1.744 0.801 ...
##  $ pitch_arm               : num  -0.757 0.15 0.15 1.944 0.24 ...
##  $ yaw_arm                 : num  2.50109 0.00913 0.00913 -1.97883 1.43711 ...
##  $ var_accel_arm           : num  0.6537 -0.9021 0.0811 -0.4641 0.2415 ...
##  $ gyros_arm_x             : num  -0.8488 -0.6079 1.0332 0.0897 -1.0043 ...
##  $ gyros_arm_y             : num  0.865 1.3 -1.298 -0.299 1.229 ...
##  $ gyros_arm_z             : num  -0.812 -1.263 1.55 1.171 -1.461 ...
##  $ max_picth_arm           : num  0.891 -0.544 -0.544 -1.318 0.839 ...
##  $ min_roll_arm            : num  -0.471 0.796 0.796 0.935 -0.665 ...
##  $ min_pitch_arm           : num  0.674 0.59 0.59 -1.333 0.497 ...
##  $ roll_dumbbell           : num  -0.591 0.44 0.478 0.278 -1.786 ...
##  $ pitch_dumbbell          : num  0.97 -1.155 -1.093 -0.516 -1.148 ...
##  $ yaw_dumbbell            : num  1.512 -0.935 -0.931 -1.272 -0.191 ...
##  $ max_roll_dumbbell       : num  0.695 -1.272 -1.107 -0.842 0.211 ...
##  $ max_picth_dumbbell      : num  1.15 -1.114 -0.993 -1.298 0.642 ...
##  $ min_roll_dumbbell       : num  1.499 -0.43 -0.593 0.1 0.616 ...
##  $ min_pitch_dumbbell      : num  1.844 -0.676 -0.684 -0.968 0.761 ...
##  $ amplitude_roll_dumbbell : num  -0.343 -0.832 -0.587 -0.795 -0.205 ...
##  $ amplitude_pitch_dumbbell: num  -0.433 -0.8329 -0.6503 -0.7677 0.0616 ...
##  $ var_accel_dumbbell      : num  -0.396 -0.443 -0.3 -0.461 -0.363 ...
##  $ avg_roll_dumbbell       : num  -0.4 0.494 0.593 0.4 -0.644 ...
##  $ stddev_roll_dumbbell    : num  -0.345 -0.738 -0.522 -0.639 -0.196 ...
##  $ var_roll_dumbbell       : num  -0.381 -0.447 -0.41 -0.437 -0.308 ...
##  $ avg_pitch_dumbbell      : num  1.284 -1.212 -1.149 -0.58 0.431 ...
##  $ stddev_pitch_dumbbell   : num  -0.374 -0.82 -0.641 -0.793 -0.138 ...
##  $ var_pitch_dumbbell      : num  -0.42 -0.511 -0.487 -0.511 -0.235 ...
##  $ avg_yaw_dumbbell        : num  1.588 -0.984 -0.928 -1.24 0.691 ...
##  $ stddev_yaw_dumbbell     : num  -0.4634 -0.7937 -0.6342 -0.7294 0.0308 ...
##  $ var_yaw_dumbbell        : num  -0.413 -0.465 -0.436 -0.459 -0.198 ...
##  $ gyros_dumbbell_x        : num  0.3029 0.1136 0.1451 -0.0379 0.082 ...
##  $ gyros_dumbbell_y        : num  0.02292 0.00681 0.15181 -0.10597 -0.83098 ...
##  $ gyros_dumbbell_z        : num  -0.2005 -0.242 -0.0883 0.0737 -0.1382 ...
##  $ magnet_dumbbell_z       : num  -0.7296 -0.5866 -0.036 0.0498 1.9019 ...
##  $ roll_forearm            : num  0.993 0.696 0.9 -0.314 -1.944 ...
##  $ pitch_forearm           : num  1.372 -1.001 -1.533 -0.377 -0.453 ...
##  $ yaw_forearm             : num  1.325 0.84 0.714 -0.187 -0.651 ...
##  $ max_picth_forearm       : num  0.647 0.551 0.538 -0.835 -0.113 ...
##  $ min_pitch_forearm       : num  0.823 1.353 0.896 0.545 -0.453 ...
##  $ amplitude_pitch_forearm : num  -0.19 -0.646 -0.315 -0.949 0.263 ...
##  $ var_accel_forearm       : num  -0.648 -0.685 -0.767 -0.684 0.11 ...
##  $ gyros_forearm_x         : num  0.8953 1.4815 0.0314 1.8826 -1.4032 ...
##  $ gyros_forearm_y         : num  -1.073 -0.898 -0.273 0.192 0.948 ...
##  $ gyros_forearm_z         : num  -0.4052 -0.182 0.0683 0.8955 0.3513 ...
##  $ magnet_forearm_y        : num  0.0753 0.8064 0.6236 0.7907 -2.2948 ...
##  $ magnet_forearm_z        : num  0.604 1.298 1.054 0.343 -0.824 ...
predanswers <- predict(model, predpmltest) 
predanswers
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 
##  B  A  B  A  A  E  D  B  A  A  B  C  B  A  E  E  A  B  B  B 
## Levels: A B C D E

Results

predanswers <- predict(model, predpmltest) 
predanswers
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 
##  B  A  B  A  A  E  D  B  A  A  B  C  B  A  E  E  A  B  B  B 
## Levels: A B C D E
pml_write_files = function(x){
  n = length(x)
  for(i in 1:n){
    filename = paste0("problem_id_",i,".txt")
    write.table(x[i],file=filename,quote=FALSE,row.names=FALSE,col.names=FALSE)
  }
}
pml_write_files(as.character(predanswers))