# автор - Лакман Ирина Александровна # практика 7 # Напоминания: # ctrl + enter - выполнение выбранной строки # <- сочетание клавиш `Alt` + `-` # --- Пакеты --------------------------------------------------------------------------------------- # Подключение пакетов library(dplyr) # для работы с данными library(DescTools) # для описательной статистики library(ISwR) # для загрузки встроенного набора данных intake library(readxl)# для работы с данными в формате Excel library(stats) # --- Загрузка данных ------------------------------------------------------------------------------ # Прописывание полного пути до файла может занять много времени # Лучше всего создать проект, где можно разместить необходимый набор данных # Тогда полный путь прописывать не придется data <- read.csv("heart.csv") # Набор данных по определению сердечно-сосудистых заболеваний # age - возраст, # sex - пол, # cp - тип боли в груди (4 значения), # trestbps - артериальное давление в состоянии покоя # chol - холестерол сыворотки крови в мг/дл, # fbs - уровень сахара в крови натощак > 120 мг/дл, # restecg - электрокардиографические результаты покоя (значения 0,1,2) # thalach - достигнутая максимальная частота сердечных сокращений, # exang - упражнения индуцированной стенокардии # oldpeak - депрессия St, индуцированная по отношению к остальным, # slope - наклон пика сегмента ST # ca - количество крупных сосудов (0-3), окрашенных флюороскопией # thal - 0 - нормальный; 1 - фиксированный дефект; 2 - обратимый дефект, # target - целевая переменная: # 0 - меньше шансов сердечного приступа # 1 - больше шансов сердечного приступа summary(data) # Статистики по данным # Некоторые переменные являются качественными, например target, sex, ср и др. # Но эти переменные записаны сейчас как числовые num или int (целочисленные) # Необходимо перевести часть переменных в факторы # Предобработка данных (укажем какие переменные являются факторными) data <- mutate(data, target = as.factor(target), sex = as.factor(sex), cp = as.factor(cp), fbs = as.factor(fbs), restecg = as.factor(restecg), exang = as.factor(exang), ca = as.factor(ca), slope = as.factor(slope), thal = as.factor(thal)) summary(data) # Видно, что по факторным признакам сейчас определяется частота наблюдения # --- Проведение тестов ---------------------------------------------------------------------------- # Разделение на группы по возрасту (старше 55 лет и младше 55 лет) data_x <- filter(data, age > 55) # только пациенты старше 55 data_y <- filter(data, age <= 55) # только пациенты младше или равно 55 summary(data_x) # Рассмотрим в образованных группах признак "уровень холестерина" (chol) # Для того, чтобы определиться какие тесты применять на сходство и различие выборок # параметрические или непараметрические - проверим выборки на нормальность распределения # --- Тест Шапиро-Уилка # Для проверки нормальности распределений сформированных двух выборок # нулевая гипотеза о согласии распределения данных в выборке с нормальным законом распределения shapiro.test(data_x$chol) shapiro.test(data_y$chol) hist(data_x$chol) hist(data_y$chol) qqnorm(data_x$chol) qqnorm(data_y$chol) # Так как тесты на нормальность нулевую гипотезу о нормальном распределении отклонили, # то применяем непараметрические тесты к сравнению выборок - тест Мана-Уитни и тест Колмогорова-Смирнова # ------применение параметрических тестов---------------- # сравнение двух выборок согласно тсету Стюдента-Уэлча # Н0: о равенстве средних уровня креатинина у пациентов с сахарным и без него диабетом t.test(data_x$crea, data_y$crea) # ------применение непараметрических тестов---------------- # --- Тест Колмогорова-Смирнова # для двух независимых выборок ks.test(data_x$chol, data_y$chol) # Нулевая гипотеза об отсутствии статистически значимой разницы между двумя независимыми выборками # --- Тест Мана-Уитни # Для двух независимых выборок wilcox.test(data_x$chol, data_y$chol, paired = FALSE) # Нулевая гипотеза об об отсутствии статистически значимой разницы между двумя независимыми выборками # Критерий хи-квадрат для сравнения частот встречаемости признака в независимых выборках # из таблицы с данными рассмотрим два фактора: пол (sex) и наличие заболеваний сердца (target) # Преобразуем данные в матрицу 2х2, чтобы сопоставить признаки sex и target data_table <- table(data$sex, data$target) data_table # Посмотрим полученную матрицу #Применим тест хи-квадрат (R автоматически применяет поправку Йетса на непрерывность) chisq.test(data_table) #нулевая гипотеза об отсутствии зависимости между сердечными заболеваниями и полом респондентов # --- Тесты для зависимых выборок --- # --- Тест Вилкоксона # Для двух зависимых выборок # Рассмотрим пример о суточном потреблении энергии, измеренном у одних и тех же # 11 женщин до (pre) и после (post) периода менструаций intake # Покажет данные в консоли ?intake # Описание данных data_2 <- intake # загрузка данных из пакета ISwR wilcox.test(data_2$pre, data_2$post, paired = TRUE) # Нулевая гипотеза об об отсутствии статистически значимой разницы # В потреблении энергии у исследованных женщин до и после менструации # Сформируем из данных data_2 качественные переменные до и после менструации у 11 женщин # Бинаризацию сделаем по принципу >=6000 - это 1, < 6000 это 0 # Новые созданные переменные pre1 и post1 добавим сразу в набор data_2 data_2$pre1[data_2$pre >= 6000] <- 1 data_2$pre1[data_2$pre < 6000] <- 0 data_2$pre1 <- as.factor(data_2$pre1) data_2$post1[data_2$post >= 6000] <- 1 data_2$post1[data_2$post < 6000] <- 0 data_2$post1 <- as.factor(data_2$post1) # Посмотрим статистику по новым данным summary(data_2) # Преобразуем данные в матрицу 2х2, чтобы сопоставить признаки pre1 и post1 data_2_table <- table(data_2$pre1, data_2$post1) data_2_table # Посмотрим полученную матрицу # --- Тест Мак-Нимара mcnemar.test(data_2_table) # По умолчанию поправка Эдвардса применяется. # При необходимости ее можно отключить, воспользовавшись аргументом correct mcnemar.test(data_2_table, correct = FALSE) # --- тест Краскелла-Уолиса # Для анализа используем встроенный набор InsectSprays, загрузим его в data_3 ?InsectSprays # Описание данных data_3 <- InsectSprays # загрузка данных View(data_3) # Просмотр набора данных head(data_3) # Покажет первые несколько строчек в наборе #Столбец count — показатель эффективности спрея, spray — его тип # Предположим, что данные во всех группах не распределены нормально # и необходимо оценить, есть ли различия в эффективности спреев между группами kruskal.test(data_3$count ~ data_3$spray) # Нулевая гипотеза об отсутствии отличий (выборки взяты из одного распределения) # установим дополнительные библиотеки library(corrplot) # для построения хитмапа коэффициентов корреляции library(tadyverse) # для дополнительных манипуляций с данными # отберем только числовые переменные из исходного набора данных data_4 <- select(data, age, trestbps, chol, thalach, oldpeak) # создадим матрицу парных коэффициентов корреляции gggg <- cor(data_4) ?corrplot # построим хитмап коэффициентов корреляции corrplot(gggg, method = "circle", type = "full") # ------------------базовая проверка на нормальность распределения--------- # используем команду plot_normality ко всему датасету (состоит только из числовых признаков) # строит обычную гистограмму, Q-Q график, гистаграммы логарифмированных и # "взятых под корнем" переменных # если в скобках указать набор данных, то анализ будет проведен для каждой из переменных plot_normality(data_4) # если в скобках указать конкретную переменную, то анализ будет проведен только для нее plot_normality(data$age)