Executive Summary: Multiple devices have been designed to track how much exercise a person does, however, some exercises are only effective if does correctly, quality versus quantity. The Human Activity Recognition (HAR)study design demonstrated that by attaching accelerometers and gyroscopes on the bodies of the “training portion” participates that the quality could be measured. These data points and be used as a training data could determine the efficacy of the test subjects with anR^2 =0.99 for the test subjects’ barbell lifts.

Introduction: Exercise trackers have become exceedingly popular with sports enthusiasts in since their advent. However, the effectiveness of exercising is as much about quantity as it is quality. Weightlifting is a prime example of how proper technique can affect the quality of the exercise, therefore, strength and muscle mass change according to that technique.

Six young health participants were asked to perform one set of 10 repetitions of the Unilateral Dumbbell Biceps Curl in five different fashions: exactly according to the specification (Class A), throwing the elbows to the front (Class B), lifting the dumbbell only halfway (Class C), lowering the dumbbell only halfway (Class D) and throwing the hips to the front (Class E).

Read more: http:/groupware.les.inf.puc-rio.br/har#ixzz4Tjs3pdu3[4]

In the study sensor were attached to the barbell, forearm, wrist, arm, and hips. Change in position and acceleration were measured. Change in position from the x,y and z planes and were further categorized into yaw, pitch, and roll. Yaw is a Euler angle that moves counterclockwise from that angle alpha along the z coordinate or the vertical axis, this is twist or oscillation. Pitch is a Euler angle that moves counterclockwise from the angle beta along the x-coordinate or lateral axis this is considered up and down or nodding of a body. Roll is a Euler angle that moves counterclockwise from the angle gamma along the y-coordinate it rotates around its longitudinal axis[3],[4] The classification scheme (classe) was based on these three principles. And was the factor that determined the quality of the exercise. From the

Using the study design above, where the classe variable was set to factor and levels, then a training and quiz (this was 20% of the original training data) was partitioned . Out of the 160 variables only those whose names started with “roll_”, “pitch_”, and “yaw_” were selected because of their usefulness in determining positioning of a body.

trainingURL <-"https://d396qusza40orc.cloudfront.net/predmachlearn/pml-training.csv"
testingURL <-"https://d396qusza40orc.cloudfront.net/predmachlearn/pml-testing.csv"

weightLifting <-read.csv(trainingURL)
test.data <-read.csv(testingURL)
weightLiftingTraining<-weightLifting%>%
  select( 
    grep("^roll_", colnames(weightLifting)),
    grep("^pitch_", colnames(weightLifting)),
    grep("^yaw_", colnames(weightLifting)),
  
    classe
  )#%>%
 # select(roll_dumbbell, pitch_arm)

test.data<-test.data%>%
  select(
          grep("^roll_", colnames(weightLifting)),
           grep("^pitch_", colnames(weightLifting)),
           grep("^yaw_", colnames(weightLifting)),
     )

Then a principle component analysis was run on these variables. The outputs of the Scree plot and the Variables plot are in figures 1 and 2.

res.pca <-PCA(weightLiftingTraining[-13], scale.unit=TRUE, ncp=9, graph=FALSE)

fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 50))

The scree plot shows that the first two PC only account for ~40% of the total variation of the data.

f <-res.pca[[1]][[2]]

fviz_pca_var(res.pca, col.var = "cos2",
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
             repel = TRUE # Avoid text overlapping
)

There is also a lot of overlap in the data and separation may not be easy. The plot shows that a few variables(orange) are highly correlated with the outcome. This is demonstrated in their proximity to the circumference of the circle. But none of them are greater than 60% and having the first two principle components not able to “explain” the most of the variation in the data, principle component analysis is not a good match. Next we will transform and center the data and use the machine learning algorithm run was a linear discriminant analysis to determine whether good separation was possible.

############### too much overlap give for poorer accuracy


training.samples <- weightLiftingTraining$classe %>%
  createDataPartition(p = 0.75, list = FALSE)
train.data <- weightLiftingTraining[training.samples, ]
quiz.data <- weightLiftingTraining[-training.samples, ]


preproccessTraining<-
  train.data%>%
  preProcess(method=c("center", "scale"))

train.transformed <-preproccessTraining%>%
     predict(train.data)
quiz.transformed <-preproccessTraining%>%
     predict(quiz.data)




model <-lda(classe ~., data=train.transformed)
model
## Call:
## lda(classe ~ ., data = train.transformed)
## 
## Prior probabilities of groups:
##         A         B         C         D         E 
## 0.2843457 0.1935046 0.1744123 0.1638810 0.1838565 
## 
## Group means:
##       roll_belt    roll_arm roll_dumbbell roll_forearm   pitch_belt   pitch_arm
## A -0.0794022396 -0.24002033   -0.04204986  -0.06861149  0.008820654  0.26223501
## B  0.0117335954  0.18101692    0.18623566  -0.02480878 -0.016184437 -0.06207668
## C -0.0007556813  0.09748811   -0.54414950   0.23357353 -0.056842285  0.08791686
## D -0.0506900396  0.06207142    0.37542329  -0.15786209  0.071745096 -0.19032006
## E  0.1563508139  0.03288272    0.05058768   0.05135794 -0.006635694 -0.25398735
##   pitch_dumbbell pitch_forearm    yaw_belt     yaw_arm  yaw_dumbbell
## A    -0.21591903   -0.62205337 -0.01132071 -0.14097872 -0.0006617566
## B     0.37385080    0.14122149 -0.01604567  0.11135282  0.1500236911
## C    -0.38974183    0.06532916  0.03166396  0.06652998 -0.2160133184
## D     0.24016859    0.61771555 -0.06775442  0.07443350  0.0050304552
## E     0.09611038    0.20083691  0.06475148 -0.02862267  0.0435604987
##   yaw_forearm
## A  0.06746028
## B -0.05526656
## C  0.16829392
## D -0.14207829
## E -0.07917211
## 
## Coefficients of linear discriminants:
##                          LD1         LD2         LD3          LD4
## roll_belt       0.8747526501  0.49502003 -2.27795196  1.002845039
## roll_arm        0.2606281937  0.15289358 -0.40875966 -0.037740718
## roll_dumbbell   0.3905761169 -0.88113013  0.15127740  0.391856789
## roll_forearm    0.0444572166  0.33985444 -0.31667580  0.029770108
## pitch_belt     -0.5658729359 -0.62607452  1.75203072  0.007180921
## pitch_arm      -0.3089156658 -0.06374105  0.21084927 -0.606574931
## pitch_dumbbell  0.1476171995 -0.13295368 -0.41867848 -0.720392023
## pitch_forearm   0.9162359670  0.32823089  0.59179087 -0.100484857
## yaw_belt       -1.0648561480 -0.69945968  2.65723172 -0.702286315
## yaw_arm         0.1176702924 -0.02768820  0.02776879 -0.291272633
## yaw_dumbbell   -0.3195203397 -0.44474402 -0.20591626  0.093622438
## yaw_forearm    -0.0002449466  0.13453663  0.12040941 -0.021718098
## 
## Proportion of trace:
##    LD1    LD2    LD3    LD4 
## 0.6468 0.2483 0.0784 0.0265
# Make predictions
predictions <- model %>% predict(quiz.transformed)
# Model accuracy
mean(predictions$class==quiz.transformed$class)
## [1] 0.4359706

Unfortunately, this model was only accurate 43% of the time.

library(nnet)

model <-lda(classe ~., data=train.transformed)
model
## Call:
## lda(classe ~ ., data = train.transformed)
## 
## Prior probabilities of groups:
##         A         B         C         D         E 
## 0.2843457 0.1935046 0.1744123 0.1638810 0.1838565 
## 
## Group means:
##       roll_belt    roll_arm roll_dumbbell roll_forearm   pitch_belt   pitch_arm
## A -0.0794022396 -0.24002033   -0.04204986  -0.06861149  0.008820654  0.26223501
## B  0.0117335954  0.18101692    0.18623566  -0.02480878 -0.016184437 -0.06207668
## C -0.0007556813  0.09748811   -0.54414950   0.23357353 -0.056842285  0.08791686
## D -0.0506900396  0.06207142    0.37542329  -0.15786209  0.071745096 -0.19032006
## E  0.1563508139  0.03288272    0.05058768   0.05135794 -0.006635694 -0.25398735
##   pitch_dumbbell pitch_forearm    yaw_belt     yaw_arm  yaw_dumbbell
## A    -0.21591903   -0.62205337 -0.01132071 -0.14097872 -0.0006617566
## B     0.37385080    0.14122149 -0.01604567  0.11135282  0.1500236911
## C    -0.38974183    0.06532916  0.03166396  0.06652998 -0.2160133184
## D     0.24016859    0.61771555 -0.06775442  0.07443350  0.0050304552
## E     0.09611038    0.20083691  0.06475148 -0.02862267  0.0435604987
##   yaw_forearm
## A  0.06746028
## B -0.05526656
## C  0.16829392
## D -0.14207829
## E -0.07917211
## 
## Coefficients of linear discriminants:
##                          LD1         LD2         LD3          LD4
## roll_belt       0.8747526501  0.49502003 -2.27795196  1.002845039
## roll_arm        0.2606281937  0.15289358 -0.40875966 -0.037740718
## roll_dumbbell   0.3905761169 -0.88113013  0.15127740  0.391856789
## roll_forearm    0.0444572166  0.33985444 -0.31667580  0.029770108
## pitch_belt     -0.5658729359 -0.62607452  1.75203072  0.007180921
## pitch_arm      -0.3089156658 -0.06374105  0.21084927 -0.606574931
## pitch_dumbbell  0.1476171995 -0.13295368 -0.41867848 -0.720392023
## pitch_forearm   0.9162359670  0.32823089  0.59179087 -0.100484857
## yaw_belt       -1.0648561480 -0.69945968  2.65723172 -0.702286315
## yaw_arm         0.1176702924 -0.02768820  0.02776879 -0.291272633
## yaw_dumbbell   -0.3195203397 -0.44474402 -0.20591626  0.093622438
## yaw_forearm    -0.0002449466  0.13453663  0.12040941 -0.021718098
## 
## Proportion of trace:
##    LD1    LD2    LD3    LD4 
## 0.6468 0.2483 0.0784 0.0265
# Make predictions
predictions <- model %>% predict(quiz.transformed)
# Model accuracy
mean(predictions$class==quiz.transformed$class)
## [1] 0.4359706
# Fit the model
model <- nnet::multinom(classe ~., data = train.data)
## # weights:  70 (52 variable)
## initial  value 23687.707195 
## iter  10 value 21627.762649
## iter  20 value 21168.953744
## iter  30 value 21144.022928
## iter  40 value 21137.810475
## iter  50 value 20874.362269
## iter  60 value 19642.312566
## final  value 19641.765103 
## converged
# Summarize the model
summary(model)
## Call:
## nnet::multinom(formula = classe ~ ., data = train.data)
## 
## Coefficients:
##   (Intercept)  roll_belt    roll_arm roll_dumbbell roll_forearm  pitch_belt
## B   -6.711540 0.08148095 0.007097298   0.005284769 0.0017729582 -0.17889173
## C   -5.800890 0.06501621 0.005647506  -0.006671127 0.0043164361 -0.15067738
## D   -4.370509 0.03705138 0.004760331   0.009667933 0.0003579189 -0.07312992
## E   -7.384292 0.08738606 0.007455114   0.004342343 0.0026052795 -0.17980834
##      pitch_arm pitch_dumbbell pitch_forearm    yaw_belt      yaw_arm
## B -0.008622027    0.008990522    0.02990670 -0.07215070 0.0021678379
## C -0.007162761   -0.003649510    0.03262135 -0.05732514 0.0012699302
## D -0.014468286    0.004198541    0.06155943 -0.03073508 0.0030378287
## E -0.017726004    0.002138376    0.03557445 -0.07513471 0.0004903393
##   yaw_dumbbell  yaw_forearm
## B -0.004175410 0.0007005414
## C -0.008078980 0.0029825044
## D -0.007940584 0.0016307675
## E -0.006056056 0.0010613624
## 
## Std. Errors:
##   (Intercept)   roll_belt     roll_arm roll_dumbbell roll_forearm  pitch_belt
## B   0.2542142 0.003406956 0.0005107786  0.0005302212 0.0002662280 0.007781151
## C   0.2864256 0.003839541 0.0005171265  0.0005091368 0.0003101539 0.008749720
## D   0.2980422 0.004005787 0.0005572045  0.0006105974 0.0002952270 0.009264312
## E   0.2563582 0.003414259 0.0005116868  0.0005322990 0.0002860474 0.007767968
##      pitch_arm pitch_dumbbell pitch_forearm    yaw_belt      yaw_arm
## B 0.0009056533    0.001028012   0.001388021 0.003035609 0.0004224993
## C 0.0009505520    0.001194884   0.001409176 0.003418090 0.0004446481
## D 0.0009974346    0.001171528   0.001637089 0.003590292 0.0004775956
## E 0.0009494990    0.001084892   0.001442619 0.003035228 0.0004418416
##   yaw_dumbbell  yaw_forearm
## B 0.0005628007 0.0003239622
## C 0.0006416248 0.0003524734
## D 0.0006305047 0.0003491792
## E 0.0005834274 0.0003318931
## 
## Residual Deviance: 39283.53 
## AIC: 39387.53
# Make predictions
predicted.classes.nnet <- model %>% predict(quiz.data)
head(predicted.classes.nnet)
## [1] A A A A A A
## Levels: A B C D E
# Model accuracy
mean(predicted.classes.nnet == quiz.data$classe)
## [1] 0.4643148

Next, an multideminsional analysis and multinomial neural net were run. While the MDA model was better the forward feeding multinomial nnet was not.

Because standard methods were not improving the outcome more thought had to be put into the modeling. If more variables were added this could be problematic with overfitting the training model. As we can see from the blue arrows in the variable plot in Figure 1 there are quite a few weak predictors. In order to leverage these as better variables we can use a boosting method. The one used ere is (xbgBoost); then, it applied to the training model.

library(randomForest)
modelxb <- train(classe ~., data = train.data, method = "xgbTree",
               trControl = trainControl("CV", number = 10))
# Make predictions
predicted.classes.xb <- modelxb %>% predict(quiz.data)

predicted <-predict(modelxb, quiz.data)
# Model n accuracy
mean(predicted.classes.xb==quiz.data$classe)
## [1] 0.9800163

Here we see a drastic improvement in the training model ability to predict the test set.

levels(quiz.data$classe) <-c("A","B","C","D","E")



actual <-as.factor(quiz.data$classe)
levels(predicted.classes.xb) <-c("A","B","C","D","E")
predicted<-predicted.classes.xb
confusionMatrix( actual,predicted, positive="1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    A    B    C    D    E
##          A 1379    5    6    2    3
##          B    4  924   19    0    2
##          C    0   11  833   11    0
##          D    0    0   16  780    8
##          E    0    3    5    3  890
## 
## Overall Statistics
##                                           
##                Accuracy : 0.98            
##                  95% CI : (0.9757, 0.9837)
##     No Information Rate : 0.282           
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9747          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: A Class: B Class: C Class: D Class: E
## Sensitivity            0.9971   0.9799   0.9477   0.9799   0.9856
## Specificity            0.9955   0.9937   0.9945   0.9942   0.9973
## Pos Pred Value         0.9885   0.9737   0.9743   0.9701   0.9878
## Neg Pred Value         0.9989   0.9952   0.9886   0.9961   0.9968
## Prevalence             0.2820   0.1923   0.1792   0.1623   0.1841
## Detection Rate         0.2812   0.1884   0.1699   0.1591   0.1815
## Detection Prevalence   0.2845   0.1935   0.1743   0.1639   0.1837
## Balanced Accuracy      0.9963   0.9868   0.9711   0.9870   0.9914
library(ggplot2)     
library(grid)
library(gridExtra)           
library(likert)

cm <- confusionMatrix(actual,predicted) #create a confusion matrix
cm_d <- as.data.frame(cm$table) # extract the confusion matrix values as data.frame
cm_st <-data.frame(cm$overall) # confusion matrix statistics as data.frame
cm_st$cm.overall <- round(cm_st$cm.overall,2) # round the values
cm_d$diag <- cm_d$Prediction == cm_d$Reference # Get the Diagonal
cm_d$ndiag <- cm_d$Prediction != cm_d$Reference # Off Diagonal     
cm_d[cm_d == 0] <- NA # Replace 0 with NA for white tiles
cm_d$Reference <-  reverse.levels(cm_d$Reference) # diagonal starts at top left
cm_d$ref_freq <- cm_d$Freq * ifelse(is.na(cm_d$diag),-1,1)


plt1 <-  ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+
  scale_x_discrete(position = "top") +
  geom_tile( data = cm_d,aes(fill = ref_freq)) +
  scale_fill_gradient2(guide = FALSE ,low="#CCFFFF",high="#1E90FF",
                       midpoint = 0,na.value = '#F8F8FF') +
  geom_text(aes(label = Freq), color = 'black', size = 3)+
  theme_bw() +
  theme(
        legend.position = "none",
        panel.border = element_blank(),
        plot.background = element_blank(),
        axis.line = element_blank(),
  )
plt2 <-  tableGrob(cm_st)


grid.arrange(plt1, plt2, nrow = 1, ncol = 2, 
             top=textGrob("Confusion Matrix",gp=gpar(fontsize=25,font=1)))

In conclusion, Using the correct Machine learning algorithm for loosely correlated variables, “pumps” them up. HAR devices can determine with a great deal of accuracy the effectiveness of barbell fits.

References

[1] Carvey D. and Nelson, K, (1987), Hans and Franz, Saturday Night Live, NBC. [2] LaValle, S.(March, 2012) Determining yaw, pitch, and roll from a rotation matrix, http://planning.cs.uiuc.edu/node103.html [3]Euler Angles.Wikipedia https://en.wikipedia.org/wiki/Euler_angles

[4] http://web.archive.org/web/20161224072740/http:/groupware.les.inf.puc-rio.br/har)