Informatyka ekonomiczna (kierunek informatyka i ekonometria) - laboratorium 9 i 10

Przekształanie danych i rysowanie map ilustrująych dane

¹ Zakład Bioinformatyki, Instytut Informatyki, Uniwersytet w Białymstoku

^✉ Correspondence: Jarosław Kotowicz <j.kotowicz@uwb.edu.pl>

1 Zajęcia grupa 2

1.1 Czyszczeni środowiska

rm(list = ls())

1.2 Podczytanie bibliotek

library(tidyverse)
library(readxl)

1.3 Podczytanie danych pobranych z bdl GUS

mieszkania <- read_excel("GOSP_2909_XPIV_20200428091111.xlsx", 
                         sheet = "DANE")
mieszkania <- mieszkania[,-c(6:7)]

library(tidyverse)

1.4 Określenie kodu na województwa podlaskiego

mieszkania[which(str_detect(mieszkania$Nazwa, "Białystok")),]

1.5 Przekształcenia danych

1.5.1 Tworzenie nowych zmiennych związanych z kodem jednostki i nazwy

m_podlaskie <- mieszkania %>%
  filter(str_sub(Kod, start = 1, end = 2) == "20") %>%
  mutate(Kod.Gminy = str_sub(Kod, start = 1, end = 6),
         Typ.Gminy = str_sub(Kod, start = 7, end = 7),
         Nazwa.Oryginalna = Nazwa)

1.5.2 Dalsze zmiany np. zamiana kodu rodzaju gminy na nazwę

m_podlaskie_gm <- m_podlaskie %>%
  filter(Typ.Gminy %in% c(1:3)) %>%
  mutate(Typ.Gminy = str_replace(Typ.Gminy, "1", "miejska"),
         Typ.Gminy = str_replace(Typ.Gminy, "2", "wiejska"),
         Typ.Gminy = str_replace(Typ.Gminy, "3", "miejsko-wiejska"),
         Nazwa = trimws(str_remove_all(Nazwa, "[[:punct:]]\\d[[:punct:]]"))) %>%
  arrange(Nazwa, Typ.Gminy)

1.5.3 Wskazanie gmin wiejskich o identycznych nazwach, jak gminy miejskie np. Augustów

m_podlaskie_s <- m_podlaskie_gm %>%
  group_by(Nazwa) %>%
  summarise(m_w = n())

m_podlaskie_gm <- m_podlaskie_s %>%
  left_join(m_podlaskie_gm) %>%
  ungroup() %>%
  mutate(Typ.Gminy.Nowy = ifelse(m_w == 2 & Typ.Gminy == "wiejska", "(rural)", ""),
         Nazwa = trimws(paste0(Nazwa, " ", Typ.Gminy.Nowy)))  %>%
  select(Nazwa, Nazwa.Oryginalna, Kod, Kod.Gminy, Typ.Gminy, Wartosc)

Joining, by = "Nazwa"

colnames(m_podlaskie_gm)[length(m_podlaskie_gm)] <- "2017.Budynki.Mieszkalne"

1.6 Podczytanie konturów

library(sf)

gadm_3sf <- readRDS("dane/gadm36_POL_3_sf.rds")

g_podlaskie <- gadm_3sf %>%
  filter(NAME_1 == "Podlaskie") %>%
  arrange(NAME_3)

1.7 Łącznie danych z bdl i konturów

m_podlaskie_gm <- m_podlaskie_gm %>%
  mutate(NAME_3 = g_podlaskie$NAME_3)

1.8 Ilustracja graficzna danych na mapie

g_podlaskie %>%
  left_join(m_podlaskie_gm) %>% 
  ggplot() +
  geom_sf(aes(fill = `2017.Budynki.Mieszkalne`)) +
  scale_fill_gradient(low = "navajowhite", high = "navajowhite4") +
  theme_bw() +
  theme(axis.line = element_blank(), 
        panel.border = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major = element_blank(), 
        plot.title = element_text(hjust = 0.5, size = rel(1.2))) +
  labs(title = "Liczba budunków mieszkanych w gminach województwa podlaskiego",
       subtitle = "Stan na 31.12.2017r.",
       caption = "Źródło: opracowanie własne na podstawie danych z bdl GUS.")

Joining, by = "NAME_3"

2 Zajęcia grupa 1

2.1 Podczytanie danych

mieszkania <- read_excel("dane/GOSP_2909_XPIV_20200428103913.xlsx", 
                         sheet = "DANE")
mieszkania <- mieszkania[,-c(6,7)]

mieszkania <- mieszkania %>%
  mutate(Nazwa.old = Nazwa) %>%
  select(Kod:Nazwa, Nazwa.old, `Budynki mieszkalne`:Wartosc )
mieszkania[which(str_detect(mieszkania$Nazwa, "Białystok")),]

sum(str_detect(mieszkania$Kod, "20"))

[1] 102

mieszkania_podlaskie <- mieszkania %>%
  filter(str_sub(Kod, start = 1, end = 2) == "20")

gadm_2sf <- readRDS("dane/gadm36_POL_2_sf.rds")

names(gadm_2sf)

 [1] "GID_0"     "NAME_0"    "GID_1"     "NAME_1"    "NL_NAME_1" "GID_2"     "NAME_2"    "VARNAME_2" "NL_NAME_2"
[10] "TYPE_2"    "ENGTYPE_2" "CC_2"      "HASC_2"    "geometry" 

gadm_2sf$NAME_0 %>% head()

[1] "Poland" "Poland" "Poland" "Poland" "Poland" "Poland"

gadm_2sf$NAME_1 %>% head()

[1] "Dolnośląskie" "Dolnośląskie" "Dolnośląskie" "Dolnośląskie" "Dolnośląskie" "Dolnośląskie"

gadm_2sf$NAME_2 %>% tail

[1] "Świdwin"           "Świnoujście"       "Szczecin"          "Szczecinek"        "Wałcz"            
[6] "Zalew Szczeciński"

gadm_2sf_podlaskie <- gadm_2sf %>%
  filter(gadm_2sf$NAME_1 == "Podlaskie")

gadm_2sf_podlaskie$NAME_2

 [1] "Augustów"            "Białystok"           "Białystok (City)"    "Bielsk"              "Grajewo"            
 [6] "Hajnówka"            "Kolno"               "Łomża"               "Łomża (City)"        "Mońki"              
[11] "Sejny"               "Siemiatycze"         "Sokółka"             "Suwałki"             "Suwałki (City)"     
[16] "Wysokie Mazowieckie" "Zambrów"            

powiaty_angielskie <- gadm_2sf_podlaskie$NAME_2
powiaty_angielskie

 [1] "Augustów"            "Białystok"           "Białystok (City)"    "Bielsk"              "Grajewo"            
 [6] "Hajnówka"            "Kolno"               "Łomża"               "Łomża (City)"        "Mońki"              
[11] "Sejny"               "Siemiatycze"         "Sokółka"             "Suwałki"             "Suwałki (City)"     
[16] "Wysokie Mazowieckie" "Zambrów"            

mieszkania_podlaskie <- mieszkania_podlaskie %>%
  mutate(Nazwa = str_remove(Nazwa, "Powiat "))

mieszkania_podlaskie <- mieszkania_podlaskie %>%
  mutate(Nazwa = str_remove(Nazwa, "m\\."))

mieszkania_podlaskie <- mieszkania_podlaskie %>%
  arrange(Nazwa)

mieszkania_podlaskie$Nazwa

 [1] "augustowski"      "białostocki"      "Białystok"        "bielski"          "grajewski"       
 [6] "hajnowski"        "kolneński"        "Łomża"            "łomżyński"        "moniecki"        
[11] "sejneński"        "siemiatycki"      "sokólski"         "suwalski"         "Suwałki"         
[16] "wysokomazowiecki" "zambrowski"      

powiaty_angielskie

 [1] "Augustów"            "Białystok"           "Białystok (City)"    "Bielsk"              "Grajewo"            
 [6] "Hajnówka"            "Kolno"               "Łomża"               "Łomża (City)"        "Mońki"              
[11] "Sejny"               "Siemiatycze"         "Sokółka"             "Suwałki"             "Suwałki (City)"     
[16] "Wysokie Mazowieckie" "Zambrów"            

w0107 <- slice(mieszkania_podlaskie, 1:7) 
w1017 <- slice(mieszkania_podlaskie, 10:17) 

mieszkania_podlaskie <- bind_rows(w0107, slice(mieszkania_podlaskie, 9)) %>%
  bind_rows(slice(mieszkania_podlaskie, 8)) %>%
  bind_rows(w1017)

mieszkania_podlaskie <- mieszkania_podlaskie %>%
  mutate(NAME_2 = powiaty_angielskie)

powiaty_angielskie

 [1] "Augustów"            "Białystok"           "Białystok (City)"    "Bielsk"              "Grajewo"            
 [6] "Hajnówka"            "Kolno"               "Łomża"               "Łomża (City)"        "Mońki"              
[11] "Sejny"               "Siemiatycze"         "Sokółka"             "Suwałki"             "Suwałki (City)"     
[16] "Wysokie Mazowieckie" "Zambrów"            

mieszkania_podlaskie$Nazwa

 [1] "augustowski"      "białostocki"      "Białystok"        "bielski"          "grajewski"       
 [6] "hajnowski"        "kolneński"        "łomżyński"        "Łomża"            "moniecki"        
[11] "sejneński"        "siemiatycki"      "sokólski"         "suwalski"         "Suwałki"         
[16] "wysokomazowiecki" "zambrowski"      

test <- gadm_2sf_podlaskie %>%
  left_join(mieszkania_podlaskie)

Joining, by = "NAME_2"

colnames(gadm_2sf_podlaskie)

 [1] "GID_0"     "NAME_0"    "GID_1"     "NAME_1"    "NL_NAME_1" "GID_2"     "NAME_2"    "VARNAME_2" "NL_NAME_2"
[10] "TYPE_2"    "ENGTYPE_2" "CC_2"      "HASC_2"    "geometry" 

colnames(test)

 [1] "GID_0"              "NAME_0"             "GID_1"              "NAME_1"             "NL_NAME_1"         
 [6] "GID_2"              "NAME_2"             "VARNAME_2"          "NL_NAME_2"          "TYPE_2"            
[11] "ENGTYPE_2"          "CC_2"               "HASC_2"             "Kod"                "Nazwa"             
[16] "Nazwa.old"          "Budynki mieszkalne" "Rok"                "Wartosc"            "geometry"          

2.2 Ilustracja graficzna

library(cartography)

test %>% ggplot() +
  geom_sf(aes(fill = Wartosc)) +
  scale_fill_gradient(low = "grey90", high = "grey30") +
  theme_bw() +
  theme(axis.line = element_blank(), 
        panel.border = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major = element_blank(), 
        plot.title = element_text(hjust = 0.5, size = rel(1.2))) +
  labs(title = "Liczba budunków mieszkanych w powiatach województwo podlaskiego",
       subtitle = "Stan na 31.12.2018r.",
       caption = "Źródło: opracowanie własne na podstawie danych z bdl GUS.")

test %>% ggplot() +
  geom_sf(aes(fill = as.factor(Wartosc))) +
  scale_fill_manual(values = carto.pal(pal1 = "red.pal", n1 = 17)) +
  theme_bw() +
  theme(axis.line = element_blank(), 
        panel.border = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid.major = element_blank(), 
        plot.title = element_text(hjust = 0.5, size = rel(1.2))) +
  labs(title = "Liczba budunków mieszkanych w powiatach województwo podlaskiego",
       subtitle = "Stan na 31.12.2018r.",
       caption = "Źródło: opracowanie własne na podstawie danych z bdl GUS.",
       fill = "Liczba budunków")

test_01 <- test %>%
  as.data.frame() %>%
  select(Nazwa, Nazwa.old, NAME_2, Wartosc)
test_01

mieszkania %>%
  filter(str_locate(Kod, "20")[,1] == 1 & is.na(str_locate(Kod, "20")[,1])==FALSE)

#detach(package:readxl)

#detach(package:tidyverse)
#detach(package:ggplot2)
#detach(package:tibble)
#detach(package:tidyr)
#detach(package:readr)
#detach(package:purrr)
#detach(package:dplyr)
#detach(package:stringr)
#detach(package:forcats)

#detach(package:sf)