## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## corrplot 0.95 loaded
## Warning: package 'knitr' was built under R version 4.5.3
Το επιλεγμένο σύνολο δεδομένων με 1000 εγγραφές, περιλαμβάνει έναν συνδυασμό ποσοτικών και ποιοτικών μεταβλητών που αφορούν τις καθημερινές συνήθειες μαθητών και την τελική τους επίδοση στις εξετάσεις. Κύριος στόχος της ανάλυσης είναι ο προσδιορισμός των παραγόντων που παρουσιάζουν την ισχυρότερη συσχέτιση με τη βαθμολογία των μαθητών.
Το συγκεκριμένο dataset επιλέχθηκε για να κατανοήσουμε τους παράγοντες που οδηγούν σε υψηλότερες βαθμολογίες στις εξετάσεις. Στόχος μας είναι να δείξουμε ότι οι καθημερινές συνήθειες επηρεάζουν άμεσα την επίδοση και ότι η επιτυχία δεν εξαρτάται αποκλειστικά από το έμφυτο ταλέντο. Μέσω της επιχειρηματικής αναλυτικής, θέλουμε να προσφέρουμε στους φοιτητές ουσιαστική υποστήριξη για την ακαδημαϊκή τους πορεία.
Θα βρόυμε υψηλή συσχέτιση μεταξύ μεταβλητών που έχουν σημαντική επίδραση στη βαθμολογία. Πως και πόσο επιδρά η διατροφή, ο ύπνος, η χρήση των social media, η γυμναστική στην επίδοση μας; Μπορούμε να εντοπίσουμε συνήθειες που θα βελτιώσουν σημαντικά την ακαδημαϊκή πορεία των φοιτητών.
kable(metadata, caption = "Περιγραφή Μεταβλητών")
| Μεταβλητή | Τύπος | Εύρος_Τιμών | Περιγραφή |
|---|---|---|---|
| student_id | character | - | Μοναδικό αναγνωριστικό μαθητή |
| age | numeric | 17 - 24 | Ηλικία φοιτητή |
| gender | character | - | Φύλο (Male/Female/Other) |
| study_hours_per_day | numeric | 0 - 8.3 | Ώρες μελέτης ανά ημέρα |
| social_media_hours | numeric | 0 - 7.2 | Χρήση Social Media καθημερινά (ώρες) |
| netflix_hours | numeric | 0 - 5.4 | Χρήση Streaming/Netflix (ώρες) |
| part_time_job | character | - | Ύπαρξη μερικής απασχόλησης (Yes/No) |
| attendance_percentage | numeric | 56 - 100 | Ποσοστό παρουσιών (0-100%) |
| sleep_hours | numeric | 3.2 - 10 | Ώρες ύπνου καθημερινά |
| diet_quality | character | - | Ποιότητα διατροφής (Poor/Fair/Good) |
| exercise_frequency | numeric | 0 - 6 | Συχνότητα άσκησης (ημέρες/βδομάδα) |
| parental_education_level | character | - | Επίπεδο μόρφωσης γονέων |
| internet_quality | character | - | Ποιότητα σύνδεσης Internet |
| mental_health_rating | numeric | 1 - 10 | Δείκτης ψυχικής υγείας (1 = Χαμηλή - 10 = Καλή |
| extracurricular_participation | character | - | Συμμετοχή σε εξωδιδακτικές δραστηριότητες (Yes/No) |
| exam_score | numeric | 18.4 - 100 | Βαθμολογία εξέτασης (0,100) |
Περιγραφικά στατιστικά του Dataset:
# Read CSV file
studentTable <- read_csv("student_performance.csv" , show_col_types = FALSE)
summary(studentTable)
## student_id age gender study_hours_per_day
## Length:1000 Min. :17.00 Length:1000 Min. :0.00
## Class :character 1st Qu.:18.75 Class :character 1st Qu.:2.60
## Mode :character Median :20.00 Mode :character Median :3.50
## Mean :20.50 Mean :3.55
## 3rd Qu.:23.00 3rd Qu.:4.50
## Max. :24.00 Max. :8.30
## social_media_hours netflix_hours part_time_job attendance_percentage
## Min. :0.000 Min. :0.000 Length:1000 Min. : 56.00
## 1st Qu.:1.700 1st Qu.:1.000 Class :character 1st Qu.: 78.00
## Median :2.500 Median :1.800 Mode :character Median : 84.40
## Mean :2.506 Mean :1.820 Mean : 84.13
## 3rd Qu.:3.300 3rd Qu.:2.525 3rd Qu.: 91.03
## Max. :7.200 Max. :5.400 Max. :100.00
## sleep_hours diet_quality exercise_frequency parental_education_level
## Min. : 3.20 Length:1000 Min. :0.000 Length:1000
## 1st Qu.: 5.60 Class :character 1st Qu.:1.000 Class :character
## Median : 6.50 Mode :character Median :3.000 Mode :character
## Mean : 6.47 Mean :3.042
## 3rd Qu.: 7.30 3rd Qu.:5.000
## Max. :10.00 Max. :6.000
## internet_quality mental_health_rating extracurricular_participation
## Length:1000 Min. : 1.000 Length:1000
## Class :character 1st Qu.: 3.000 Class :character
## Mode :character Median : 5.000 Mode :character
## Mean : 5.438
## 3rd Qu.: 8.000
## Max. :10.000
## exam_score
## Min. : 18.40
## 1st Qu.: 58.48
## Median : 70.50
## Mean : 69.60
## 3rd Qu.: 81.33
## Max. :100.00
Μπορούμε να βρούμε μετρικές όπως τυπική απόκλιση , μεταβλητότητα και εύρος
summary(studentTable [, c(
"exam_score",
"study_hours_per_day",
"sleep_hours",
"social_media_hours",
"attendance_percentage"
)])
## exam_score study_hours_per_day sleep_hours social_media_hours
## Min. : 18.40 Min. :0.00 Min. : 3.20 Min. :0.000
## 1st Qu.: 58.48 1st Qu.:2.60 1st Qu.: 5.60 1st Qu.:1.700
## Median : 70.50 Median :3.50 Median : 6.50 Median :2.500
## Mean : 69.60 Mean :3.55 Mean : 6.47 Mean :2.506
## 3rd Qu.: 81.33 3rd Qu.:4.50 3rd Qu.: 7.30 3rd Qu.:3.300
## Max. :100.00 Max. :8.30 Max. :10.00 Max. :7.200
## attendance_percentage
## Min. : 56.00
## 1st Qu.: 78.00
## Median : 84.40
## Mean : 84.13
## 3rd Qu.: 91.03
## Max. :100.00
#Τυπική Απόκλιση στο exam_score
round(sd(studentTable$exam_score,na.rm=TRUE),2)
## [1] 16.89
#Variance στο exam_score
round(var(studentTable$exam_score,na.rm=TRUE),2)
## [1] 285.22
#Ελάχιστη/Μέγιστη Τιμή
min(studentTable$exam_score,na.rm=TRUE)
## [1] 18.4
max(studentTable$exam_score,na.rm=TRUE)
## [1] 100
#Τυπική Απόκλιση στο sleep_hours
round(sd(studentTable$sleep_hours,na.rm=TRUE),2)
## [1] 1.23
#Variance στο sleep_hours
round(var(studentTable$sleep_hours,na.rm=TRUE),2)
## [1] 1.5
#Τυπική Απόκλιση στη Παρακολούθηση των διαλέξεων
round(sd(studentTable$attendance_percentage,na.rm=TRUE),2)
## [1] 9.4
#Variance στη Παρακολούθηση των διαλέξεων
round(var(studentTable$attendance_percentage,na.rm=TRUE),2)
## [1] 88.35
Θα βρούμε ποιες μεταβλητές έχουν ισχυρή συσχέτιση μεταξύ τους.
#Βήμα 1. Πίνακας Συσχετίσεων όλων των numerical μεταβλητών
numeric_data <- studentTable %>% select(where(is.numeric)) # Select only numeric columns
student_numeric_data <- cor(numeric_data, use = "complete.obs")
corrplot(student_numeric_data, method = "color", addCoef.col = "black", type = "upper",
tl.col = "black", tl.srt = 45)
cor(studentTable$study_hours_per_day,studentTable$exam_score)
## [1] 0.8254185
cor(studentTable$social_media_hours,studentTable$exam_score)
## [1] -0.1667329
cor(studentTable$mental_health_rating,studentTable$exam_score)
## [1] 0.3215229
Σχολιασμός
# Scatterplot
scatter <- ggplot(data = studentTable, aes(x = study_hours_per_day, y = exam_score)) +
geom_point(color = "firebrick", size = 3, alpha = 0.7) +
labs(
title = "Exam score based on Study hours per day",
color = "Exam Score"
) +
theme_classic()
scatter
## Ignoring unknown labels:
## • colour : "Exam Score"
# 1. Δημιουργεί 2 groups με βάση τον βαθμό της ψυχικής υγείας.
boxplot_data <- studentTable %>%
mutate(mental_health_group = ifelse(mental_health_rating < 5,
"Below 5 (Struggling)",
"5 and Above (Stable)"))
# 2. Create the boxplot
boxplot_mental_health <- ggplot(boxplot_data, aes(x = mental_health_group, y = exam_score, fill = mental_health_group)) +
geom_boxplot(alpha = 0.7, width = 0.6) +
geom_jitter(width = 0.2, alpha = 0.3) + # Adds individual student dots to see the sample size
scale_fill_manual(values = c("Λιγότερο απο 5 (Δυσκολία)" = "#f8766d",
"5 και άνω (Σταθερότητα)" = "#00bfc4")) +
labs(
title = "Επίδοση στις Εξετάσεις με βάση την Ψυχική Υγεία",
subtitle = "Σύγκριση Βαθμολογιών με βάση την ψυχική υγεία 1-10 rating",
x = "Ψυχική Υγεία",
y = "Βαθμολογία (%)",
fill = "Category"
) +
theme_minimal() +
theme(legend.position = "none") # Legend is redundant here since x-axis is labeled
boxplot_mental_health
## Warning: No shared levels found between `names(values)` of the manual scale and the
## data's fill values.
## No shared levels found between `names(values)` of the manual scale and the
## data's fill values.
## No shared levels found between `names(values)` of the manual scale and the
## data's fill values.
Σχολιασμός Παρατηρούμε πως οι μαθητές με ψυχική υγεία που είναι πιο υγιείς (5+) σημειώνουν μέσο όρο στην βαθμολογία των εξετάσεων (~75) ενώ οι μαθητές που δυσκολεύονται ψυχικά σημειώνουν ~62.
#Step 4 A histogram for the exam_scores
score_hist <- ggplot(data = studentTable, aes(x = exam_score)) +
geom_histogram(binwidth = 5, fill = "#3498DB", color = "white") +
stat_bin(binwidth = 5, geom = "text", aes(label = after_stat(count)),
vjust = -0.5, size = 3.5) +
labs(
title = "Κατανομή Βαθμολογίας Μαθητών",
x = "Βαθμολογία",
y = "Πλήθος Μαθητών"
) +
theme_minimal()
score_hist
Σχολιασμός Παρατηρούμε πως περίπου το 30% των μαθητων (300+ μαθητές) έγραψαν μεταξύ 62 και 75 στις εξετάσεις.
#Step 5 Ιστόγραμμα μεταξύ μαθητών που πέρασαν/κόπηκαν στις εξετάσεις
studentTable$status <- ifelse(studentTable$exam_score >= 50,
"Επιτυχία",
"Αποτυχία")
bar_chart <- ggplot(data = studentTable, aes(x = status)) +
geom_bar(fill = "steelblue", color = "white") +
geom_text(stat = 'count', aes(label = after_stat(count)), vjust = -0.5) +
labs(
title = "Ραβδόγραμμα - Μαθητές που έγραψαν 50% και άνω",
x = "Αποτελέσματα Μαθητών",
y = "Αριθμός Μαθητών"
) + theme_minimal()
bar_chart
Σχολιασμός Παρατηρούμε πως πάνω απο το ~87% των μαθητών πέρασαν με προβιβάσιμο βαθμό στις εξετάσεις (50+ ελάχιστος βαθμός).