Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Lange Nacht der Museen (R-Script)
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
# THE SOFTWARE.
# install libraries
install.packages("jsonlite")
install.packages("tidyr")
install.packages("dplyr")
install.packages("purrr")
install.packages("TSP")
install.packages("readr")
# load libraries
library(readr)
library(TSP)
library(purrr)
library(dplyr)
library(tidyr)
library(jsonlite)
# your google api key goes here:
gmaps_api_key <- YOUR_KEY
# parse the museums
# assuming we have a csv file called museen.csv
museums <- readr::read_csv2("museen.csv", col_types = list(geo = readr::col_character())) %>%
separate(geo, into = c("lat", "lng"), sep = ",") %>%
mutate(lat = as.numeric(lat),
lng = as.numeric(lng)) %>%
mutate(id = row_number())
# create lat_long pairs for google distance matrix api
lat_long_positions <- by_row(museums, ~ paste0(.x$lat, ",", .x$lng))$.out %>%
unlist
solve_and_export <- function(vehicle_type) {
print(paste0("Solving for ", vehicle_type))
print("Getting locations")
locations <- paste0(lat_long_positions, collapse = "|")
durations <- map(lat_long_positions, function(current_pos) {
params <- paste0(
"origins=", current_pos,
"&destinations=", locations,
"&mode=", vehicle_type,
"&key=", gmaps_api_key
)
url_string <- paste("https://maps.googleapis.com/maps/api/distancematrix/json?",
params, sep = "")
Sys.sleep(1)
route <- jsonlite::fromJSON(url_string)
duration <- route$rows$elements[[1]]$duration$value
duration
})
print("Downloaded distance matrix")
# build the distance matrix
dmatrix <- do.call(rbind, durations)
# we convert this asymmetric-tsp to a symmetric TSP and solve it
atsp_model <- ATSP(dmatrix)
tsp_model <- reformulate_ATSP_as_TSP(atsp_model, infeasible = 9999999, cheap = -999999)
# Please note: concorde is not free software!
# You can find the terms of usage for concorde at http://www.math.uwaterloo.ca/tsp/concorde.html
# type ?solve_TSP for other solution methods
result <- solve_TSP(tsp_model, method = "concorde")
# convert it back to atsp
# sometimes the tour is reversed. We need to check both
tour <- result[result <= n_of_cities(atsp_model)]
result_atsp_rev <- TOUR(c(1, rev(tour[2:length(tour)])), tsp = atsp_model)
result_atsp <- TOUR(tour, tsp = atsp_model)
if (tour_length(result_atsp_rev) < tour_length(result_atsp)) {
result_atsp <- result_atsp_rev
}
result_atsp
# export to geo_json
tour_vector <- as.integer(result_atsp)
features <- map2(1:length(tour_vector), tour_vector, function(i, the_id) {
city <- filter(museums, id == the_id)
list(
type = "Feature",
properties = list(sequence = i,
object_id = city$object_id,
name = city$object_name),
geometry = list(
type = "Point",
coordinates = c(city$lng, city$lat)
)
)
})
geo_json_list <- list(
type = "FeatureCollection",
tour_length = tour_length(result_atsp),
vehicle_type = vehicle_type,
features = features
)
export_json <- jsonlite::toJSON(geo_json_list, auto_unbox = TRUE, pretty = TRUE)
writeLines(export_json, con = paste0("route_", vehicle_type,".geo.json"))
}
# solve it
solve_and_export("walking")
solve_and_export("bicycling")
solve_and_export("driving")
# result
# http://interaktiv.morgenpost.de/lange-nacht-der-museen/
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment