@Andy Cliftonのコードを作り直して、距離のより正確な測定値を追加し、バーの位置に依存するのではなく、スケールバーを目的の長さにできるようにしました。
Andy のコードで 99% 正解しましたが、彼のコードで使用されている Haversine 式は、他のソースからの結果で検証されていませんが、自分でエラーを見つけることはできません。
この最初の部分は、コードを完全にするために、上記の Andy Clifton の回答からコピーしたものです。
sites.data = data.frame(lon = c(-77.61198, -77.57306, -77.543),
lat = c(35.227792, 35.30288, 35.196),
label = c("PP Site","NOAA", "CRONOS Data"),
colour = c("red","blue","blue"))
map.base <- get_map(location = c(lon = mean(sites.data$lon),
lat = mean(sites.data$lat)),
zoom = 10)
bb <- attr(map.base,"bb")
sbar <- data.frame(lon.start = c(bb$ll.lon + 0.1*(bb$ur.lon - bb$ll.lon)),
lon.end = c(bb$ll.lon + 0.25*(bb$ur.lon - bb$ll.lon)),
lat.start = c(bb$ll.lat + 0.1*(bb$ur.lat - bb$ll.lat)),
lat.end = c(bb$ll.lat + 0.1*(bb$ur.lat - bb$ll.lat)))
次の 2 つの手順は異なります。
最初distVincentyEllipsoid
にパッケージの関数を使用しgeosphere
て、Haversine 式よりもさらに正確に距離を計算します。
sbar$distance <- geosphere::distVincentyEllipsoid(c(sbar$lon.start,sbar$lat.start),
c(sbar$lon.end,sbar$lat.end))
次に、マップの縮尺に応じて、標準の長さになるように縮尺記号を修正します。この例では、20km、つまり 20,000 メートルが妥当な選択のように思えます。
scalebar.length <- 20
sbar$lon.end <- sbar$lon.start +
((sbar$lon.end-sbar$lon.start)/sbar$distance)*scalebar.length*1000
再びアンディのコードを使用して、geom_segment
見栄えが良いと思うので、矢印のみを追加しました
ptspermm <- 2.83464567 # need this because geom_text uses mm, and themes use pts. Urgh.
map.scale <- ggmap(map.base,
extent = "normal",
maprange = FALSE) %+% sites.data +
geom_point(aes(x = lon,
y = lat,
colour = colour)) +
geom_text(aes(x = lon,
y = lat,
label = label),
hjust = 0,
vjust = 0.5,
size = 8/ptspermm) +
geom_segment(data = sbar,
aes(x = lon.start,
xend = lon.end,
y = lat.start,
yend = lat.end),
arrow=arrow(angle = 90, length = unit(0.1, "cm"),
ends = "both", type = "open")) +
geom_text(data = sbar,
aes(x = (lon.start + lon.end)/2,
y = lat.start + 0.025*(bb$ur.lat - bb$ll.lat),
label = paste(format(scalebar.length),
'km')),
hjust = 0.5,
vjust = 0,
size = 8/ptspermm) +
coord_map(projection = "mercator",
xlim=c(bb$ll.lon, bb$ur.lon),
ylim=c(bb$ll.lat, bb$ur.lat))
# Fix presentation ----
map.out <- map.scale +
theme_bw(base_size = 8) +
theme(legend.justification = c(1,1),
legend.position = c(1,1))
ggsave(filename ="map.png",
plot = map.out,
dpi = 300,
width = 4,
height = 3,
units = c("in"))
