Исследовательский анализ данных в R: обобщение данных, визуализация и прогнозная модель
Извлечение значения набора данных
Исследовательский анализ данных неизбежен для понимания любого набора данных. Он включает обобщение данных, визуализацию, некоторый статистический анализ и прогнозный анализ. В этой статье основное внимание будет уделено повествованию данных или исследовательскому анализу данных с использованием R и различных пакетов R.
Эта статья будет охватывать:
- Обобщение и визуализация некоторых ключевых моментов
2. Некоторая базовая статистика
3. Прогностическая модель
Если вы регулярно читаете мои статьи, возможно, вы уже видели другой проект исследовательского анализа данных, использующий тот же набор данных ранее в Python. Вот ссылка:
Я использую тот же набор данных здесь для выполнения исследовательского анализа данных в R. Однако подход отличается.
Давайте начнем! Не стесняйтесь скачать набор данных по этой ссылке.
Подведение итогов и визуализация
У меня есть набор данных в той же папке, что и мой файл RStudio. Итак, здесь я могу прочитать файл CSV в RStudio:
df = read.csv("heart_failure_clinical_records_dataset.csv")
Я не показываю снимок экрана, потому что набор данных довольно большой. Это столбцы в наборе данных:
colnames(df)
Выход:
[1] "age" "anaemia" "creatinine_phosphokinase" "diabetes" "ejection_fraction" [6] "high_blood_pressure" "platelets" "serum_creatinine" "serum_sodium" "sex" [11] "smoking" "time" "DEATH_EVENT"
Набор данных имеет разные параметры здоровья, возраст, пол и DEATH_EVENT. Есть много способов подойти к набору данных. Я хочу начать с просмотра графика корреляции. Было бы неплохо начать с того, чтобы посмотреть, какие переменные коррелированы. Требуется библиотека corrplot.
library(corrplot) corrplot(cor(df), type = "upper")
Я воспользуюсь этим сюжетом как руководством при выборе следующих шагов.
В этом наборе данных есть шесть непрерывных переменных. Давайте проверим их распределение. Сначала эти шесть переменных будут разделены как другой набор данных, а затем с использованием базового R будут построены гистограммы:
df1 = df[, c('age', 'creatinine_phosphokinase', 'ejection_fraction', 'platelets', 'serum_creatinine', 'serum_sodium')]
hist.data.frame(df1, title = "Histograms of all Numerical Variables")
Распределение дает представление об этих шести переменных. Наличие некоторых данных будет еще более полезным. Я буду использовать сводную функцию, которая дает некоторые основные статистические параметры.
summary(df1)
Выход:
age creatinine_phosphokinase ejection_fraction platelets Min. :40.00 Min. : 23.0 Min. :14.00 Min. : 25100 1st Qu.:51.00 1st Qu.: 116.5 1st Qu.:30.00 1st Qu.:212500 Median :60.00 Median : 250.0 Median :38.00 Median :262000 Mean :60.83 Mean : 581.8 Mean :38.08 Mean :263358 3rd Qu.:70.00 3rd Qu.: 582.0 3rd Qu.:45.00 3rd Qu.:303500 Max. :95.00 Max. :7861.0 Max. :80.00 Max. :850000 serum_creatinine serum_sodium Min. :0.500 Min. :113.0 1st Qu.:0.900 1st Qu.:134.0 Median :1.100 Median :137.0 Mean :1.394 Mean :136.6 3rd Qu.:1.400 3rd Qu.:140.0 Max. :9.400 Max. :148.0
Точно так же категориальные переменные для удобства взяты как отдельный набор данных:
df2 = df[, c('anaemia', 'diabetes', 'high_blood_pressure', 'sex', 'smoking', 'DEATH_EVENT')]
head(df2)
Хотя график корреляции не показывает корреляции между DEATH_EVENT и переменной «пол». Я все еще хочу увидеть количество смертей у мужчин и женщин. Перед этим рекомендуется заменить 0 и 1 этих столбцов на какие-нибудь значимые строки.
df$death = ifelse(df$DEATH_EVENT == 1, "Yes", "No") df$sex = ifelse(df$sex == 1, "Male", "Female") table(df$sex, df$death)
В целом в наборе данных больше мужчин, чем женщин. Какой процент мужчин и женщин?
data = table(df$sex) data1 = round(data/sum(data)*100) data1 = paste(names(data1), data1) paste(data1, "%", sep = "")
Выход:
[1] "Female 35%" "Male 65%"
Чтобы узнать больше о населении в наборе данных, давайте отдельно проверим возрастное распределение мужского и женского населения:
ggplot(df, aes(x = age)) + geom_histogram(fill = "white", colour = "black") + facet_grid(sex ~ .)
Приведенные выше гистограммы показывают, что мужское население в целом старше женского.
Креатинин сыворотки и натрий сыворотки показывают некоторую корреляцию. Диаграмма рассеяния ясно покажет это:
ggplot(df) + geom_point(aes(x = serum_creatinine, y = serum_sodium, colour = death, shape = death)) + ggtitle("Serum Creatinine vs Serum Sodium")
Из-за небольшого количества выбросов большая часть данных сгруппирована в одном месте. В такой ситуации рекомендуется проверять тот же график без этих выбросов.
df_scr = df[df$serum_creatinine < 4.0 & df$serum_sodium > 120,]
ggplot(df_scr) + geom_point(aes(x = serum_creatinine, y = serum_sodium, colour = death, shape = death)) + ggtitle("Serum Creatinine vs Serum Sodium")
График четко показывает взаимосвязь между натрием и креатинином сыворотки. Точки разделены событиями смерти с использованием разных цветов и форм.
Следующий график - это зависимость фракции выброса от случая смерти. Он покажет график джиттера, который на самом деле является модифицированной версией графика разброса. Когда одна из переменных на диаграмме рассеяния является категориальной, точки остаются на прямой линии и перекрываются. Это становится трудно понять. Вот почему на графике джиттера точки немного отклоняются, что дает лучшее понимание данных. Также мы добавим красную точку, которая покажет среднее значение данных.
Если вы заметили, я немного обрезал данные. Я вырезал две точки данных, которые были выбросами.
Переменная времени имеет сильную корреляцию с событиями смерти. Я хотел бы увидеть диаграмму, которая покажет разницу во «времени» для событий смерти и без событий смерти:
ggplot(df, aes(death, time))+geom_point() + labs(title="Death Event with Time Variable Segregated by Gender",
x = "Death",
y = "Time") +
geom_boxplot(fill='steelblue', col="black", notch=TRUE) + facet_wrap(~ sex)
Креатининфосфокиназа и событие смерти имеют некоторую корреляцию. Следующий график исследует это с помощью гистограммы:
ggplot(df, aes(x=creatinine_phosphokinase, fill=death)) + geom_histogram(bins=20) + labs(title = "Distribution of Creatinine Phosphokinase", x = "Creatinine Phosphokinase", y = "Count")
Анемия также связана с креатининфосфокиназой. Распределение можно разделить по анемии, чтобы наблюдать распределение отдельно по анемии:
ggplot(df, aes(x=creatinine_phosphokinase, fill=death)) + geom_histogram(bins=20)+facet_wrap(~anaemia) + labs(title = "Distribution of Creatinine Phosphokinase", x = "Creatinine Phosphokinase", y = "Count")
Распределение совершенно иное для населения с анемией и без анемии.
Переменная «время» сильно коррелирует со случаями смерти. На этом графике разброса возраста и времени события смерти показаны разными цветами.
ggplot(df, aes(x = age, y = time, col = death))+geom_point() + labs(title = "Age vs Time", x = "Age", y = "Time")
На следующем графике показано распределение креатинина сыворотки, выделенное разными цветами для случаев смерти:
ggplot(df, aes(x = serum_creatinine, fill = death))+geom_histogram() + labs(title = "Distribution of Serum Creatinine different colors for death event", x = "Serum Creatinine", y = "Count")
Справа очень мало выбросов. Давайте проверим то же распределение без этих выбросов:
df_sc = df[df$serum_creatinine < 4.0,] ggplot(df_sc, aes(x = serum_creatinine, fill = death))+geom_histogram() + labs(title = "Distribution of Serum Creatinine different colors for death event", x = "Serum Creatinine", y = "Count")
Теперь распределение стало более ясным.
Фракция выброса может быть разной для случаев смерти. Также будет интересно посмотреть, отличается ли фракция выброса в зависимости от пола.
ggplot(df, aes(death, ejection_fraction, fill = as.factor(sex))) +
geom_bar(stat = "summary", fun = "median", col = "black",
position = "dodge") + geom_point(position = position_dodge(0.9)) + labs(title = "Ejection Fraction per Death Event", x = "Death", y = "Ejection Fraction")
Эти черные точки показывают расхождение в данных.
Следующий график исследует взаимосвязь между анемией и креатининфосфокиназой отдельно для случаев смерти и без событий смерти.
ggplot(df, aes(x = as.factor(anaemia), y = creatinine_phosphokinase, fill = death)) + geom_violin() + stat_summary(aes(x= as.factor(anaemia), y = creatinine_phosphokinase), fun = median, geom='point', colour = "red", size = 3)+facet_wrap(~death)+ geom_jitter(position = position_jitter(0.1), alpha = 0.2) + labs(title = "Creatinine Phosphokinase for Anaemia State Segregated by Death Event", x = "Anaemia", y ="Creatinine Phosphokinase")
На этом графике вы можете одновременно увидеть несколько разных ракурсов. Сюжет скрипки показывает распределение и выбросы. В то же время я поместил в него график джиттера с красной точкой, которая указывает на медианное значение соответствующих данных.
Прогнозирующая модель
В этом разделе мы попытаемся увидеть, можем ли мы предсказать событие смерти, используя другие функции в наборе данных. Во-первых, мы должны проверить пропорции смертельных событий:
data = table(df$death) round(data/sum(data), 2)
Выход:
No Yes 0.68 0.32
Для этой прогнозной модели я еще раз импортирую набор данных, потому что я внес несколько изменений в набор данных, который импортировал ранее.
df1 = read.csv("heart_failure_clinical_records_dataset.csv")
Теперь я разделю набор данных на данные для обучения и данные для тестирования.
library(caTools) set.seed(1243) split = sample.split(df1$DEATH_EVENT, SplitRatio = 0.75)
Это разбиение должно предоставлять логические значения для каждого DEATH_EVENT. 75% из них верны, а 25% - ложны. На основе этого значения разделения, training_data и test_data будут разделены:
training_data = subset(d, split == TRUE) test_data = subset(d, split == FALSE)
Набор данных готов для классификатора. Я выбираю машинный классификатор опорных векторов для этого проекта.
library(e1071)
svm_fit = svm(formula = DEATH_EVENT ~ .,
data = training_data,
type = 'C-classification',
kernel = 'linear'
)
Данные обучения были помещены в классификатор, и теперь классификатор обучен. Теперь классификатор можно протестировать на тестовых данных. Используя тестовые данные, я спрогнозирую DEATH_EVENT. Итак, нам нужно исключить DEATH_EVENT из тестовых данных.
y_pred = predict(svm_fit, newdata = test_data[-13])
Прогноз сделан. Теперь давайте проверим точность прогноза. Здесь используется функция ConfusionMatrix из пакета «caret». Поскольку эта функция ConfusionMatrix предоставляет так много информации с помощью всего одной строчки кода:
library(caret) confusionMatrix(y_pred, as.factor(test_data$DEATH_EVENT))
Выход:
Confusion Matrix and Statistics
Reference
Prediction 0 1
0 47 5
1 4 19
Accuracy : 0.88
95% CI : (0.7844, 0.9436)
No Information Rate : 0.68
P-Value [Acc > NIR] : 5.362e-05
Kappa : 0.7212
Mcnemar's Test P-Value : 1
Sensitivity : 0.9216
Specificity : 0.7917
Pos Pred Value : 0.9038
Neg Pred Value : 0.8261
Prevalence : 0.6800
Detection Rate : 0.6267
Detection Prevalence : 0.6933
Balanced Accuracy : 0.8566
'Positive' Class : 0
Общая точность 88%.
Посмотрите на матрицу путаницы вверху! Он не предсказывает 47 случаев смерти точно и 4 случая смерти не были ошибочно предсказаны как события смерти. С другой стороны, 19 смертельных случаев были предсказаны точно, а 5 смертельных случаев были ошибочно предсказаны как не имеющие смертельного исхода.
Здесь истинно положительное значение - 19, ложное положительное - 4, а ложноотрицательное - 5. Используя эту информацию, оценка F1 рассчитывается ниже:
true_positive / (true_positive + 0,5 * (false_positive + false_negative)) = 0,81
Я не комментирую, хорошо или плохо работает модель прогнозирования. Это зависит от ожиданий и ожиданий варьируется от проекта к проекту.
Заключение
Исследовательский анализ данных очень динамичен. Вы можете подойти к набору данных по-разному. Это был один из моих подходов. Если вы ранее проверяли мою работу с тем же набором данных в Python, вы увидите другой подход. Не стесняйтесь опробовать на нем другие типы визуализации и классификатор по вашему выбору. Спасибо за прочтение!
Не стесняйтесь подписываться на меня в Twitter и ставить лайки на моей странице Facebook.
