क्या ggmap में स्केल बार (रैखिक दूरी के लिए) जोड़ने का कोई तरीका है?

Question

यह नहीं कि मेरे प्रश्न के लिए यह महत्वपूर्ण है, लेकिन यहां मेरा साजिश उदाहरण है, जिस पर मैं एक स्केल बार जोड़ना चाहता हूं।

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

Answer 1

कुछ चीजें आप ऐसा करने के लिए क्या करने की जरूरत है।

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" 

हम उस के विस्तार की आवश्यकता होगी:

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 पैकेज का उपयोग करने के लिए नक्शा प्राप्त कर सकते हैं:

पहले एक data.frame() में अपने डेटा डाल करने के लिए है छवि:

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

अब हम पैमाने को समझना शुरू करते हैं। सबसे पहले, हमें एक समारोह की आवश्यकता है जो हमें दो बिंदुओं के बीच दूरी प्रदान करती है, जो कि लेट/लांग के आधार पर होती है। उसके लिए, हमने Calculate distance in (x, y) between two GPS-Points पर Haversine सूत्र, फ्लोरिस द्वारा वर्णित का उपयोग करें:

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 पर प्रलेखन का उपयोग कर सकते हैं।

Answer 2

मैंने @ एंडी क्लिफ्टन कोड को दूरी का एक और सटीक माप जोड़ने के लिए फिर से काम किया है, और बार की स्थिति के आधार पर स्केल बार को वांछित लंबाई के लिए अनुमति देने के लिए अनुमति दी है।

एंडी के कोड ने मुझे 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))) 

अगले दो चरणों अलग हैं:

पहले की गणना करने के geosphere पैकेज से distVincentyEllipsoid फ़ंक्शन का उपयोग

यह पहला हिस्सा सिर्फ कोड की पूर्णता के लिए ऊपर एंडी क्लिफ्टन के जवाब से नकल कर रहा है दूरी Haversine सूत्र से भी अधिक preciseley:

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 

फिर एंडी कोड का उपयोग कर, मैं सिर्फ तीर 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")) 

लग रहा है लगता है जोड़ दिया है