3. úkol 4EK418

library(RCzechia)
library(ggplot2)
library(dplyr)
library(rmarkdown)

# census 1980
okresy_1980 <- RCzechia::historie("okresy_1980") %>% 
  mutate(duchodci_80 = `obyvatelstvo celkem 65+`,
         obyvatele_80 = `počet obyvatel přítomných`) %>%
  select(duchodci_80, obyvatele_80) %>%
  st_transform(5514)

# náhled na strukturu
glimpse(okresy_1980)

Rows: 76
Columns: 3
$ duchodci_80  <int> 197084, 13770, 12460, 21864, 16420, 13617, 13317, 16619, …
$ obyvatele_80 <int> 1163430, 90402, 78304, 152848, 96419, 81348, 98141, 11422…
$ geometry     <MULTIPOLYGON [m]> MULTIPOLYGON (((-733748.6 -..., MULTIPOLYGON…

# census 1930
okresy_1930 <- RCzechia::historie("okresy_1930") %>% 
  mutate(nemci_30 = `národnost německá`,
         duchodci_30 = `obyvatelstvo celkem věk 65+`,
         obyvatele_30 = `počet obyvatel přítomných`) %>%
  select(nemci_30, duchodci_30, obyvatele_30) %>%
  st_transform(5514)

# náhled na strukturu
glimpse(okresy_1930)

Rows: 330
Columns: 4
$ nemci_30     <int> 12543, 8924, 7374, 57732, 45, 39355, 77, 24889, 9177, 97,…
$ duchodci_30  <int> 1052, 1466, 788, 3224, 2144, 2183, 2341, 2187, 771, 1812,…
$ obyvatele_30 <int> 14885, 22710, 7567, 61629, 24912, 40795, 28675, 27486, 95…
$ geometry     <MULTIPOLYGON [m]> MULTIPOLYGON (((-489265.5 -..., MULTIPOLYGON…

# obrázek 1980
ggplot() +
  geom_sf(data = okresy_1980, color = NA, aes(fill = duchodci_80 / obyvatele_80)) +
  scale_fill_viridis_c(limits = c(0, .2),
                       option = "magma",
                       direction = -1,
                       na.value = "grey75",
                       labels = scales::label_percent()) +
  labs(title = "Důchodci 1980",
       fill =  "% z celku") +
  theme_minimal()

# obrázek 1930
ggplot() +
  geom_sf(data = okresy_1930, color = NA, aes(fill = duchodci_30 / obyvatele_30)) +
  scale_fill_viridis_c(limits = c(0, .2),
                       option = "magma",
                       direction = -1,
                       na.value = "grey75",
                       labels = scales::label_percent()) +
  labs(title = "Důchodci 1930",
       fill =  "% z celku") +
  theme_minimal()

# měření přenášená metrika, zda se výrazně liší počet 
# obyvatelů při změně okresů

obyv <- st_interpolate_aw(x = okresy_1930,
                           to = st_geometry(okresy_1980),
                           extensive = T)


okresy_1980$obyv_inter <- obyv$obyvatele_30


print(cor(okresy_1980$obyvatele_80,
    okresy_1980$obyv_inter))

[1] 0.9387087

# výsledek je blízko 1, to znamená, že rozdíly nejsou příliš velké 
# a můžeme pokračovat na analýze hypotéz


# hypotéza modrých zón

podklad <- okresy_1980 %>% 
  mutate(pct30 = obyv$duchodci_30/obyv$obyvatele_30,
         pct80 = okresy_1980$duchodci_80/okresy_1980$obyvatele_80)

modry <- lm(data = podklad,
             pct30 ~ pct80)


# hypotéza Postupim

postupim <- okresy_1980 %>% 
  mutate(
  pct_nem = obyv$nemci_30/obyv$obyvatele_30,
  pct_80 = okresy_1980$duchodci_80/okresy_1980$obyvatele_80) %>% 
  st_drop_geometry()

podpos <- lm(data = postupim,
             pct_nem ~ pct_80)


summary(podpos)

Call:
lm(formula = pct_nem ~ pct_80, data = postupim)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.54685 -0.14546  0.02973  0.16620  0.38368 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   1.5966     0.1296   12.31  < 2e-16 ***
pct_80       -9.8206     0.9454  -10.39  4.2e-16 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.2081 on 74 degrees of freedom
Multiple R-squared:  0.5932,    Adjusted R-squared:  0.5877 
F-statistic: 107.9 on 1 and 74 DF,  p-value: 4.197e-16

summary(modry)

Call:
lm(formula = pct30 ~ pct80, data = podklad)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.035516 -0.006844  0.001316  0.009000  0.019103 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.055803   0.007505   7.435  1.5e-10 ***
pct80       0.117811   0.054727   2.153   0.0346 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.01204 on 74 degrees of freedom
Multiple R-squared:  0.05893,   Adjusted R-squared:  0.04622 
F-statistic: 4.634 on 1 and 74 DF,  p-value: 0.0346

# Nezávislá proměnná u hypotézy Postupim je více statisticky významný než 
# u hypotézy Modrých zón. Dále Postupim je schopen vysvětlit téměř 60 % pozorování, 
# Modrých zón jen 6 %. Hypotéza postupim je statisticky významněji než Modrých 
# zón, takže Postupim lépe vysvětluje naše situace.