Есть ли способ добавить шкалу шкалы (для линейных расстояний) в ggmap?

Не то, чтобы это было важно для моего вопроса, но вот пример моего примера, поверх которого я бы хотел добавить шкалу.

ggmap(get_map(location = "Kinston, NC", zoom = 12, maptype = 'hybrid')) +
geom_point(x = -77.61198, y = 35.227792, colour = "red", size = 5) +
geom_point(x = -77.57306, y = 35.30288, colour = "blue", size = 3) +
geom_point(x = -77.543, y = 35.196, colour = "blue", size = 3) +
geom_text(x = -77.575, y = 35.297, label = "CRONOS Data") +
geom_text(x = -77.54, y = 35.19, label = "NOAA") +
geom_text(x = -77.61, y = 35.22, label = "PP Site")

NC map

Ответы

Ответ 1

Есть несколько вещей, которые вам нужно сделать, чтобы это произошло.

Сначала нужно поместить ваши данные в data.frame():

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"))

Теперь мы можем получить карту для этой области с помощью пакета gg_map:

require(gg_map)
map.base <- get_map(location = c(lon = mean(sites.data$lon),
                                 lat = mean(sites.data$lat)),
                    zoom = 10) # could also use zoom = "auto"

Нам понадобятся экстенты этого изображения:

bb <- attr(map.base,"bb")

Теперь мы начинаем выяснять масштаб. Во-первых, нам нужна функция, дающая нам расстояние между двумя точками, основанное на lat/long. Для этого мы используем формулу Хаверсина, описанную Флорисом в Рассчитаем расстояние в (x, y) между двумя GPS-точками:

distHaversine <- function(long, lat){

  long <- long*pi/180
  lat <- lat*pi/180  
  dlong = (long[2] - long[1])
  dlat  = (lat[2] - lat[1])

  # Haversine formula:
  R = 6371;
  a = sin(dlat/2)*sin(dlat/2) + cos(lat[1])*cos(lat[2])*sin(dlong/2)*sin(dlong/2)
  c = 2 * atan2( sqrt(a), sqrt(1-a) )
  d = R * c
  return(d) # in km
}

Следующий шаг - выработать точки, которые будут определять нашу шкалу. В этом примере я помещал что-то в левом нижнем углу графика, используя ограничительную рамку, которую мы уже выяснили:

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)))

sbar$distance = distHaversine(long = c(sbar$lon.start,sbar$lon.end),
                              lat = c(sbar$lat.start,sbar$lat.end))

Наконец, мы можем нарисовать карту со шкалой.

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)) +
  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(distance, 
                                digits = 4,
                                nsmall = 2),
                         '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"))

Что дает вам что-то вроде этого:

Карта со шкалой шкалы

Приятно то, что во всех записях используется ggplot2(), поэтому вы можете использовать документацию в http://ggplot2.org, чтобы сделать это Посмотрите, как вам нужно.

Ответ 2

Я переработал код @Andy Clifton, чтобы добавить более точное измерение расстояния, и чтобы шкала масштабирования имела желаемую длину, а не в зависимости от положения панели.

Код Энди получил мне 99 процентов пути, но формула Хаверсина, используемая в его коде, не проверяется с результатами из других источников, хотя я сам не могу найти ошибку.

Эта первая часть копируется из ответа Энди Клифтона выше только для полноты кода:

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)))

Следующие два шага отличаются:

Сначала используйте функцию distVincentyEllipsoid из пакета geosphere, чтобы рассчитать расстояние еще точнее, чем формула Хаверсина:

sbar$distance <- geosphere::distVincentyEllipsoid(c(sbar$lon.start,sbar$lat.start),
 c(sbar$lon.end,sbar$lat.end))

Затем исправьте шкалу шкалы так, чтобы она была стандартной длиной - в зависимости от масштаба вашей карты. В этом примере 20 км кажется хорошим разумным выбором, т.е. 20 000 метров:

scalebar.length <- 20
sbar$lon.end <- sbar$lon.start +
((sbar$lon.end-sbar$lon.start)/sbar$distance)*scalebar.length*1000

Снова используя код Andy, я только добавил стрелки к 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"))

пример переработанной шкалы