Исходный документ был написан 18 декабря 2020 г.

Резюме

В этом отчете анализируются собранные данные о различных пользователях, выполняющих упражнения со штангой с разным уровнем качества. Алгоритм машинного обучения был использован для создания модели для определения рейтинга пользователя на основе данных, собранных с нескольких акселерометров. Более подробную информацию о проекте можно найти здесь.

Анализ

Инициализация

Следующий код использовался для инициализации необходимых r-библиотек, а также для загрузки необходимых данных и сохранения их в памяти. Некоторые столбцы данных, которые не требовались для моделирования, были исключены (например, имена пользователей).

library(caret)
library(gbm) 
library(dplyr) 
library(randomForest) 
library(ggplot2) 
set.seed(90210) 
Ntree <- 200
 
download.file("https://d396qusza40orc.cloudfront.net/predmachlearn/pml-training.csv", "training.csv") 
download.file("https://d396qusza40orc.cloudfront.net/predmachlearn/pml-testing.csv", "testing.csv") 
train <- read.csv2("training.csv", sep = ",")[,-c(1:7)] 
test <- read.csv2("testing.csv", sep = ",")[,-c(1:7)]

Сокращение предикторов

Данные содержат слишком много предикторов (всего 153) для создания точных и простых моделей. Требуется некоторая обрезка. Первая обрезка выполняется с функцией почти нулевой дисперсии из библиотеки каретки, которая находит предикторы, демонстрирующие близкую к нулю вариацию. Эти предикторы мало что добавят для включения в модели.

nz <- nearZeroVar(train) 
train <- train[,-nz] 
test <- test[-nz]

С этого шага количество предикторов сокращается до 94. В данных остается множество значений NA. Эти значения рассматриваются в следующем фрагменте кода.

maxi <- length(train) - 1 
valna <- 1:maxi 
for (i in 1:maxi) { 
  train[,i] <- as.numeric(train[,i]) 
  test[,i] <- as.numeric(test[,i]) 
  valna[i] <- mean(is.na(train[,i])) } table(valna)
## valna 
## 0 0.979308938946081 
## 52 41

Код показывает, что есть 52 предиктора, у которых нет пропущенных данных, и 41 предиктор, у которых в основном отсутствуют значения. Эти предикторы мало что добавят к моделированию и удаляются с помощью следующего кода.

train <- train[, valna == 0] test <- test[, valna == 0]

Затем обучение было разделено для создания проверочного набора, который будет использоваться для перекрестной проверки. Обратите внимание, что алгоритм случайного леса имеет встроенную перекрестную проверку с ошибкой «из коробки». Около 1/3 данных используется в случайном лесу.

Valid <- createDataPartition(train$classe, p = 0.3)[[1]] 
valid <- train[Valid,] 
train <- train[-Valid,]

Следующим шагом является использование функции важности переменной в библиотеке каретки, чтобы еще больше уменьшить количество предикторов. Данные поезда по-прежнему очень велики, но, создав выборку из обучающих данных и смоделировав ее, мы можем получить разумное приближение важных переменных.

strain <- rbind(sample_n(train[train$classe == "A",],round(mean(train$classe == "A")*200,0)),
sample_n(train[train$classe == "B",],round(mean(train$classe == "B")*200,0)), 
sample_n(train[train$classe == "C",],round(mean(train$classe == "C")*200,0)), 
sample_n(train[train$classe == "D",],round(mean(train$classe == "D")*200,0)), 
sample_n(train[train$classe == "E",],round(mean(train$classe == "E")*200,0)) )

Набор выборок был установлен для обеспечения точного представления переменной classe в обучающих данных. Две модели были завершены, и их важные переменные были сложены вместе.

mdl1 <- train(classe~., data = strain, method = "rf", ntree = Ntree) mdl2 <- train(classe~., data = strain, method = "gbm", verbose = FALSE) 
var <- varImp(mdl1)$importance > 50 | varImp(mdl2)$importance > 50 varorder <- order(varImp(mdl1)$importance, decreasing = TRUE) 
Varimp <- row.names(varImp(mdl1)$importance)[varorder[1:2]]

Значение 50 использовалось в качестве порогового значения. Общее количество предикторов уменьшено до 4.

valid <- valid[,var] 
train <- train[,var] 
test <- test[,var]

Моделирование

С уменьшенными предикторами теперь можно обучать модели. Поскольку эти модели будут просматривать весь набор обучающих данных, это потребует много времени. Модели включают:
— Случайный лес
— Обобщенный усиленный
— Линейный дискриминант
— Комбинированный
Используется функция randomForest, поскольку она более эффективна, чем функция обучения. Метод данных также более эффективен, чем метод формул.

mdl11 <- randomForest(x = train[,1:(ncol(train) - 1)], y = as.factor(train[,ncol(train)]), ntree = Ntree, proximity = TRUE) mdl21 <- train(classe~., data = train, method = "gbm", verbose = FALSE) 
mdl31 <- train(classe~., data = train, method = "lda")

Следующий код создает комбинированную модель

pmdl11 <- predict(mdl11, valid) 
pmdl21 <- predict(mdl21, valid) 
pmdl31 <- predict(mdl31, valid) 
join <- data.frame(pmdl11, pmdl21, pmdl31, classe = valid$classe) jmdl <- randomForest(x = join[,1:3], y = as.factor(join$classe), ntree = Ntree)

Оценка модели

Новые модели необходимо будет проверить на соответствие набору проверочных данных. Нестандартная ошибка для моделей случайного леса не использовалась, поскольку данные проверки обеспечивают единообразное сравнение для всех моделей. Для тестирования моделей использовалась следующая функция:

Exacc <- function(mdl, test){
 mean(predict(mdl,test) == test$classe) 
}

Точность модели резюмируется в следующем кадре данных, когда они используются для прогнозирования результатов в наборе проверки:

## Model accuracy 
## 1 mdl11 0.8955680 
## 2 mdl21 0.7994566 
## 3 mdl31 0.3625403 
## 4 joint 0.8920020

Заключение

Из результатов тестирования модели видно, что случайный лес и их комбинация являются наиболее точными моделями для проверочного набора. Комбинированная модель имеет примерно тот же уровень точности, что и случайный лес, то есть это модель с наибольшим весом. Это также означает, что включение усиленной и линейной дискриминантных моделей не способствует его точности. Для упрощения модель случайного леса является лучшей моделью.

Сюжет

Центры модели могут быть найдены из данных близости. Данные близости сравниваются с двумя предикторами, наиболее важными предикторами. Два наиболее значимых предиктора иногда менялись, поэтому код был изменен, чтобы сделать его гибким.

index <- names(train) %in% Varimp 
mdlp <- classCenter(train[index], train$classe, mdl11$proximity) mdlp <- as.data.frame(mdlp) 
mdlp$classe <- rownames(mdlp)

Эти центральные данные могут быть включены в обучающие данные. Существуют совершенно разные области, основанные на разных значениях классов, но другие предикторы также вносят свой вклад в точность модели.

index <- names(train) %in% Varimp 
names <- names(train[index]) 
f <- function(name1, name2){ 
  xval <- sym(name1) 
  yval <- sym(name2) 
  
  ggplot(data = train, aes_string(x = xval, y = yval, col = "classe")) +
  geom_point() + 
  geom_point(aes_string(x = xval, y = yval, col = "classe"), size = 10, shape = 4, data = mdlp) + 
  labs(title = "Model centers on two variables of importance") 
} 
f(names[1], names[2])

Первоначально опубликовано на https://datasandbox.netlify.app 29 января 2022 г.