Analyses of swisscom data
Grid preparation
Ancillary data
Municipality boundaries
st_gg21 <- st_read("data-raw/swisstopo/swissboundaries3d_2021-07_2056_5728/SHAPEFILE_LV95_LN02/swissBOUNDARIES3D_1_3_TLM_HOHEITSGEBIET.shp",
as_tibble = TRUE) %>%
st_zm(drop = TRUE, what = "ZM") %>%
# move to LV03
st_transform(21781) %>%
# filter(! BFS_NUMMER %in% c(2391, 5391, 5394)) %>%
# exclude lakes
# filter(OBJEKTART != "Kantonsgebiet") %>%
# exclude FL & enclaves
filter(ICC == "CH") %>%
select(BFS_NUMMER, NAME, KANTONSNUM, GEM_TEIL) %>%
rename(GMDNR = BFS_NUMMER,
GMDNAME = NAME,
KTNR = KANTONSNUM) %>%
arrange(GMDNR)
write_rds(st_gg21, "data/swisstopo/st_gg21.Rds")City quartiers
Data from BfS.
st_qg17 <- st_read("data-raw/BfS/ag-b-00.03-95-qg17/shp/quart17.shp",
as_tibble = TRUE) %>%
st_zm(drop = TRUE, what = "ZM") %>%
st_transform(21781) %>%
select(-OBJECTID_1, -Flaeche) %>%
rename(GMDNR = GMDE,
QNAME = NAME,
QNR = NR) %>%
left_join(st_gg21 %>%
st_drop_geometry() %>%
select(GMDNR, GMDNAME)) %>%
relocate(geometry, .after = last_col())
write_rds(st_qg17, "data/swisstopo/st_qg17.Rds")Example of Bern
STATPOP offset
Could be used to define offset for
st_make_grid
statpop_20 <- read_delim("data-raw/BfS/ag-b-00.03-vz2020statpop/STATPOP2020.zip",
delim = ";", escape_double = FALSE, trim_ws = TRUE)[] %>%
mutate_all(as.integer)
# statpop_20 %>% slice(1:10) %>% View()
write_rds(statpop_20, "data/BfS/statpop_20.Rds")offset_bfs <- read_rds("data/BfS/statpop_20.Rds") %>%
summarise(min_x = min(X_KOORD),
min_y = min(Y_KOORD)) %>%
st_as_sf(coords = c("min_x", "min_y"),
crs = 21781,
remove = FALSE)swisscom offset
Using two communities that are furthest away in southerly and westerly directions:
Chansy to define x
- Postal code 1284
- SFOS number 6611
Chiasso to define y
- Postal code 6830
- SFOS number 5250
Tile definitions were pulled from API using
query_swisscom_heatmaps_api.py.
Points of grid were defined using lower left corner coordinates.
WGS84 coordinates were transformed to
LV03.
chansy_grid <- fromJSON("data/swisscom/chansy_grid.json")
chansy_grid <- flatten(chansy_grid$tiles) %>%
as_tibble()
chansy_grid_sf <- chansy_grid %>%
st_as_sf(coords = c("ll.x", "ll.y"),
crs = 4326,
remove = FALSE) %>%
st_transform(21781) %>%
mutate(x = st_coordinates(.)[, 1],
y = st_coordinates(.)[, 2])Chansy
Chiasso
Coordinates of lower left corner were then obtained by getting minimum values
offset_swisscom <-
bind_rows(
chansy_grid_sf %>%
st_drop_geometry() %>%
summarise(min_x = min(x),
min_y = min(y)) ,
chiasso_grid_sf %>%
st_drop_geometry() %>%
summarise(min_x = min(x),
min_y = min(y))
) %>%
summarise(min_x = min(min_x),
min_y = min(min_y)) %>%
# needs rounding - transfrom error?
mutate(min_y = round(min_y)) %>%
st_as_sf(coords = c("min_x", "min_y"),
crs = 21781,
remove = FALSE)Note small difference from BfS derived minimums (in black)!
Commuter flows
Data
2018 commuter
flows from mobility microcensus.
Testing only on areas of canton Bern.
commuters <- read_delim("data-raw/BfS/ts-x-11.04.04.05-2018.csv",
delim = ";", escape_double = FALSE,
col_types = cols(REF_YEAR = col_integer(),
GEO_CANT_RESID = col_integer(),
GEO_COMM_RESID = col_integer(),
GEO_CANT_WORK = col_integer(),
GEO_COMM_WORK = col_integer(),
VALUE = col_integer()),
trim_ws = TRUE) %>%
janitor::clean_names() %>%
filter(perspective == "R") %>%
select(-perspective, -ref_year) %>%
filter(geo_cant_resid == 2) %>%
select(-geo_cant_resid) %>%
arrange(geo_comm_resid, desc(value))There are cross cantonal flows still here!
geo_cant_work <integer>
# total N=10093 valid N=10093 mean=7.46 sd=14.33
Value | N | Raw % | Valid % | Cum. %
---------------------------------------
1 | 313 | 3.10 | 3.10 | 3.10
2 | 6862 | 67.99 | 67.99 | 71.09
3 | 254 | 2.52 | 2.52 | 73.61
5 | 12 | 0.12 | 0.12 | 73.72
6 | 22 | 0.22 | 0.22 | 73.94
7 | 11 | 0.11 | 0.11 | 74.05
8 | 2 | 0.02 | 0.02 | 74.07
9 | 117 | 1.16 | 1.16 | 75.23
10 | 344 | 3.41 | 3.41 | 78.64
11 | 825 | 8.17 | 8.17 | 86.81
12 | 60 | 0.59 | 0.59 | 87.41
13 | 90 | 0.89 | 0.89 | 88.30
14 | 2 | 0.02 | 0.02 | 88.32
17 | 6 | 0.06 | 0.06 | 88.38
19 | 285 | 2.82 | 2.82 | 91.20
20 | 8 | 0.08 | 0.08 | 91.28
22 | 152 | 1.51 | 1.51 | 92.79
23 | 31 | 0.31 | 0.31 | 93.09
24 | 222 | 2.20 | 2.20 | 95.29
25 | 30 | 0.30 | 0.30 | 95.59
26 | 104 | 1.03 | 1.03 | 96.62
77 | 341 | 3.38 | 3.38 | 100.00
<NA> | 0 | 0.00 | <NA> | <NA>Aggregating by community of origin
geo_comm_resid_agg <-
left_join(
commuters %>%
group_by(geo_comm_resid) %>%
summarise(workers_all = sum(value)) %>%
ungroup() %>%
select(geo_comm_resid, workers_all),
commuters %>%
filter(geo_comm_resid == geo_comm_work) %>%
rename(workers_stay = value) %>%
ungroup() %>%
select(geo_comm_resid, workers_stay)
) %>%
left_join(
commuters %>%
filter(geo_comm_resid != geo_comm_work) %>%
group_by(geo_comm_resid) %>%
summarise(workers_leave = sum(value)) %>%
ungroup() %>%
select(geo_comm_resid, workers_leave)
) %>%
mutate(percent_leave = (workers_leave / workers_all) * 100)