Packages

library(tidyverse)
library(data.table)
data.table 1.12.2 using 4 threads (see ?getDTthreads).  Latest news: r-datatable.com

Attaching package: ‘data.table’

The following objects are masked from ‘package:dplyr’:

    between, first, last

The following object is masked from ‘package:purrr’:

    transpose
library(readxl)
library(VIM)
Loading required package: colorspace
VIM is ready to use. 
 Since version 4.0.0 the GUI is in its own package VIMGUI.

          Please use the package to use the new (and old) GUI.

Suggestions and bug-reports can be submitted at: https://github.com/alexkowa/VIM/issues

Attaching package: ‘VIM’

The following object is masked from ‘package:datasets’:

    sleep
library(vcd)

GUS Data

Read raw data

gus_woj <- fread("../data-raw/POPYT_POZNAN_2011_2017.csv") %>%
  rename( kwartal = 3, woj = 4) %>%
  select(rok = ROK, kwartal, woj, ends_with("1"), -P6_011, -V1) %>%
  filter(rok %in% 2011:2014, kwartal == 1, woj != "POLSKA") %>%
  mutate(woj = str_pad(woj,2,"0",side = "left")) %>%
  gather(zawody, liczba, -rok, -kwartal,-woj)  %>%
  mutate(zawody = str_replace(zawody, "P6_",""),
         zawody = str_replace(zawody, "1$",""),
         zawody = as.numeric(zawody),
         zawod1 = case_when(zawody %in% 2:5 ~ 1,
                            zawody %in% 6:11 ~ 2,
                            zawody %in% 12:16 ~ 3,
                            zawody %in% 17:20 ~ 4,
                            zawody %in% 21:24 ~ 5,
                            zawody %in% 25:27 ~ 6,
                            zawody %in% 28:32 ~ 7,
                            zawody %in% 33:35 ~ 8,
                            zawody %in% 36:41 ~ 9)) %>%
  group_by(rok, kwartal, woj, zawod1) %>%
  mutate(zawod2 = paste0(zawod1, row_number())) %>%
  ungroup() 

Read data from excel spreadsheets

dir(path = "../data-raw", pattern = "*00", full.names = T) %>%
  set_names(basename(.)) %>%
  map_df(~read_excel(path = .x, sheet = "Arkusz5", skip = 9, col_names = F) %>%
            filter(`...1` != "OGÓŁEM") %>%
            set_names(nm = c("zawod","ogolem", LETTERS[1:19])) %>%
            select(-ogolem) %>%
            mutate(kod = str_extract(zawod, "\\d{1,2}\\."),
                   kod = str_replace(kod, "\\.", ""),
                   kod = as.numeric(kod)) %>%
            filter(kod > 10) %>%
            gather(sekcja, wolne, -kod, -zawod) %>%
            filter(wolne > 0), 
         .id = "rok") %>%
  mutate(rok = readr::parse_number(rok),
         kod1 = substr(kod, 1,1))  %>%
  rename(kod2 = kod) %>%
  select(rok, kod1, kod2, zawod, sekcja, wolne) -> gus_sek

-
/
                                                                                                                           
New names:
* `` -> ...1
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5
* … and 16 more problems

-
/
                                                                                                                           
New names:
* `` -> ...1
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5
* … and 16 more problems

-
/
                                                                                                                           
New names:
* `` -> ...1
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5
* … and 16 more problems

-
/
                                                                                                                           
New names:
* `` -> ...1
* `` -> ...2
* `` -> ...3
* `` -> ...4
* `` -> ...5
* … and 16 more problems
gus_sek %>%
  count(rok, wt = wolne)

Joining two things together

gus_sek %>%
  select(-zawod) %>%
  mutate(kod1 = as.numeric(kod1)) %>%
  bind_rows(gus_woj %>% 
              mutate(kod2 = as.numeric(zawod2)) %>%
              select(rok, woj, kod1 = zawod1, kod2 , woj, wolne = liczba)) -> gus_dane
saveRDS(object = gus_dane, file = "../data/gus-woj-sek.rds")

Data with standard errors

precs %>% 
  spread(rok, prec) %>%
  add_row(sekcja = "overall", `2011` = 3.40, `2013` = 4.01, `2014` = 3.98, .before = 1) %>%
  xtable(caption = "Estimates on relative standard erros of estimators for vacancies of the demand for labour in IV quarter 2011, 2013 and 2014",
         label = "tab-rel-var") %>%
  print.xtable(include.rownames = F,
               caption.placement = "top")
% latex table generated in R 3.5.1 by xtable 1.8-4 package
% Thu Jul 25 23:10:15 2019
\begin{table}[ht]
\centering
\caption{Estimates on relative standard erros of estimators for vacancies of the demand for labour in IV quarter 2011, 2013 and 2014} 
\label{tab-rel-var}
\begin{tabular}{lrrr}
  \hline
sekcja & 2011 & 2013 & 2014 \\ 
  \hline
overall & 3.40 & 4.01 & 3.98 \\ 
  C & 5.50 & 5.27 & 5.64 \\ 
  F & 13.86 & 19.21 & 15.12 \\ 
  G & 13.69 & 15.75 & 16.33 \\ 
  H & 8.07 & 9.93 & 9.17 \\ 
  I & 15.99 & 20.78 & 18.26 \\ 
  J & 6.30 & 7.04 & 11.50 \\ 
  K & 7.00 & 8.36 & 7.43 \\ 
  M & 8.12 & 8.71 & 12.01 \\ 
  N & 23.09 & 12.89 & 17.76 \\ 
  O & 3.19 & 3.50 & 2.56 \\ 
  P & 8.85 & 10.65 & 12.06 \\ 
  Q & 5.53 & 6.88 & 6.00 \\ 
  R & 7.08 & 8.68 & 9.28 \\ 
  S & 18.09 & 21.29 & 20.77 \\ 
   \hline
\end{tabular}
\end{table}

Add bootstrap population data

Bootstraping totals

set.seed(123)
pop_totals %>%
  group_by(rok, r, b) %>%
  do(res = rmultinom(n = 100, size = .$r[[1]], p = .$data[[1]]$p) %>% as.data.frame(),
     kod2 = .$data[[1]]$kod2,
     sekcja = .$data[[1]]$sekcja) %>%
  group_by(rok, b) %>%
  unnest(kod2, sekcja, res) %>%
  ungroup() %>%
  arrange(rok, r, b) %>%
  gather(b2, wolne, V1:V100) %>%
  mutate(b2 = gsub("V", "", b2),
         b2 = as.numeric(b2)) %>%
  arrange(rok, b, b2) -> pop_totals2
saveRDS(boot_pop, file = "../data/gus-woj-sek-boot-totals.rds")

BKL Data

nace_sek <- readRDS("../data/bkl-finalne-model.rds") %>%
  ungroup() %>%
  count(sekcja_pkd, nace) %>%
  select(-n) %>%
  filter(!is.na(sekcja_pkd))
bkl <- readRDS("../data/bkl-oferty.rds") %>%
  filter(rok != 2010) %>%
  mutate(woj = str_pad(woj, 2, "0", side = "left"),
         sekcja_pkd = as.character(sekcja_pkd),
         zawod_9grup = ifelse(is.na(zawod_9grup), substr(zawod,1,1), zawod_9grup)) %>%
  rename(id = plik, zawod6 = zawod, zawod1 = zawod_9grup) %>%
  left_join(nace_sek) %>%
  select(id, rok, zrodlo, forma_ogl, zrodlo_dokladne, zawod1, zawod6, 
         woj, podregion, nace, sekcja_pkd2, branza, wyksztalcenie, jezyk_angielski:komp_biurowe)
saveRDS(bkl, "../data/bkl-before-imp.rds")
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCmVkaXRvcl9vcHRpb25zOiAKICBjaHVua19vdXRwdXRfdHlwZTogaW5saW5lCi0tLQoKIyBQYWNrYWdlcwoKYGBge3J9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGRhdGEudGFibGUpCmxpYnJhcnkocmVhZHhsKQpsaWJyYXJ5KFZJTSkKbGlicmFyeSh2Y2QpCmBgYAoKIyMgR1VTIERhdGEKClJlYWQgcmF3IGRhdGEKYGBge3J9Cmd1c193b2ogPC0gZnJlYWQoIi4uL2RhdGEtcmF3L1BPUFlUX1BPWk5BTl8yMDExXzIwMTcuY3N2IikgJT4lCiAgcmVuYW1lKCBrd2FydGFsID0gMywgd29qID0gNCkgJT4lCiAgc2VsZWN0KHJvayA9IFJPSywga3dhcnRhbCwgd29qLCBlbmRzX3dpdGgoIjEiKSwgLVA2XzAxMSwgLVYxKSAlPiUKICBmaWx0ZXIocm9rICVpbiUgMjAxMToyMDE0LCBrd2FydGFsID09IDEsIHdvaiAhPSAiUE9MU0tBIikgJT4lCiAgbXV0YXRlKHdvaiA9IHN0cl9wYWQod29qLDIsIjAiLHNpZGUgPSAibGVmdCIpKSAlPiUKICBnYXRoZXIoemF3b2R5LCBsaWN6YmEsIC1yb2ssIC1rd2FydGFsLC13b2opICAlPiUKICBtdXRhdGUoemF3b2R5ID0gc3RyX3JlcGxhY2UoemF3b2R5LCAiUDZfIiwiIiksCiAgICAgICAgIHphd29keSA9IHN0cl9yZXBsYWNlKHphd29keSwgIjEkIiwiIiksCiAgICAgICAgIHphd29keSA9IGFzLm51bWVyaWMoemF3b2R5KSwKICAgICAgICAgemF3b2QxID0gY2FzZV93aGVuKHphd29keSAlaW4lIDI6NSB+IDEsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICB6YXdvZHkgJWluJSA2OjExIH4gMiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDEyOjE2IH4gMywKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDE3OjIwIH4gNCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDIxOjI0IH4gNSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDI1OjI3IH4gNiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDI4OjMyIH4gNywKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDMzOjM1IH4gOCwKICAgICAgICAgICAgICAgICAgICAgICAgICAgIHphd29keSAlaW4lIDM2OjQxIH4gOSkpICU+JQogIGdyb3VwX2J5KHJvaywga3dhcnRhbCwgd29qLCB6YXdvZDEpICU+JQogIG11dGF0ZSh6YXdvZDIgPSBwYXN0ZTAoemF3b2QxLCByb3dfbnVtYmVyKCkpKSAlPiUKICB1bmdyb3VwKCkgCmBgYAoKCgpSZWFkIGRhdGEgZnJvbSBleGNlbCBzcHJlYWRzaGVldHMKCmBgYHtyfQpkaXIocGF0aCA9ICIuLi9kYXRhLXJhdyIsIHBhdHRlcm4gPSAiKjAwIiwgZnVsbC5uYW1lcyA9IFQpICU+JQogIHNldF9uYW1lcyhiYXNlbmFtZSguKSkgJT4lCiAgbWFwX2RmKH5yZWFkX2V4Y2VsKHBhdGggPSAueCwgc2hlZXQgPSAiQXJrdXN6NSIsIHNraXAgPSA5LCBjb2xfbmFtZXMgPSBGKSAlPiUKICAgICAgICAgICAgZmlsdGVyKGAuLi4xYCAhPSAiT0fDk8WBRU0iKSAlPiUKICAgICAgICAgICAgc2V0X25hbWVzKG5tID0gYygiemF3b2QiLCJvZ29sZW0iLCBMRVRURVJTWzE6MTldKSkgJT4lCiAgICAgICAgICAgIHNlbGVjdCgtb2dvbGVtKSAlPiUKICAgICAgICAgICAgbXV0YXRlKGtvZCA9IHN0cl9leHRyYWN0KHphd29kLCAiXFxkezEsMn1cXC4iKSwKICAgICAgICAgICAgICAgICAgIGtvZCA9IHN0cl9yZXBsYWNlKGtvZCwgIlxcLiIsICIiKSwKICAgICAgICAgICAgICAgICAgIGtvZCA9IGFzLm51bWVyaWMoa29kKSkgJT4lCiAgICAgICAgICAgIGZpbHRlcihrb2QgPiAxMCkgJT4lCiAgICAgICAgICAgIGdhdGhlcihzZWtjamEsIHdvbG5lLCAta29kLCAtemF3b2QpICU+JQogICAgICAgICAgICBmaWx0ZXIod29sbmUgPiAwKSwgCiAgICAgICAgIC5pZCA9ICJyb2siKSAlPiUKICBtdXRhdGUocm9rID0gcmVhZHI6OnBhcnNlX251bWJlcihyb2spLAogICAgICAgICBrb2QxID0gc3Vic3RyKGtvZCwgMSwxKSkgICU+JQogIHJlbmFtZShrb2QyID0ga29kKSAlPiUKICBzZWxlY3Qocm9rLCBrb2QxLCBrb2QyLCB6YXdvZCwgc2VrY2phLCB3b2xuZSkgLT4gZ3VzX3NlawpgYGAKCmBgYHtyfQpndXNfc2VrICU+JQogIGNvdW50KHJvaywgd3QgPSB3b2xuZSkKYGBgCgoKSm9pbmluZyB0d28gdGhpbmdzIHRvZ2V0aGVyCgpgYGB7cn0KZ3VzX3NlayAlPiUKICBzZWxlY3QoLXphd29kKSAlPiUKICBtdXRhdGUoa29kMSA9IGFzLm51bWVyaWMoa29kMSkpICU+JQogIGJpbmRfcm93cyhndXNfd29qICU+JSAKICAgICAgICAgICAgICBtdXRhdGUoa29kMiA9IGFzLm51bWVyaWMoemF3b2QyKSkgJT4lCiAgICAgICAgICAgICAgc2VsZWN0KHJvaywgd29qLCBrb2QxID0gemF3b2QxLCBrb2QyICwgd29qLCB3b2xuZSA9IGxpY3piYSkpIC0+IGd1c19kYW5lCmBgYAoKYGBge3J9CnNhdmVSRFMob2JqZWN0ID0gZ3VzX2RhbmUsIGZpbGUgPSAiLi4vZGF0YS9ndXMtd29qLXNlay5yZHMiKQpgYGAKCgpEYXRhIHdpdGggc3RhbmRhcmQgZXJyb3JzCgpgYGB7cn0KZDIwMTEgPC0gcmVhZC50YWJsZSgiLi4vZGF0YS1yYXcvcG9weXQtMjAxMSIsIGhlYWRlciA9IEYsIHNlcCAgPSAiOyIsIGRlYyA9ICIsIiwgc3RyaW5nc0FzRmFjdG9ycyA9IEYpICU+JQogIHNlbGVjdChzZWtjamEgPSBWMSwgcHJlYyA9IFYzKSAlPiUKICBtdXRhdGUocm9rID0gMjAxMSkKCmQyMDEzIDwtIHJlYWRfZXhjZWwoIi4uL2RhdGEtcmF3L1BXX3BvcHl0X25hX3ByYWNlX3dfMjAxMy54bHMiLCBjb2xfbmFtZXMgPSBGLCBza2lwID0gMzEpICU+JQogIG5hLm9taXQoKSAlPiUKICBtdXRhdGUoc2VrY2phID0gZDIwMTEkc2VrY2phKSAlPiUKICBzZWxlY3Qoc2VrY2phLCBwcmVjID0gMyklPiUKICBtdXRhdGUocm9rID0gMjAxMykKICAKZDIwMTQgPC0gcmVhZF9leGNlbCgiLi4vZGF0YS1yYXcvcG9weXRfbmFfcHJhY2VfMjAxNC54bHMiLCBjb2xfbmFtZXMgPSBGLCBza2lwID0gMzEpICU+JQogIG5hLm9taXQoKSAlPiUKICBtdXRhdGUoc2VrY2phID0gZDIwMTEkc2VrY2phKSAlPiUKICBzZWxlY3Qoc2VrY2phLCBwcmVjID0gMykgJT4lCiAgbXV0YXRlKHJvayA9IDIwMTQpCgpwcmVjcyA8LSBiaW5kX3Jvd3MoZDIwMTEsZDIwMTMsIGQyMDE0KQpgYGAKCgpBZGQgYm9vdHN0cmFwIHBvcHVsYXRpb24gZGF0YQoKCmBgYHtyfQpndXNfZGFuZSAlPiUKICBmaWx0ZXIoaXMubmEod29qKSkgICU+JQogIGNvdW50KHJvaywgc2VrY2phLCB3dCA9IHdvbG5lKSAlPiUKICBsZWZ0X2pvaW4ocHJlY3MpICU+JQogIGZpbHRlcihyb2sgIT0gMjAxMikgJT4lCiAgbmEub21pdCgpICU+JQogIG11dGF0ZShzZCA9IG4qcHJlYy8xMDApIC0+IHBvcF9kYXRhX3dpdGhfcHJlYwpgYGAKCmBgYHtyfQpndXNfZGFuZSAlPiUKICBmaWx0ZXIoaXMubmEod29qKSwgc2VrY2phICVpbiUgdW5pcXVlKHBvcF9kYXRhX3dpdGhfcHJlYyRzZWtjamEpKSAlPiUKICBjb3VudChyb2ssIHNla2NqYSwga29kMiwgd3QgID0gd29sbmUpICU+JQogIGFkZF9jb3VudChyb2ssIHNla2NqYSwgd3QgPSBuLCBuYW1lID0gInRvdGFsIikgJT4lCiAgbXV0YXRlKHAgPSBuIC8gdG90YWwpIC0+IHphd29keV9zZWtjamUKYGBgCgpCb290c3RyYXBpbmcgdG90YWxzCgpgYGB7cn0KYiA8LSAxMDAwCnBvcF9kYXRhX3dpdGhfcHJlYyAlPiUKICBncm91cF9ieShyb2ssIHNla2NqYSkgJT4lCiAgZG8oYiA9IDE6YiwKICAgICBuX2hhdCA9IHJvdW5kKHJub3JtKG4gPSBiLCBtZWFuID0gLiRuW1sxXV0sIHNkID0gLiRzZFtbMV1dKSkpICU+JQogIHVubmVzdCgpICU+JQogIGxlZnRfam9pbiggemF3b2R5X3Nla2NqZSAlPiUgc2VsZWN0KHJvaywgc2VrY2phLCBrb2QyLCBwKSkgJT4lCiAgbXV0YXRlKGhhdF93b2xuZSA9IHJvdW5kKHAqbl9oYXQpKSAtPiBib290X3BvcAoKYm9vdF9wb3AKYGBgCgpgYGAKc2V0LnNlZWQoMTIzKQpwb3BfdG90YWxzICU+JQogIGdyb3VwX2J5KHJvaywgciwgYikgJT4lCiAgZG8ocmVzID0gcm11bHRpbm9tKG4gPSAxMDAsIHNpemUgPSAuJHJbWzFdXSwgcCA9IC4kZGF0YVtbMV1dJHApICU+JSBhcy5kYXRhLmZyYW1lKCksCiAgICAga29kMiA9IC4kZGF0YVtbMV1dJGtvZDIsCiAgICAgc2VrY2phID0gLiRkYXRhW1sxXV0kc2VrY2phKSAlPiUKICBncm91cF9ieShyb2ssIGIpICU+JQogIHVubmVzdChrb2QyLCBzZWtjamEsIHJlcykgJT4lCiAgdW5ncm91cCgpICU+JQogIGFycmFuZ2Uocm9rLCByLCBiKSAlPiUKICBnYXRoZXIoYjIsIHdvbG5lLCBWMTpWMTAwKSAlPiUKICBtdXRhdGUoYjIgPSBnc3ViKCJWIiwgIiIsIGIyKSwKICAgICAgICAgYjIgPSBhcy5udW1lcmljKGIyKSkgJT4lCiAgYXJyYW5nZShyb2ssIGIsIGIyKSAtPiBwb3BfdG90YWxzMgpgYGAKCgpgYGB7cn0Kc2F2ZVJEUyhib290X3BvcCwgZmlsZSA9ICIuLi9kYXRhL2d1cy13b2otc2VrLWJvb3QtdG90YWxzLnJkcyIpCmBgYAoKCgoKCiMjIEJLTCBEYXRhCgpgYGB7cn0KbmFjZV9zZWsgPC0gcmVhZFJEUygiLi4vZGF0YS9ia2wtZmluYWxuZS1tb2RlbC5yZHMiKSAlPiUKICB1bmdyb3VwKCkgJT4lCiAgY291bnQoc2VrY2phX3BrZCwgbmFjZSkgJT4lCiAgc2VsZWN0KC1uKSAlPiUKICBmaWx0ZXIoIWlzLm5hKHNla2NqYV9wa2QpKQpgYGAKCmBgYHtyfQpia2wgPC0gcmVhZFJEUygiLi4vZGF0YS9ia2wtb2ZlcnR5LnJkcyIpICU+JQogIGZpbHRlcihyb2sgIT0gMjAxMCkgJT4lCiAgbXV0YXRlKHdvaiA9IHN0cl9wYWQod29qLCAyLCAiMCIsIHNpZGUgPSAibGVmdCIpLAogICAgICAgICBzZWtjamFfcGtkID0gYXMuY2hhcmFjdGVyKHNla2NqYV9wa2QpLAogICAgICAgICB6YXdvZF85Z3J1cCA9IGlmZWxzZShpcy5uYSh6YXdvZF85Z3J1cCksIHN1YnN0cih6YXdvZCwxLDEpLCB6YXdvZF85Z3J1cCkpICU+JQogIHJlbmFtZShpZCA9IHBsaWssIHphd29kNiA9IHphd29kLCB6YXdvZDEgPSB6YXdvZF85Z3J1cCkgJT4lCiAgbGVmdF9qb2luKG5hY2Vfc2VrKSAlPiUKICBzZWxlY3QoaWQsIHJvaywgenJvZGxvLCBmb3JtYV9vZ2wsIHpyb2Rsb19kb2tsYWRuZSwgemF3b2QxLCB6YXdvZDYsIAogICAgICAgICB3b2osIHBvZHJlZ2lvbiwgbmFjZSwgc2VrY2phX3BrZDIsIGJyYW56YSwgd3lrc3p0YWxjZW5pZSwgamV6eWtfYW5naWVsc2tpOmtvbXBfYml1cm93ZSkKYGBgCgpgYGB7cn0Kc2F2ZVJEUyhia2wsICIuLi9kYXRhL2JrbC1iZWZvcmUtaW1wLnJkcyIpCmBgYAoKCg==