Internet w szkole to nie tylko lekcje i e-dziennik, ale też codzienna „walka” z różnymi zagrożeniami w tle. W tym raporcie analizujemy naruszenia wykryte w szkolnych sieciach. Sprawdzamy, w których województwach takich zdarzeń było najwięcej oraz jakie kategorie naruszeń dominowały.
W raporcie użyto zestawienia naruszeń rejestrowanych w okresie 17.12-31.12.25 przez system bezpieczeństwa Ogólnopolskiej Sieci Edukacyjnej NASK określany jako B3, który analizuje ruch sieciowy i generuje raporty o próbach dostępu do treści potencjalnie szkodliwych. Dane te są istotne, ponieważ obejmują realne zdarzenia wykryte w szkolnych sieciach w całej Polsce, pozwalają porównać skalę i strukturę naruszeń między regionami oraz wskazać kategorie wymagające największej uwagi profilaktycznej i technicznej. Analiza korelacji między kategoriami pomaga też zrozumieć, które typy naruszeń mogą występować wspólnie, co jest wskazówką przy planowaniu działań ochronnych i edukacyjnych w szkołach.
library(dplyr)
library(readr)
library(ggplot2)
library(tidyr)
library(stringr)
library(treemap)
library(corrgram)
library(DT)
library(corrplot)
library(rsconnect)
library(scales)
library(treemapify)
df <- read_delim(
"dane/analiza_dzienna_szkol_z_kategoriami_17.12.2025-31.12.2025.csv",
delim = ";",
col_types = cols(rspo = col_character())
)
cat_cols <- names(df)[grepl("^rodzaj", names(df))]
| Element | Wartość |
|---|---|
| Liczba wierszy | 15792 |
| Liczba szkół | 6685 |
| Liczba województw | 17 |
| Zakres dat | 2025-12-17 - 2025-12-30 |
| voivodeship | naruszenia | szkoly | udzial_procentowy |
|---|---|---|---|
| mazowieckie | 14258 | 920 | 14.19 |
| malopolskie | 10270 | 694 | 10.22 |
| lodzkie | 9112 | 539 | 9.07 |
| lubelskie | 8864 | 530 | 8.82 |
| kujawsko-pomorskie | 6993 | 417 | 6.96 |
| swietokrzyskie | 6828 | 335 | 6.80 |
| podkarpackie | 6128 | 424 | 6.10 |
| pomorskie | 5922 | 360 | 5.89 |
| dolnoslaskie | 5739 | 429 | 5.71 |
| slaskie | 5309 | 522 | 5.28 |
| warminsko-mazurskie | 4510 | 311 | 4.49 |
| zachodniopomorskie | 4226 | 214 | 4.21 |
| wielkopolskie | 3846 | 341 | 3.83 |
| opolskie | 3134 | 225 | 3.12 |
| podlaskie | 2983 | 212 | 2.97 |
| lubuskie | 2328 | 209 | 2.32 |
| NA | 13 | 3 | 0.01 |
Z których województw pochodzi najwięcej naruszeń?
woj_pct <- df %>%
filter(!is.na(voivodeship)) %>%
group_by(voivodeship) %>%
summarise(naruszenia = sum(total_naruszenia, na.rm = TRUE), .groups = "drop") %>%
mutate(procent = naruszenia / sum(naruszenia)) %>%
arrange(desc(procent)) %>%
mutate(voivodeship = factor(voivodeship, levels = voivodeship))
ggplot(woj_pct, aes(x = voivodeship, y = procent)) +
geom_col(fill = "#2C7FB8") +
coord_flip() +
scale_y_continuous(labels = percent_format(accuracy = 0.1),
expand = expansion(mult = c(0, 0.15))) +
geom_text(aes(label = percent(procent, accuracy = 0.1)),
hjust = -0.05, size = 3) +
labs(title = "Udział województw w naruszeniach w Polsce",
x = "Województwo", y = "Udział (%)") +
theme_minimal()
Jaki procent wszystkich naruszeń w danym województwie stanowią poszczególne naruszenia?
df_long <- df %>%
mutate(voivodeship = trimws(voivodeship)) %>%
select(voivodeship, starts_with("rodzaj_")) %>%
pivot_longer(starts_with("rodzaj_"), names_to = "rodzaj", values_to = "liczba") %>%
mutate(liczba = parse_number(as.character(liczba))) %>%
group_by(voivodeship, rodzaj) %>%
summarise(suma = sum(liczba, na.rm = TRUE), .groups = "drop")
plot_df <- df_long %>%
group_by(voivodeship) %>%
mutate(
procent = suma / sum(suma),
lab = ifelse(procent >= 0.05, percent(procent, accuracy = 1), "")
) %>%
ungroup()
ggplot(plot_df, aes(x = voivodeship, y = procent, fill = rodzaj)) +
geom_col() +
geom_text(aes(label = lab), position = position_stack(vjust = 0.5), size = 3) +
scale_y_continuous(labels = label_percent(accuracy = 1)) +
labs(
title = "Struktura rodzajów naruszeń (100%) w województwach",
x = "Województwo",
y = "Udział (%)",
fill = "Rodzaj naruszenia"
) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
naruszenia_suma <- df %>%
pivot_longer(cols = all_of(cat_cols), names_to = "kategoria", values_to = "liczba") %>%
group_by(kategoria) %>%
summarise(liczba = sum(liczba, na.rm = TRUE), .groups = "drop") %>%
arrange(desc(liczba)) %>%
mutate(kategoria_skrocona = str_replace(kategoria, "^rodzaj_", "") %>%
str_replace_all("_", " "))
ggplot(naruszenia_suma, aes(area = liczba, fill = liczba, label = kategoria_skrocona)) +
geom_treemap(color = "white", size = 1.5) +
geom_treemap_text(
fontface = "bold",
colour = "white",
place = "centre",
size = 10,
reflow = TRUE
) +
scale_fill_gradient(low = "#FEE5D9", high = "#A50F15") +
labs(
title = "Najczęściej występujące naruszenia w Polsce",
fill = "Liczba"
) +
theme_void() + theme_minimal() +
theme(
legend.position = "right",
plot.title = element_text(size = 16, hjust = 0.5),
plot.subtitle = element_text(size = 12, color = "gray50", hjust = 0.5)
)
Jaki jest trend w okresie badań? Czy naruszenia rosną czy maleją? Metoda LOESS działa na zasadzie dopasowania małych linii do małych okien danych i przesunięcie ich wzdłuż całego wykresu, tworząc gładką krzywą.
library(dplyr)
library(ggplot2)
df %>%
group_by(date) %>%
summarise(total = sum(total_naruszenia, na.rm = TRUE), .groups = "drop") %>%
arrange(date) %>%
mutate(day_num = row_number()) %>%
ggplot(aes(x = day_num, y = total)) +
geom_line(color = "#A50F15", linewidth = 1, alpha = 0.6) +
geom_point(color = "#A50F15", size = 2) +
geom_smooth(method = "loess", span = 0.3, color = "darkred", fill = "#FEE5D9", se = TRUE) +
scale_x_continuous(
breaks = seq(1, 14, 1),
labels = format(sort(unique(df$date)), "%d.%m")
) +
labs(
title = "Trend naruszeń w okresie 17-30 grudnia",
subtitle = "Linia gładka pokazuje ogólny trend",
x = "Data",
y = "Suma naruszeń"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 14),
axis.text.x = element_text(angle = 45, hjust = 1)
)
Do standaryzacji danych, używamy metody z-score, która mierzy ile odchyleń standardowych od średniej znajduje się nasz wynik.
Gdzie x - wartość pojedynczej obserwacji, \(\mu\) - średnia arytmetyczna wszystkich wartości w zbiorze danych \(\sigma\) - odchylenie standardowe zbioru danych
df_standaryzowany <- df %>%
mutate(
total_naruszenia_zscore = scale(total_naruszenia)[,1],
)
head(df_standaryzowany %>% select(date, city, total_naruszenia, total_naruszenia_zscore), 10)
## # A tibble: 10 × 4
## date city total_naruszenia total_naruszenia_zscore
## <date> <chr> <dbl> <dbl>
## 1 2025-12-17 sulechow 4 -0.127
## 2 2025-12-17 legnica 5 -0.0732
## 3 2025-12-17 kalisz 1 -0.288
## 4 2025-12-17 lechow 1 -0.288
## 5 2025-12-17 bolewice 1 -0.288
## 6 2025-12-17 gdansk 2 -0.234
## 7 2025-12-17 kalety 53 2.51
## 8 2025-12-17 dlugie 2 -0.234
## 9 2025-12-17 rozyca 1 -0.288
## 10 2025-12-17 wielun 1 -0.288
Teoretycznie nie możemy sprawdzić korelacji nie wiedząc, czy nasze dane wykazują rozkład normalny, dlatego wybierzemy na podstawie tego wykresu trzy kategorie, których normalność sprawdzimy.
# Kategorie
top_10_cat <- df %>%
pivot_longer(cols = all_of(cat_cols), names_to = "kat", values_to = "val") %>%
group_by(kat) %>%
summarise(total = sum(val, na.rm = TRUE), .groups = "drop") %>%
arrange(desc(total)) %>%
slice_head(n = 10) %>%
pull(kat)
# Korelacja
korelacja_macierz <- df %>%
select(all_of(top_10_cat)) %>%
cor(use = "complete.obs")
colnames(korelacja_macierz) <- str_replace(colnames(korelacja_macierz), "^rodzaj_", "") %>%
str_replace_all("_", " ")
rownames(korelacja_macierz) <- colnames(korelacja_macierz)
# Heatmapa korelacji
corrplot(korelacja_macierz,
method = "color",
type = "lower",
diag = TRUE,
addCoef.col = "black", # ← CZARNY TEKST
number.cex = 0.75,
col = colorRampPalette(c("white", "#FEE5D9", "#A50F15"))(50),
tl.col = "black", # ← CZARNY TEKST NA OSIACH
tl.srt = 90,
mar = c(1, 1, 1, 1))
Chcę przeprowadzić test normalności Shapiro-Wilka dla sextingu, childgroomingu i cyberprzemocy. Dane muszą mieścić się w przedziale 3-5000. Nasza próbka jest za duża, dlatego losuję próbkę.
cat("=== TEST SHAPIRO-WILKA ===\n")
## === TEST SHAPIRO-WILKA ===
cat("(H0: dane mają rozkład normalny; p < 0.05 = odrzucamy H0)\n")
## (H0: dane mają rozkład normalny; p < 0.05 = odrzucamy H0)
cat("(Próbka: 5000 losowych obserwacji)\n\n")
## (Próbka: 5000 losowych obserwacji)
# Losowa próbka 5000
set.seed(123)
indeksy <- sample(1:nrow(df), min(5000, nrow(df)))
# Sexting
sexting_data <- df$rodzaj_sexting[indeksy]
test_sexting <- shapiro.test(sexting_data)
cat("SEXTING\n")
## SEXTING
cat("p-value:", round(test_sexting$p.value, 6), "\n")
## p-value: 0
if (test_sexting$p.value < 0.05) cat("Rozkład NIENORMALNY\n\n") else cat("Rozkład normalny\n\n")
## Rozkład NIENORMALNY
# Childgrooming
childgrooming_data <- df$rodzaj_childgrooming[indeksy]
test_childgrooming <- shapiro.test(childgrooming_data)
cat("CHILDGROOMING\n")
## CHILDGROOMING
cat("p-value:", round(test_childgrooming$p.value, 6), "\n")
## p-value: 0
if (test_childgrooming$p.value < 0.05) cat("Rozkład NIENORMALNY\n\n") else cat("Rozkład normalny\n\n")
## Rozkład NIENORMALNY
# Cyberprzemoc
cyberprzemoc_data <- df$rodzaj_cyberprzemoc[indeksy]
test_cyberprzemoc <- shapiro.test(cyberprzemoc_data)
cat("CYBERPRZEMOC\n")
## CYBERPRZEMOC
cat("p-value:", round(test_cyberprzemoc$p.value, 6), "\n")
## p-value: 0
if (test_cyberprzemoc$p.value < 0.05) cat("Rozkład NIENORMALNY\n\n") else cat("Rozkład normalny\n\n")
## Rozkład NIENORMALNY
# Podsumowanie
cat("=== WNIOSEK ===\n")
## === WNIOSEK ===
cat("Jeśli wszystkie p-value < 0.05 → dane są nienormalne\n")
## Jeśli wszystkie p-value < 0.05 → dane są nienormalne
cat("Używam korelacji SPEARMANA zamiast Pearsona\n")
## Używam korelacji SPEARMANA zamiast Pearsona
Z powyższych wynika, że nie mogę przeprowadzić korelacji Pearsona, dlatego przeprowadzam korelację Spearmana.
Korelacja Spearmana mierzy siłę związku między dwiema zmiennymi na podstawie ich rang, a nie surowych wartości. Zamienia wartości na rangi (1 = najmniejsza, n = największa), potem liczy korelację tych rang. Używa się go, gdy dane nie są normalne, są mierzone na zmiennych porządkowych lub obserwowany jest związek nieliniowy.
# Wybrane trzy kategorie
pary_korelacja <- df %>%
select(rodzaj_sexting, rodzaj_childgrooming, rodzaj_cyberprzemoc) %>%
cor(use = "complete.obs", method = "spearman")
# Zmiana nazw
colnames(pary_korelacja) <- c("sexting", "childgrooming", "cyberprzemoc")
rownames(pary_korelacja) <- c("sexting", "childgrooming", "cyberprzemoc")
# Wykresik
corrplot(pary_korelacja,
method = "color",
type = "lower",
diag = TRUE,
addCoef.col = "black",
number.cex = 1,
col = colorRampPalette(c("white", "#FEE5D9", "#A50F15"))(50),
tl.col = "black",
tl.srt = 0,
mar = c(3, 3, 3, 3),
title = "Korelacja Spearmana: sexting, childgrooming, cyberprzemoc")
Analiza statystyczna wykazała średnią/małą korelację między cyberprzemocą a sextingiem (r_s = 0.15) oraz średnią korelację między cyberprzemocą a child-groomingiem (r_s = 0.26). Na szczególną uwagę zasługuje korelacja między child-groomingiem a sextingiem (r_s = 0.39). Może ona sugerować, że child-grooming stanowi etap wstępny do sextingu.