Orte mit ggplot() auf eine OpenStreetMap plotten

Wir plotten ein paar Adressen auf eine OpenStreetMap-Karte mit ggplot().
ggplot
openstreetmap
Autor:in

Joe Slam

Veröffentlichungsdatum

27 Nov. 2022 - 00:00

Geändert

30 März 2024 - 12:40

Ich habe in einem Tibble mehrere Adressen (z.B. von Kunden, Kooperationspartnern etc.) und möchte diese auf einer OpenStreetMap plotten. Dies kann mit dem {OpenStreetMap}-Paket und ggplot() umgesetzt werden.

Skurrile Adressen

Erzeugen wir uns zunächst ein paar skurrile Testadressen.

library(tidyverse)
# Erzeuge Tibble mit skurrilen Adressen
Orte <- tribble(
  ~Strasse, ~PLZ, ~Ort,
  "Beamtenlaufbahn", 24103, "Kiel",
  "Bremsweg", 19057, "Schwerin",
  "Zäher Wille", 68305, "Mannheim",
  "Ameisenstraße", 04249, "Leipzig",
  "Am Schmerzenmösle", 78464, "Allmannsdorf",
  "Unter Fettenhennen", 50667, "Köln",
  "Im Himmel", 58285, "Gevelsberg",
  "Unterer Fauler Pelz", 69117, "Heidelberg",
  "Seidenes Strümpfchen", 34117, "Kassel",
  "Im Sack", 27321, "Thedinghausen",
  "Rutschbahn", 20146, "Hamburg",
  "Zornige Ameise", 45134, "Essen",
  "Mafiastraße", 47249, "Duisburg"
)

Hilfsfunktion

Jetzt benötigen wir eine kleine Hilfsfunktion, mit welcher wir die Adressen in Längen- und Breitenangaben (longitude, latitude) umwandeln können. Hier hat Dimitry Kisler eine funktionierende Variante vorgestellt. Die Funktion heisst nominatim_osm() und nutzt die API von http://nominatim.openstreetmap.org/.

## geocoding function using OSM Nominatim API
## details: http://wiki.openstreetmap.org/wiki/Nominatim
## made by: D.Kisler 

nominatim_osm <- function(address = NULL)
{
  if(suppressWarnings(is.null(address)))
    return(data.frame())
  tryCatch(
    d <- jsonlite::fromJSON( 
      gsub('\\@addr\\@', gsub('\\s+', '\\%20', address), 
           'http://nominatim.openstreetmap.org/search?q=@addr@&format=json&addressdetails=0&limit=1')
    ), error = function(c) return(data.frame())
  )
  if(length(d) == 0) return(data.frame())
  return(data.frame(lon = as.numeric(d$lon), lat = as.numeric(d$lat)))
}

Die Funktion nimmt die vollständige Adresse als Charakter entgegen. Also binden wir die Adressdaten zu jeweils einem Adress-String zusammen.

### ziehe die Adressen
Adressen <- Orte %>%
  unite("Adresse", Strasse:Ort, sep=" ") |> 
  pull(Adresse)

# Anschauen
Adressen
 [1] "Beamtenlaufbahn 24103 Kiel"          
 [2] "Bremsweg 19057 Schwerin"             
 [3] "Zäher Wille 68305 Mannheim"          
 [4] "Ameisenstraße 4249 Leipzig"          
 [5] "Am Schmerzenmösle 78464 Allmannsdorf"
 [6] "Unter Fettenhennen 50667 Köln"       
 [7] "Im Himmel 58285 Gevelsberg"          
 [8] "Unterer Fauler Pelz 69117 Heidelberg"
 [9] "Seidenes Strümpfchen 34117 Kassel"   
[10] "Im Sack 27321 Thedinghausen"         
[11] "Rutschbahn 20146 Hamburg"            
[12] "Zornige Ameise 45134 Essen"          
[13] "Mafiastraße 47249 Duisburg"          

Hole die Längen- und Breitenangaben der Adressen

Per lapply() können wir die Adressen auf unsere Funktion loslassen.

### Hole die Koordinaten von allen Adressen
Koordinaten <- suppressWarnings(lapply(Adressen, function(address) {
  #calling the nominatim OSM API
  api_output <- nominatim_osm(address)
  # if address has a typo or is not found, return NA
  if(nrow(api_output) == 0) { 
    api_output <- data.frame(lon=NA, lat=NA)
  }
  #return data.frame
  return(data.frame(Adresse = address, api_output))
}) %>%
  #stack the list output into data.frame
  bind_rows() %>% data.frame())

# schaue an
Koordinaten
                                Adresse       lon      lat
1            Beamtenlaufbahn 24103 Kiel 10.130928 54.32614
2               Bremsweg 19057 Schwerin 11.350407 53.64449
3            Zäher Wille 68305 Mannheim  8.493369 49.51984
4            Ameisenstraße 4249 Leipzig 12.320721 51.29433
5  Am Schmerzenmösle 78464 Allmannsdorf  9.197833 47.68228
6         Unter Fettenhennen 50667 Köln  6.956118 50.94089
7            Im Himmel 58285 Gevelsberg  7.330112 51.32413
8  Unterer Fauler Pelz 69117 Heidelberg  8.709759 49.41028
9     Seidenes Strümpfchen 34117 Kassel  9.498792 51.31495
10          Im Sack 27321 Thedinghausen  9.025481 52.95809
11             Rutschbahn 20146 Hamburg  9.983085 53.57055
12           Zornige Ameise 45134 Essen  7.055969 51.42895
13           Mafiastraße 47249 Duisburg  6.767938 51.37159

Erstelle den Kartenausschnitt

Jetzt erstellen wir uns einen Kartenausschnitt, der jeweils die kleinsten und größten Ausprägungen von lat und lon einschließt (plus etwas margin vom 0.05). Dies kann ein bisschen dauern…

# | label: kartenausschnitt
# aktiviere OpenStreetMap
library(OpenStreetMap)
# get the map (this might take some time)
mymap <-openmap(c(min(Koordinaten$lat, na.rm=TRUE)-0.05, 
                  min(Koordinaten$lon, na.rm=TRUE)-0.05), 
                c(max(Koordinaten$lat, na.rm=TRUE)+0.05, 
                  max(Koordinaten$lon, na.rm=TRUE)+0.05), 
                #zoom=10,
                # other 'type' options are "osm", "bing", "stamen-toner",
                # "stamen-watercolor" "apple-iphoto", "skobbler";
                type = "osm", mergeTiles = TRUE)

Die Daten müssen auf das selbe Koordinatensystem transformiert werden. Auch dies kann ein bisschen dauern…

# project openstreetmap to alternate coordinate system (might also take some time)
mymap_coord <- openproj(mymap)

Plotte die Karte mit ggplot

Jetzt können wir ein ggplot()-Objekt der Karte erzeugen….

# create a ggplot2-Object of the map
mymap_plt <- OpenStreetMap::autoplot.OpenStreetMap(mymap_coord)

…und die Adresspunkte dort einfügen.

# add the city points
mymap_plt + 
  geom_point(data=Koordinaten, aes(x=lon, y=lat), 
             size=1, shape=13, color="red") +
  xlab("") + ylab("") + 
  ggtitle("Wohnorte der Kunden")

Kartentypen

Die Funktion openmap() kann verschiedene types erstellen. Die Hilfeseite zeigt alle Möglichkeiten an. Hier mal zum Vergleich der type apple-iphoto“…

## andere Kartenvariante
# get the map (this might take some time)
mymap2 <-openmap(c(min(Koordinaten$lat, na.rm=TRUE)-0.05, 
                  min(Koordinaten$lon, na.rm=TRUE)-0.05), 
                c(max(Koordinaten$lat, na.rm=TRUE)+0.05, 
                  max(Koordinaten$lon, na.rm=TRUE)+0.05), 
                #zoom=10,
                # other 'type' options are "osm", "bing", "stamen-toner",
                # "stamen-watercolor" "apple-iphoto", "skobbler";
                type = "apple-iphoto", mergeTiles = TRUE)
mymap_coord2 <- openproj(mymap2)
mymap_plt2 <- OpenStreetMap::autoplot.OpenStreetMap(mymap_coord2)
mymap_plt2 + 
  geom_point(data=Koordinaten, aes(x=lon, y=lat), 
             size=1, shape=13, color="red") +
  xlab("") + ylab("") + 
  ggtitle("Wohnorte der Kunden")

… und stamen-watercolor“…

## andere Kartenvariante
# get the map (this might take some time)
mymap3 <-openmap(c(min(Koordinaten$lat, na.rm=TRUE)-0.05, 
                  min(Koordinaten$lon, na.rm=TRUE)-0.05), 
                c(max(Koordinaten$lat, na.rm=TRUE)+0.05, 
                  max(Koordinaten$lon, na.rm=TRUE)+0.05), 
                #zoom=10,
                # other 'type' options are "osm", "bing", "stamen-toner",
                # "stamen-watercolor" "apple-iphoto", "skobbler";
                type = "stamen-watercolor", mergeTiles = TRUE)
mymap_coord3 <- openproj(mymap3)
mymap_plt3 <- OpenStreetMap::autoplot.OpenStreetMap(mymap_coord3)
mymap_plt3 + 
  geom_point(data=Koordinaten, aes(x=lon, y=lat), 
             size=1, shape=13, color="red") +
  xlab("") + ylab("") + 
  ggtitle("Wohnorte der Kunden")