Введение
В этой статье я буду использовать фреймворк Tidymodels в R для построения модели классификации на титаническом наборе данных.
Инфраструктура Tidymodels позволяет использовать разработку функций, проверку модели, выбор модели и многое другое в элегантном, простом и эффективном стиле Tidyverse.
Исследование данных
В этой статье я буду использовать титанический набор данных с этого конкурса Kaggle. Обзор данных показан ниже.

Наша цель будет состоять в том, чтобы предсказать выживание пассажиров на основе других функций в наборе данных. Давайте начнем с загрузки пакетов, которые мы будем использовать, считывания данных и просмотра общего обзора.
library(tidyverse)
library(tidymodels)
library(janitor)
library(skimr)
titanic_data <-
read_csv("train.csv") |>
clean_names()
test_data <-
read_csv("test.csv") |>
mutate(
survived = NA
) |>
clean_names()
skim(titanic_data)

Мы можем сделать следующие наблюдения:
- имя содержит 891 уникальную запись, что эквивалентно количеству строк в наборе данных, поэтому мы исключим его из нашего анализа.
- sex — это символ, поэтому мы закодируем эту переменную в горячем режиме.
- ticket, как и name, имеет большое количество уникальных значений, поэтому мы также исключим это.
- cabin имеет большое количество пропущенных значений, поэтому мы создадим для него индикаторный столбец NA. Кроме того, кабина имеет формат B55, E17, C92 и т. д., поэтому мы сохраним только первую букву.
- начало будет закодировано горячим способом.
- passenger_id, как и name, уникален, поэтому мы его исключим.
- pclass пока кажется хорошим.
- В возрасте отсутствуют значения, которые мы будем вычислять с помощью медианы.
- sib_sp, parch,и fare пока все в порядке.
Разработка функций
Теперь мы готовы преобразовать набор данных в соответствии с приведенными выше спецификациями. Вот этапы разработки функций в коде.
model_recipe <-
titanic_data |>
recipe(survived ~ .) |>
step_select(
-c(
name,
ticket,
passenger_id
)
) |>
step_mutate(
cabin = as.factor(
str_sub(
cabin,
start = 1,
end = 1
)
)
) |>
step_indicate_na(
all_predictors()
) |>
step_dummy(
all_nominal_predictors()
) |>
step_impute_median(
all_numeric_predictors()
) |>
step_nzv(
all_numeric_predictors()
) |>
step_corr(
all_numeric_predictors()
) |>
step_BoxCox(
all_numeric_predictors()
) |>
step_normalize(
all_numeric_predictors()
)
Вот объяснение каждого шага в коде:
- step_select, чтобы исключить переменные ticket,passage_id,иимя.
- step_mutate, чтобы получить только первую букву из переменной cabin.
- step_indicate_na, чтобы создать столбцы индикаторов NA для переменных с отсутствующими наблюдениями.
- step_dummy, чтобы создать фиктивные переменные для каждого из категориальных предикторов.
- step_impute_median для расчета медианы.
- step_nzv для удаления предикторов с почти нулевой дисперсией.
- step_corr для удаления предикторов с высокой степенью корреляции (таких как sex_male и sex_female, созданных однократным кодированием sex).
- step_BoxCox, чтобы выполнить преобразование кокса с данными (преобразование данных для более нормального распределения).
- step_normalize для центрирования и масштабирования данных.
Порядок этих шагов важен!
Теперь давайте применим преобразование к данным и просмотрим результат.
titanic_data_transformed <-
prep(model_recipe) |>
bake(new_data = titanic_data)
skim(titanic_data_transformed)

Давайте также посмотрим на график корреляции предикторов и выжившего столбца.

Мы видим, что переменные действительно обладают предсказательной силой, поэтому мы должны увидеть довольно сильный результат.
Выбор модели
Мы попытаемся подогнать четыре разные модели к набору данных и посмотреть, какая из них работает лучше всего. Мы попробуем регрессию случайного леса, логистическую регрессию, регрессию ближайшего соседа и регрессию дерева решений.
Следующая функция — это оболочка, которую я создал для шагов Tidymodels, описанных в этой статье. Эта функция включает в себя разделение теста/обучения, перекрестную проверку для автоматической настройки гиперпараметров и подгонку модели.
# Function to create a model
create_model <-
function(data,
formula,
model_type,
mode = "regression",
n_folds = 10,
seed = 101) {
# Model recipe
model_recipe <-
data |>
recipe(formula)
# Model mode and engine
model <-
model_type |>
set_mode(mode)
# Wrap in a workflow
model_workflow <-
workflow() |>
add_recipe(model_recipe) |>
add_model(model)
# Split the data
set.seed(seed)
data_split <-
initial_split(
as.data.frame(data),
strata = all.vars(formula)[1]
)
# Create data folds
set.seed(seed)
data_folds <-
vfold_cv(
training(data_split),
v = n_folds,
strata = all.vars(formula)[1]
)
# Select best model
set.seed(seed)
best_model <-
tune_grid(
model_workflow,
resamples = data_folds
) |>
select_best()
# Finalize the model
model_workflow_final <-
finalize_workflow(
model_workflow,
best_model
)
# Fit the model
set.seed(seed)
model_fit <-
model_workflow_final |>
last_fit(
data_split
)
}
Вот код для установки четырех моделей. Обратите внимание, что я изменяю выживший столбец на фактор (требование для прогнозирования с классификацией) и устанавливаю параметры моделей, которые хочу настроить, с помощью функции tune().
Примечание. Для запуска следующего кода вам потребуются установленные пакеты ranger и kknn.
rf_model <-
titanic_data_transformed |>
mutate(
survived = factor(survived)
) |>
create_model(
survived ~ .,
rand_forest(
mtry = tune(),
min_n = tune()
),
"classification",
3
)
lr_model <-
titanic_data_transformed |>
mutate(
survived = factor(survived)
) |>
create_model(
survived ~ .,
logistic_reg(),
"classification",
3
)
nn_model <-
titanic_data_transformed |>
mutate(
survived = factor(survived)
) |>
create_model(
survived ~ .,
nearest_neighbor(
neighbors = tune()
),
"classification",
3
)
dt_model <-
titanic_data_transformed |>
mutate(
survived = factor(survived)
) |>
create_model(
survived ~ .,
decision_tree(
min_n = tune()
),
"classification",
3
)
Давайте теперь проверим результаты.
do.call(
bind_rows,
args = list(
collect_metrics(rf_model),
collect_metrics(lr_model),
collect_metrics(nn_model),
collect_metrics(dt_model)
)
) |>
mutate(
model = c(
rep("random_forest", 2),
rep("logistic_regression", 2),
rep("nearest_neighbor", 2),
rep("decision_tree", 2)
)
) |>
select(
-c(.config)
)

Мы видим, что наиболее эффективной моделью была модель ближайшего соседа с точностью 0,804 и оценкой ROC_AUC 0,855.
Мы можем выбрать эту модель и собрать прогнозы нашей модели для набора тестовых данных, предоставленного Kaggle.
test_data_transformed <-
prep(model_recipe) |>
bake(new_data = test_data)
result <-
predict(
object = extract_fit_parsnip(
nn_model
),
new_data = test_data_transformed,
type = "class"
)
Результат
Я загрузил фрейм данных результата в CSV и загрузил его в Kaggle. Моя оценка точности была 0,75837.
Вот полная копия кода из этой статьи: MCodrescu/titanic_data_model (github.com)
Спасибо за прочтение!
Дополнительная информация о R доступна на странице medium.com/r-evolution. Подпишитесь на нашу рассылку новостей и следите за нами в Твиттере.