[HW4] Ryski Adam

homeworks/hw4/RyskiAdam/homework04.Rmd

@@ -0,0 +1,153 @@
+---
+title: "Praca domowa 4"
+author: "Adam Ryski"
+date: "2024-12-12"
+output:
+  html_document:
+    toc: true
+    toc_float: true
+    code_folding: hide
+    theme: united
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+library(dplyr)
+library(ggplot2)
+library(readxl)
+library(tidyr)
+```
+### Moc geografii
+Przedmiotem tej analizy jest spojrzenie na wpływ geografii na opuszczanie noworodków w szpitalu przez biologicznych rodziców, oraz wychowywanie dzieci w pieczy zastępczej, tj. w rodzinach zastępczych i domach dziecka. Zjawiska zachodzące na jakimś terenie geograficznym oczywiście, czasem wynikają stricte z samej lokalizacji, ale w przypadku większości zjawisk socjologicznych można śmiało stwierdzić, że są one często wynikiem historii tych miejsc. Lata decyzji podejmowanych na danym obszarze nawet setki lat temu często kształtują życie aktualnych pokoleń.
+
+
+### Wpływ zaborów na pozostawianie dzieci
+Często można w internecie spotkać wizualizacje pokazujące istotne różnice w dzisiejszym funkcjonowaniu naszego społeczeństwa na mapie Polski podzielonej według granic administracyjnych dawnych zaborów. Jak widać na poniższym wykresie różnicę można zauważyć nawet w tak wydawałoby się nie związnym granicami zagadnieniem jak pozostawianie dzieci. Niestety ze względu na ograniczone dane na wykresie zostało zastosowane uproszczenie. To jest za zabór rosyjski uznano województwa: mazowieckie, podlaskie, świętokrzyskie, lubelskie, oraz łódzkie. Za zabór austro-węgierski małopolskie i podkarpackie. Natomiast dane z reszty województw przypisano zaborowi Pruskiemu. Oczywiście dawne granice przebiegały nieco inaczej ale do wstępnej analizy przybliżenie można uznać za wystarczające do stwierdzenia, że aktualnie bogatsze województwa, niegdyś będące pod zaborem Pruskim, wcale nie cieszą się niską liczbą pozostawień, a wręcz przeciwnie.
+
+```{r wykres 1, message=FALSE, warning = FALSE}
+a <- read_excel("Noworodki pozostawione w szpitalu 2007-2023.xlsx")
+a2 <- na.omit(a)
+x <- a2[1,]
+colnames(a2) <- substr(x, nchar(x) - 3, nchar(x))
+colnames(a2)[1] <- "Województwo"
+a3 <- a2[-1,]
+a4 <- pivot_longer(a3, cols= !"Województwo")
+colnames(a4) <- c("Województwo", "Rok", "Liczba pozostawień")
+a5 <- a4 %>% mutate(Rok = as.integer(Rok))
+
+b <- read_excel("Urodzenia żywe w Polsce 2007-2023.xlsx")
+b2 <- pivot_longer(b, cols= !"Województwo")
+colnames(b2) <- c("Województwo", "Rok", "Liczba urodzeń")
+b3 <- b2 %>% mutate(Rok = as.integer(Rok), Województwo = ifelse(Województwo == "POLSKA", "Polska", Województwo))
+
+result <- b3 %>% left_join(a5, join_by("Województwo", "Rok",))
+result$zabory = ifelse(result$Województwo %in% c("mazowieckie", "podlaskie", "świętokrzyskie", "lubelskie", "łódzkie"), "Rosyjski", ifelse(result$Województwo %in% c("małopolskie", "podkarpackie"), "Austro-Węgierski", ifelse(result$Województwo %in% c("Polska"),"Polska", "Purski")))
+result$`Liczba pozostawień` = as.double(result$`Liczba pozostawień`)
+result$`Liczba urodzeń` = as.double(result$`Liczba urodzeń`)
+result$`Promil pozostawień` = result$`Liczba pozostawień` / result$`Liczba urodzeń` * 1000
+result <- result %>% filter(`Województwo` != "Polska")
+
+ggplot() + 
+  scale_y_continuous(expand = c(0,0, 0.01, 0)) +
+  theme(axis.text.x = element_text(angle = 60, vjust = 0.5)) +
+  scale_x_continuous(labels = as.character(result$Rok), breaks = result$Rok, expand = c(0.01,0, 0.01, 0)) +
+  theme(text = element_text(size = 10),
+        axis.text.x = element_text(hjust = 0.5, size = 9),
+        axis.text.y = element_text(hjust = 0.5, size = 10)) +
+  labs(y = "Promil pozostawień", x = "Rok", fill = "Były zabór:",
+       title = "Promil noworodków pozostawionych w szpitalu z wszystkich żywych urodzeń",
+       subtitle = "z podziałem na zabory\n(pozostawienia wynikają nie ze względów zdrowotnych)") +
+  geom_bar(data = result , aes(x = Rok, y = `Promil pozostawień`, group = zabory, fill = zabory), 
+           width = 0.6, stat="identity", position = position_dodge(width=0.7)) +
+  scale_fill_manual(values = c("#315ca8",  "#e4007e","#884292"))
+```
+
+### Kto pomaga większości wychowankom?
+Jak widać na załączonym wykresie w Polsce, zdecydowana większość wychowanków przypada pieczy rodzinnej. Udział pieczy rodzinnej pozostaje dominujący i niezachwiany od lat. Natomiast w ujęciu ogólnopolskim ciężko mówić o tym, że na przestrzeni ostatnich lat doszło do zmian w tym obszarze. Rola obu rodzajów pieczy pozostaje niezmienna od lat i nie mamy do czynienia z wyraźnymi trendami, które mogłyby zachwiać istniejącą równowagę.
+
+```{r wykres 2, message=FALSE, warning = FALSE}
+a <- read_excel("Wychowankowie (0-24 lata) w pieczy zastępczej 2014-2023.xlsx", sheet = "Wychowankowie instytucjonalnej ")
+colnames(a)[1] <- "Województwo"
+a2 <- pivot_longer(a, cols= !"Województwo")
+colnames(a2) <- c("Województwo", "Rok", "Liczba wychowanków")
+a2$instytucjonalna = c("instytucjonalna")
+
+b <- read_excel("Wychowankowie (0-24 lata) w pieczy zastępczej 2014-2023.xlsx", sheet = "Wychowankowie rodzinnej pieczy ")
+colnames(b)[1] <- "Województwo"
+b2 <- pivot_longer(b, cols= !"Województwo")
+colnames(b2) <- c("Województwo", "Rok", "Liczba wychowanków")
+b2$instytucjonalna = c("rodzinna")
+
+result <- rbind(a2, b2)
+result2 <- result %>% mutate(Rok = as.integer(Rok))
+
+result3 <- result2 %>% filter(Województwo == "POLSKA")
+
+result3$Rok <- as.character(result3$Rok)
+
+ggplot(result3, aes(x = Rok, weight=`Liczba wychowanków`, fill = instytucjonalna, group = instytucjonalna)) +
+  labs(y = "Procentowy udział danej pieczy w wychowankach", 
+       x = "Rok", 
+       fill = "Piecza:",
+       title = "Udział pieczy rodzinnej w wychowankach",
+       subtitle = "Na przestrzeni lat",
+       ) + 
+  scale_fill_manual(values = c("#ea4f7f", "#303174")) +
+  geom_bar(stat = "count", position = "fill") +
+  scale_y_continuous(expand = c(0,0, 0.02, 0)) +
+  theme(axis.text.x = element_text(angle = 60, vjust = 0.5)) +
+  theme(text = element_text(size = 10), axis.text.x = element_text(hjust = 0.5, size = 9), axis.text.y = element_text(hjust = 0.5, size = 10)) 
+
+```
+
+### Popularność pieczy rodzinnej w zależności od województwa
+Czy to przypadek, że trzy najniższe wartości odsetka udziału pieczy rodzinnej w wychowankach są najniższe w aż 3 województwach, które w pierwszym wykresie przypisaliśmy do zaboru Rosyjskiego? Być może ale wykres wydaje się sugerować, że warto sprawdzić popularność pieczy rodzinnej w zależności od zamożności województwa co mam nadzieje będzie miał ktoś jeszcze okazję porównać w kolenych analizach.
+
+```{r wykres 3, message=FALSE, warning = FALSE}
+a <- read_excel("Wychowankowie (0-24 lata) w pieczy zastępczej 2014-2023.xlsx", sheet = "Wychowankowie instytucjonalnej ")
+colnames(a)[1] <- "Województwo"
+a2 <- pivot_longer(a, cols= !"Województwo")
+colnames(a2) <- c("Województwo", "Rok", "Liczba wychowanków")
+a2$instytucjonalna = c("instytucjonalna")
+
+b <- read_excel("Wychowankowie (0-24 lata) w pieczy zastępczej 2014-2023.xlsx", sheet = "Wychowankowie rodzinnej pieczy ")
+colnames(b)[1] <- "Województwo"
+b2 <- pivot_longer(b, cols= !"Województwo")
+colnames(b2) <- c("Województwo", "Rok", "Liczba wychowanków")
+b2$instytucjonalna = c("rodzinna")
+
+result <- rbind(a2, b2)
+result2 <- result %>% mutate(Rok = as.integer(Rok))
+
+result3 <- result2 %>% group_by(Województwo, instytucjonalna) %>% summarise(liczba = sum(`Liczba wychowanków`))
+
+totals1 <- result3 %>% group_by(Województwo) %>% summarise(total = sum(liczba)) 
+rodzinna1 <- result3 %>% filter(instytucjonalna == "rodzinna") %>% select(Województwo, liczba)
+rodzinna1 <- rodzinna1 %>% left_join(totals1)
+rodzinna1$procent <- rodzinna1$liczba / rodzinna1$total
+
+woj <- rodzinna1 %>% arrange(procent) %>% select(Województwo)
+woj$order <- rep(1:nrow(woj))
+
+result4 <- result3 %>% left_join(woj)
+
+result5 <- result4 %>% arrange(order)
+
+
+ggplot(result5, aes(x = reorder(Województwo, order), weight=liczba, fill = instytucjonalna, group = instytucjonalna)) +
+  labs(y = "Procentowy udział danej pieczy w wychowankach", 
+       x = "Województwo", 
+       fill = "Piecza:",
+       title = "Udział pieczy rodzinnej w wychowankach",
+       subtitle = "W podziale na województwa"
+       ) + 
+  scale_fill_manual(values = c("#ea4f7f", "#303174")) +
+  geom_bar(stat = "count", position = "fill") +
+  scale_y_continuous(expand = c(0,0, 0.02, 0)) +
+  theme(axis.text.x = element_text(angle = 60, vjust = 0.5)) +
+  theme(text = element_text(size = 10), axis.text.x = element_text(hjust = 0.5, size = 9), axis.text.y = element_text(hjust = 0.5, size = 10)) 
+```
+
+### Podsumowanie
+Zaskakujące było dla mnie jak duży udział w pieczy ma piecza rodzinna. Aczkolwiek moim zdaniem jest to zgodne z duchem samoorganizacji Polaków w trudnych sytuacjach. Ciekawe natomiast jest dla mnie to, że teoretycznie bogatsze województwa cieszą się wyższymi odsetkami pozostawień, aczkolwiek również wyższymi odsetkami organizacji pieczy rodzinnej, która jednak wydaje się wymaga od jednostek więcej środków i zaangażowania.
+