Lab2Nikishkin

knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE)

library(dplyr)

## 
## Присоединяю пакет: 'dplyr'

## Следующие объекты скрыты от 'package:stats':
## 
##     filter, lag

## Следующие объекты скрыты от 'package:base':
## 
##     intersect, setdiff, setequal, union

library(ggplot2)
library(reshape2)
library(kableExtra)

## 
## Присоединяю пакет: 'kableExtra'

## Следующий объект скрыт от 'package:dplyr':
## 
##     group_rows

library(ggfortify)

# Чтение данных
data <- read.csv("var05.csv")
str(data)

## 'data.frame':    156 obs. of  4 variables:
##  $ stid  : int  1528 1519 1528 1528 1529 1525 1529 2369 1527 1529 ...
##  $ discid: int  162 139 150 176 163 139 159 150 3 112 ...
##  $ semnum: int  5 5 5 5 5 5 5 5 5 5 ...
##  $ stmark: int  60 60 88 88 90 85 60 14 96 92 ...

table(data$semnum)

## 
##   5 
## 156

data_simple <- data %>% select(-semnum)

# Уникальные студенты
cat("Количество уникальных студентов:", length(unique(data_simple$stid)), "\n")

## Количество уникальных студентов: 18

shapiro_test <- shapiro.test(data_simple$stmark)
shapiro_test

## 
##  Shapiro-Wilk normality test
## 
## data:  data_simple$stmark
## W = 0.71191, p-value = 3.973e-16

# Собираем топ студентов
top_students <- data_simple %>% 
  group_by(stid) %>% 
  filter(stmark >= 90) %>% 
  summarise(n = n()) %>% 
  arrange(desc(n))
head(top_students, 10)

## # A tibble: 10 × 2
##     stid     n
##    <int> <int>
##  1  1536     8
##  2  1525     7
##  3  1520     6
##  4  1527     6
##  5  1529     6
##  6  1533     6
##  7  1523     5
##  8  1526     5
##  9  1530     4
## 10  1534     4

summary(data_simple$stmark)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    0.00   65.00   85.00   71.44   90.00   98.00

# Гистрограмма распределения оценок
ggplot(data_simple, aes(x = stmark)) +
  geom_histogram(binwidth = 5, fill = 'cyan', color = 'black') +
  labs(title = "Распределение оценок студентов",
       x = "Оценка",
       y = "Количество") +
  theme_minimal()

# Здесь оценки по студентам - boxplot
# Да, по сути у нас ID кривые (было бы круто по именам, но что есть), но зная, что у нас всего 18 студентов, то впринципе показательно. 
ggplot(data_simple, aes(y = stmark, x = factor(stid))) +
  geom_boxplot() +
  labs(title = "Распределение оценок по студентам",
       x = "ID студента",
       y = "Оценка") +
  theme(axis.text.x = element_blank())

# Преобразование в широкий формат
wide_data <- dcast(data_simple, stid ~ discid, value.var = "stmark")
wide_data[is.na(wide_data)] <- 0
head(wide_data)

##   stid  3 28 57 112 139 150 159 162 163 176
## 1 1519 91 80 65  90  60  85  75  85  90  23
## 2 1520 94 79 80  92  79  94  85  90  90  96
## 3 1523 93 80 85  91  81  98  85  90  90  80
## 4 1525 93 92 65  94  85  94  70  90  90  97
## 5 1526 90 76 65  91  73  94  60  90  90  83
## 6 1527 96 92 65  92  84  96  85  95  90  78

# KMeans
# Здесь был очень долгий затуп. Из-за ID предметов.
set.seed(123)
kmeans_result <- kmeans(wide_data[-1], centers = 3)
wide_data$cluster <- as.factor(kmeans_result$cluster)

# Рассчитываем IQR (межквартальный размах) для каждого предмета (ищем предметы, где оценки студентов сильно отличаются — это поможет выделить кластеры четче)
iqr_values <- apply(wide_data[-1], 2, IQR)  # Нужно убрать stid
# Выбираем топ-2 предмета с максимальным разбросом
top_subjects <- names(sort(iqr_values, decreasing = TRUE))[1:2]
top_subjects

## [1] "162" "176"

autoplot(kmeans_result, data = wide_data[-1], frame = TRUE)

ggplot(wide_data, aes(x = `162`, y = `176`, color = cluster)) +
  geom_point(size = 3) +
  labs(title = "Кластеризация студентов по успеваемости (по ID предметов)",
       x = "Оценка по предмету 162",
       y = "Оценка по предмету 176") +
  theme_minimal()

# Иерархическая кластеризация
# Здесь цифры от 1-18 разумеется уникальные студенты и чем выше его "строка", тем больше отличие. 
dist_matrix <- dist(wide_data[-1])
hclust_result <- hclust(dist_matrix)

plot(hclust_result, main = "Дендрограмма иерархической кластеризации",
     xlab = "Студенты", ylab = "Расстояние")

mean_marks <- wide_data %>% 
  select(-stid) %>% 
  summarise(across(everything(), ~ mean(., na.rm = TRUE))) %>% 
  t() %>% 
  as.data.frame() %>% 
  rename("Средний_балл" = "V1") %>% 
  mutate(Предмет = rownames(.)) %>% 
  select(Предмет, Средний_балл) %>% 
  arrange(desc(Средний_балл))

## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `across(everything(), ~mean(., na.rm = TRUE))`.
## Caused by warning in `mean.default()`:
## ! аргумент не является числовым или логическим: возвращаю NA

mean_marks %>% 
  kable(digits = 1, caption = "Средний балл по предметам") %>% 
  kable_styling(bootstrap_options = "striped", full_width = FALSE)

Средний балл по предметам

	Предмет	Средний_балл
3	3	70.5
150	150	67.3
112	112	66.2
163	163	65.0
28	28	63.2
162	162	63.1
159	159	62.9
139	139	55.7
57	57	54.2
176	176	51.0
cluster	cluster	NA