Traufgänge Albstadt
In this post, I want to visualise some hiking paths near my hometown.
The so called ‘Traufgänge’ are some panoramic tours, that pass through spectacular natural scenery along a steeply declining Albtrauf.
This post will describe the progress to scrap, preprocess and visualise
the data. The whole process is put together in one big drake plan.
I will describe the most important functions, data frames and plots in more
detail:
Data
The gpx files of the hiking paths are available online. Create all the
links, by inserting a unique id into a base url.
glue_trauf_urls <- function(ids) {
str_glue(
"http://www.outdooractive.com/download.tour.gpx?i=",
"{ids}&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de")
}glue_collapse(links, sep = " \n")## http://www.outdooractive.com/download.tour.gpx?i=1508840&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=1515629&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=1561121&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=1526041&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=1484741&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=1515671&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=1547041&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=26035570&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=4480506&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=de
## http://www.outdooractive.com/download.tour.gpx?i=4480579&proj=api-albstadt&key=TQSXFTL4-EMWGKXWF-4OSSHXDG&lang=deRead all the gpx files and extract the name of each hiking path from the
xml file. Shorten the name of the hiking path.
read_gpx <- function(links) {
tibble(
path = links, gpx = map(path, ~ xml_ns_strip(read_xml(.))),
name = map_chr(
gpx, ~ xml_text(xml_find_first(., "//name")))) %>%
mutate(
name = str_trim(str_remove_all(
name, "Traufgang|in Albstadt|Premium-Winterwanderweg")),
trackpoints = map(gpx, xml_find_all, xpath = "//trkpt"),
attrs = map(trackpoints, xml_attrs),
ele = map(
trackpoints, ~ xml_text(xml_find_all(.x, "ele"))))
}dplyr::select(df_gpx, name, gpx)## # A tibble: 10 x 2
## name gpx
## <chr> <list>
## 1 Wacholderhöhe <xml_dcmn>
## 2 Schlossfelsenpfad <xml_dcmn>
## 3 Zollernburg-Panorama <xml_dcmn>
## 4 Felsenmeersteig <xml_dcmn>
## 5 Hossinger Leiter <xml_dcmn>
## 6 Ochsenbergtour <xml_dcmn>
## 7 Wiesenrunde <xml_dcmn>
## 8 Traufgängerle Hexenküche <xml_dcmn>
## 9 Schneewalzer <xml_dcmn>
## 10 Wintermärchen <xml_dcmn>Get all attributes and elevation nodes from every gpx file and unnest the data and perform some basic preprocessing:
tidy_gpx <- function(df_gpx) {
df_gpx %>%
mutate(id = map(ele, ~ 1:length(.x))) %>%
unnest(cols = c(attrs, ele, id)) %>%
mutate(
lat = map_chr(attrs, "lat"), lon = map_chr(attrs, "lon"),
name = str_replace_all(name, c("ä" = "ae", "ö" = "oe"))) %>%
select_if(negate(is_list)) %>%
mutate_at(vars(ele, lat, lon), parse_number)
}Take a glimpse at the final data frame:
dplyr::select(df_gpx_tidy, -path)## # A tibble: 2,774 x 5
## name ele id lat lon
## <chr> <dbl> <int> <dbl> <dbl>
## 1 Wacholderhöhe 887. 1 48.3 9.04
## 2 Wacholderhöhe 886. 2 48.3 9.04
## 3 Wacholderhöhe 889. 3 48.3 9.04
## 4 Wacholderhöhe 890. 4 48.3 9.04
## 5 Wacholderhöhe 892. 5 48.3 9.04
## 6 Wacholderhöhe 889. 6 48.3 9.04
## 7 Wacholderhöhe 893. 7 48.3 9.04
## 8 Wacholderhöhe 898. 8 48.3 9.04
## 9 Wacholderhöhe 899. 9 48.3 9.04
## 10 Wacholderhöhe 897. 10 48.3 9.04
## # ... with 2,764 more rowsVisualisation
Create simple features data frame:
sf_gpx <- function(df_gpx_tidy) {
df_gpx_tidy %>%
nest(data = -name) %>%
mutate(
sf_obj = map(
data, ~ st_linestring(as.matrix(.x[, c("lon", "lat", "ele")]))),
dm = map(
data, ~ st_distance(st_as_sf(.x, coords = c("lon", "lat", "ele")))),
geometry = st_sfc(sf_obj)) %>%
st_sf(crs = 4326)
}Calculate the bounding box for the simple features data frame:
trauf_bbox <- function(sf_trauf) {
st_bbox(sf_trauf)
}Based on the bounding box from the previous step, download a stamen map:
get_bbox_stamen_map <- function(bbox, tol_bbox) {
map_toner <- get_stamenmap(c(
left = bbox$xmin[[1]] - 2 * tol_bbox,
right = bbox$xmax[[1]] + tol_bbox,
bottom = bbox$ymin[[1]] - 2 * tol_bbox,
top = bbox$ymax[[1]] + tol_bbox),
zoom = 12, maptype = "toner-hybrid")
}ggmap::ggmap(trauf_map)
Visualise the simple features data frame:
vis_sf <- function(df_gpx_sf, map) {
plot_data <- df_gpx_sf %>%
select(-dm)
ggmap(map) +
geom_sf(
aes(color = name),
data = plot_data, inherit.aes = FALSE, size = 1.1) +
theme(
axis.line = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.position = "none",
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.background = element_blank(),
strip.text = element_blank())
}p1## Warning in `$.crs`(crs, "proj4string"): CRS uses proj4string, which is
## deprecated.
Visualise the elevation of every route and save the result for later:
vis_alt <- function(df_gpx) {
df_gpx %>%
mutate(name = str_wrap(name, width = 10)) %>%
ggplot(aes(x = id, y = ele, color = name)) +
geom_line() +
facet_wrap(~ name, scales = "free_x") +
labs(x = "", y = "Hoehenmeter", color = "Name") +
theme(axis.text.x = element_blank(), legend.position = "bottom")
}p2
Get the two plots in one plot and show the result:
comb_plots <- function(p1, p2) {
p1 + p2 +
plot_layout(ncol = 2)
}erg_plot## Warning in `$.crs`(crs, "proj4string"): CRS uses proj4string, which is
## deprecated.