Related
I have two dataframes both recording the top 10 stations riders went. One is for casual rider, the other one is for member rider. Both dataframes contain column 'station','freq','latitude','longitude'. I'm able to use ggmap to plot the graph showing the locations of the stations from both dataframes, but not able to show the legend.
R scripe is showing below:
library(ggplot2)
library(rstudioapi)
library(ggmap)
map_location <- c (lon = -87.623177, lat = 41.881832)
chicago_map_zoom <- get_map (location = map_location,
maptype = 'roadmap',
color='bw',
source='google',
zoom=13,
)
chicago_plot <- ggmap(chicago_map_zoom) +
geom_point (data = casual_top_station,
aes (x = longitude,
y = latitude),
color = "red",
shape = 15,
alpha = 0.5,
size = 3) +
geom_point (data = member_top_station,
aes (x = longitude,
y = latitude),
color = "blue",
shape = 16,
alpha = 0.5,
size = 2) +
scale_color_identity (name = "Subscription type",
breaks = c("red","blue"),
labels = c("Casual","Member"),
guide = "legend") +
theme (axis.ticks = element_blank(),
axis.text = element_blank(),
axis.title = element_blank()) +
labs (title = "Top 10 casual and member rider stations",
subtitle = "Both start and end stations")
Result graph: Chicago_map
Instead of using scale_color_identity ... to set the values for color, shape and size I would suggest to first an id column to your data.frames
which could then be mapped on aesthetics inside aes. Afterwards set your desired colors, shapes and sizes via the scale_xxx_manual family of functions.
Using some fake data for the points:
library(ggplot2)
library(ggmap)
casual_top_station <- data.frame(
longitude = -87.65,
latitude = 41.9
)
member_top_station <- data.frame(
longitude = -87.65,
latitude = 41.86
)
casual_top_station$id <- "Casual"
member_top_station$id <- "Member"
legend_title <- "Subscription type"
base <- ggmap(chicago_map_zoom) +
scale_color_manual(values = c(Casual = "red", Member = "blue")) +
scale_shape_manual(values = c(Casual = 15, Member = 16)) +
scale_size_manual(values = c(Casual = 3, Member = 2)) +
theme(
axis.ticks = element_blank(),
axis.text = element_blank(),
axis.title = element_blank()
) +
labs(
title = "Top 10 casual and member rider stations",
subtitle = "Both start and end stations",
color = legend_title, shape = legend_title, size = legend_title
)
base +
geom_point(
data = casual_top_station,
aes(
x = longitude,
y = latitude,
color = id, shape = id, size = id
),
alpha = 0.5
) +
geom_point(
data = member_top_station,
aes(
x = longitude,
y = latitude,
color = id, shape = id, size = id
),
alpha = 0.5
)
Also, to simplify your code further I would suggest to bind both data frames by row using e.g. dplyr::bind_rows which would allow to add your points via just one geom_point.
top_station <- dplyr::bind_rows(casual_top_station, member_top_station)
base +
geom_point(
data = top_station,
aes(
x = longitude,
y = latitude,
color = id, shape = id, size = id
), alpha = .5)
Very much related to this question I am trying to plot some world regions, now using a Mercator projection, but keep getting into trouble when adding x and y limits:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator", xlim = c(-125, -30), ylim = c(-60, 35))
Obviously not great. When I use coord_cartesian (as suggested here) to set the limits, I loose the Mercator projection:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator") +
coord_cartesian(xlim = c(-125, -30), ylim = c(-60, 35))
When I use lims I get what I want for Latin America:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator") +
lims(x = c(-125, -30), y = c(-60, 35))
Problem is, this approach does not always work, for example for Africa or Asia I start to get some crazy behaviour towards the plot border:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator") +
lims(x = c(-20, 45), y = c(-50, 40))
# lims(x = c(40, 150), y = c(-10, 55))
A solution here could be to convert the lat/lon coordinates to "proper" web mercator coordinates (here I'm using epsg 3857, which is the "google" projection), and then plotting using those "new" coordinates.
Assuming that original coordinates are latlon wgs84 (epsg 4326), this can be achieved like this:
worldmerc <- SpatialPointsDataFrame(coords = data_frame(x = world$long, y = world$lat),
data = world, proj4string = CRS("+proj=longlat +datum=WGS84")) %>%
subset((lat < 90 & lat > -90)) %>% # needed because transform not defined at the poles !!!!
spTransform(CRS("+init=epsg:3857"))
worldmerc <- mutate(worldmerc#data, longmerc = coordinates(worldmerc)[,1], latmerc = coordinates(worldmerc)[,2])
Plotting the whole data gives you this (Note the use of coord_fixed to preserve aspect ratio !:
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black") +coord_fixed()
Now, the problem is that to do subsetting you would now need to enter "map" coordinates instead than lat long, but also that can be tweaked:
#For South America
xlim = c(-125, -30)
ylim = c(-60, 35)
lims = SpatialPoints(coords = data_frame(x = xlim, y = ylim), proj4string = CRS("+proj=longlat +datum=WGS84"))%>%
spTransform(CRS("+init=epsg:3857"))
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black")+
coord_fixed(xlim = coordinates(lims)[,1], ylim = coordinates(lims)[,2])
#for africa
xlim = c(-20,45)
ylim = c(-50,40)
lims = SpatialPoints(coords = data_frame(x = xlim, y = ylim), proj4string = CRS("+proj=longlat +datum=WGS84"))%>%
spTransform(CRS("+init=epsg:3857"))
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black")+
coord_fixed(xlim = coordinates(lims)[,1], ylim = coordinates(lims)[,2])
As you can see, in both cases you get "correct" maps.
Now, last thing you may want to do is maybe have "lat/lon" coordinates on the axis. That's a bit of a hack but can be done like this:
library(magrittr)
xlim = c(-125, -30)
ylim = c(-60, 35)
# Get the coordinates of the limits in mercator projection
lims = SpatialPoints(coords = data_frame(x = xlim, y = ylim),
proj4string = CRS("+proj=longlat +datum=WGS84"))%>%
spTransform(CRS("+init=epsg:3857"))
# Create regular "grids" of latlon coordinates and find points
# within xlim/ylim - will be our labels
majgrid_wid_lat = 20
majgrid_wid_lon = 30
majbreaks_lon = data_frame(x=seq(-180, 180, majgrid_wid_lon)) %>%
filter(x >= xlim[1] & x <= xlim[2]) %>%
as.data.frame()
majbreaks_lat = data_frame(x=seq(-90, 90, majgrid_wid_lat)) %>%
filter(x >= ylim[1] & x <= ylim[2]) %>%
as.data.frame()
#Find corresponding mercator coordinates
mercbreaks_lat = SpatialPoints(coords = expand.grid(x = majbreaks_lon$x, y = majbreaks_lat$x), proj4string = CRS("+init=epsg:4326"))%>%
spTransform(CRS("+init=epsg:3857")) %>% coordinates() %>% extract(,2) %>% unique()
mercbreaks_lon = SpatialPoints(coords = expand.grid(x = majbreaks_lon$x, y = majbreaks_lat$x), proj4string = CRS("+init=epsg:4326"))%>%
spTransform(CRS("+init=epsg:3857")) %>% coordinates() %>% extract(,1) %>% unique()
# Plot using mercator coordinates, but latlon labels
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_fixed(xlim = coordinates(lims)[,1], ylim = coordinates(lims)[,2])+
scale_x_continuous("lon", breaks = mercbreaks_lon, labels = signif(majbreaks_lon$x, 2)) +
scale_y_continuous("lat", breaks = mercbreaks_lat, labels = signif(majbreaks_lat$x,2))+theme_bw()
, which gives:
It's a bit convoluted and there could be better ways, but it does the trick, and could be easily transformed in a function.
HTH,
Lorenzo
library(ggplot2)
library(ggmap)
data <- read.table(file = "data.txt", sep = ",", col.names = c("lat", "lon", "place_name"), fill=FALSE, strip.white=TRUE)
# getting the map
mapgilbert <- get_map(location = c(lon = mean(data$lon), lat = mean(data$lat)),
zoom = "auto" , maptype = "roadmap", scale = 2, color = "bw")
# plotting the map with some points on it
ggmap(mapgilbert, extent = "device") +
geom_point(data = data, aes(x = lon, y = lat, fill = place_name), size = 0.5, shape = 22) +
guides(fill=FALSE, alpha=FALSE, size=FALSE)
This will produce points with different color (According to their names). Something like this:
However, I want to get rid of the black border of the points. Is there a way to do that?
Try a different shape:
data <- data.frame(lat=52.5176736, lon=13.3895097)
library(ggmap)
library(ggplot2)
mapgilbert <- get_map(location = c(lon = mean(data$lon), lat = mean(data$lat)),
zoom = "auto" , maptype = "roadmap", scale = 2, color = "bw")
ggmap(mapgilbert, extent = "device") +
geom_point(data = data, aes(x = lon, y = lat), size = 6, shape = 16, color="red") +
guides(fill=FALSE, alpha=FALSE, size=FALSE)
or set color to NA when using shape = 21:
ggmap(mapgilbert, extent = "device") +
geom_point(data = data, aes(x = lon, y = lat), size = 6, shape = 21, color=NA, fill = "red") +
guides(fill=FALSE, alpha=FALSE, size=FALSE)
I want to plot data points for various cities over a greyed-out map from google. As these cities are some distance from each other, I thought I would use a faceted plot.
Creating the map is easy enough; see image and code below. However, each facet shows the same area - in this case Greater London - with the result that the points for other cities are not shown.
Ideally I would like each facet to show each city with the relevant points overlaid. So the facet 'Cardiff' would show a zoomed map of Cardiff and its data points, 'Birmingham' would show Birmingham and its points and so on. I've tried changing various parameters such as zoom and center but I haven't been successful.
How can I show a different city and the relevant points in each facet?
require(ggmap)
require(reshape)
# create fake data
sites <- data.frame(site = 1:6,
name = c(
"Royal Albert Hall",
"Tower of London",
"Wales Millenium Centre",
"Cardiff Bay Barrage",
"Birmingham Bullring",
"Birmingham New Street Station"
),
coords = c(
"51.501076,-0.177265",
"51.508075,-0.07605",
"51.465211,-3.163208",
"51.44609,-3.166652",
"52.477644,-1.894158",
"52.477487,-1.898836"),
subzone = rep(c('London','Cardiff','Birmingham'), each = 2)
)
# use function from reshape to split/add column
sites = transform(sites,
new = colsplit(coords, split = ",", names = c('lat', 'lon')))
names(sites) <- c(names(sites)[1:4], 'lat','lon')
ggmap(get_googlemap(center = "London", # omitting this doesn't help
scale = 2,
zoom = 11, # fiddling with zoom doesn't work
color = 'bw',
maptype = 'roadmap',
extent = 'panel',
format = "png8",
filename = "facet_map_test",
)) +
facet_wrap(~ subzone, ncol = 1) +
geom_point(data = sites,
aes(x = lon, y = lat),
fill = "red",
size = 3,
colour = "black",
shape = 21,
alpha = 1) +
theme(legend.position = "none") +
theme()
Using the gridExtra package is probably the best way to go. The code:
# getting the maps
londonmap <- get_map(location = c(lon = -0.1266575, lat = 51.504575), zoom = 12)
cardiffmap <- get_map(location = c(lon = -3.16493, lat = 51.45565), zoom = 13)
birminghammap <- get_map(location = c(lon = -1.896497, lat = 52.477565), zoom = 14)
# plotting the maps
p1 <- ggmap(londonmap) +
geom_point(data = sites[sites$subzone == "London",],
aes(x = lon, y = lat, fill = "red", alpha = 0.8, size = 3),
shape = 21) +
ggtitle("London") +
theme(axis.title = element_blank(), legend.position = "none", plot.margin = unit(c(0,0,0,0), "lines"))
p2 <- ggmap(cardiffmap) +
geom_point(data = sites[sites$subzone == "Cardiff",],
aes(x = lon, y = lat, fill = "red", alpha = 0.8, size = 3),
shape = 21) +
ggtitle("Cardiff") +
theme(axis.title = element_blank(), legend.position = "none", plot.margin = unit(c(0,0,0,0), "lines"))
p3 <- ggmap(birminghammap) +
geom_point(data = sites[sites$subzone == "Birmingham",],
aes(x = lon, y = lat, fill = "red", alpha = 0.8, size = 3),
shape = 21) +
ggtitle("Birmingham") +
theme(axis.title = element_blank(), legend.position = "none", plot.margin = unit(c(0,0,0,0), "lines"))
# grouping the plots together in one plot
grid.arrange(p1, p2, p3, ncol = 1)
The result:
Not that it's critical to my question, but here is my plot example, on top of which I'd like to add a scale bar.
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")
There are a few things you need to do to make this happen.
First is to put your data into a 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"))
Now we can get the map for this region using the gg_map package:
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"
We'll need the extents of that image:
bb <- attr(map.base,"bb")
Now we start figuring out the scale. First, we need a function give us the distance between two points, based on lat/long. For that, we use the Haversine formula, described by Floris at Calculate distance in (x, y) between two GPS-Points:
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
}
The next step is to work out the points that will define our scale bar. For this example, I put something in the lower left of the plot, using the bounding box that we've already figured out:
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))
Finally, we can draw the map with the scale.
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))
Then we save it...
# 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"))
Which gives you something like this:
The nice thing is that all of the plotting uses ggplot2(), so you can use the documentation at http://ggplot2.org to make this look how you need.
I've reworked #Andy Clifton's code to add a more precise measure of the distance, and to allow for the scale bar to be of a desired length, as opposed to depending on the positioning of the bar.
Andy's code got me 99 percent of the way, but the Haversine formula used in his code is not validated with results from other sources, although I can't find the error myself.
This first part is copied from Andy Clifton's answer above just for completeness of the code:
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)))
The next two steps are different:
First use the distVincentyEllipsoid function from the geosphere package to calculate the distance even more preciseley than the Haversine formula:
sbar$distance <- geosphere::distVincentyEllipsoid(c(sbar$lon.start,sbar$lat.start),
c(sbar$lon.end,sbar$lat.end))
Then correct the scale bar so that is a standard length - depending on the scale of your map. In this example 20km seems like a nice reasonable choice, i.e. 20,000 meters:
scalebar.length <- 20
sbar$lon.end <- sbar$lon.start +
((sbar$lon.end-sbar$lon.start)/sbar$distance)*scalebar.length*1000
Again using Andy's code, I've only added the arrows to the geom_segment because I think it looks nicer
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"))