Related
I have a dataset of people arriving in a location, how long they stayed, and their home locations. I want to create an animated chart which 'flies' them to their destination, and returns them to their original point once their trip is over. But I'm not sure if this is possible with gganimate or not. At the moment I only seem to be able to do a "start" and "end" frame, though it's a little hard to tell whether it just doesn't have enough frames to do the intended action.
Here's something like what I have so far:
library(dplyr)
library(ggplot2)
library(ggmap)
library(gganimate)
#Coordinates
europecoords <- c(left = -23, bottom = 36, right = 27.87, top = 70.7)
londonareacoords <- c(left = -.7, bottom = 51, right = 0.2, top = 52)
londonpointcoords <- as.data.frame(list(lon = -.14, lat = 51.49))
#Get the map we'll use as the background
europe <- get_stamenmap(europecoords, zoom = 4, maptype = "toner-lite")
#Sample dataset configuration
numberofpoints <- 10
balance <- 0.1
#Set up an example dataset
ids <- seq(1:numberofpoints)
arrivalday <- sample(x = 30, size = numberofpoints, replace = TRUE)
staylength <- sample(x = 7, size = numberofpoints, replace = TRUE)
startlocationlondonarealon <- sample(x = seq(londonareacoords['left'] * 10, londonareacoords['right'] * 10), size = numberofpoints * balance, replace = TRUE) / 10
startlocationlondonarealat <- sample(x = seq(londonareacoords['bottom'] * 10, londonareacoords['top'] * 10), size = numberofpoints * balance, replace = TRUE) / 10
startlocationeuropelon <- sample(x = seq(europecoords['left'] * 10, europecoords['right'] * 10), size = (numberofpoints * (1 - balance)), replace = TRUE) / 10
startlocationeuropelat <- sample(x = seq(europecoords['bottom'] * 10, europecoords['top'] * 10), size = (numberofpoints * (1 - balance)), replace = TRUE) / 10
startlocationlon <- c(startlocationlondonarealon, startlocationeuropelon)
startlocationlat <- c(startlocationlondonarealat, startlocationeuropelat)
points <- as.data.frame(cbind(ID = ids, arrivalday, staylength, departureday = arrivalday + staylength, startlocationlon, startlocationlat))
#Map the sample dataset to check it looks reasonable
ggmap(europe) +
geom_point(data = points, aes(x = startlocationlon, y = startlocationlat), col = "blue", size = 2) +
geom_point(data = londonpointcoords, aes(x = lon, y = lat), col = "red")
#Separate the events out to rearrange, then glue them back together
event1 <- points %>%
mutate(Event = "Day Before Arrival", Date = arrivalday - 1) %>%
mutate(Lon = startlocationlon,
Lat = startlocationlat) %>%
select(ID, Event, Date, Lon, Lat)
event2 <- points %>%
mutate(Event = "Arrival Date", Date = arrivalday) %>%
mutate(Lon = londonpointcoords$lon[1],
Lat = londonpointcoords$lat[1]) %>%
select(ID, Event, Date, Lon, Lat)
event3 <- points %>%
mutate(Event = "Departure Date", Date = departureday) %>%
mutate(Lon = londonpointcoords$lon[1],
Lat = londonpointcoords$lat[1]) %>%
select(ID, Event, Date, Lon, Lat)
event4 <- points %>%
mutate(Event = "Day After Departure", Date = departureday + 1) %>%
mutate(Lon = startlocationlon,
Lat = startlocationlat) %>%
select(ID, Event, Date, Lon, Lat)
events <- rbind(event1, event2, event3, event4) %>%
mutate(Event = factor(Event, ordered = TRUE, levels = c("Day Before Arrival", "Arrival Date", "Departure Date", "Day After Departure"))) %>%
mutate(ID = factor(ID))
#Make an animation
ggmap(europe) +
geom_point(data = events, aes(x = Lon, y = Lat, group = ID, col = ID), size = 2) +
#geom_point(data = londonpointcoords, aes(x = lon, y = lat), col = "red") +
transition_manual(Date) +
labs(title = "Date: {frame}") +
NULL
But as I said, the points don't seem to be 'flying' as much as just appearing and disappearing. Should I be using a different data format? Transition type? Number of frames? (I'm having trouble finding documentation on any of the above, which is part of why I'm stuck...)
Final result
Code
library(ggplot2)
library(ggmap)
library(gganimate)
ggm <- ggmap(europe) +
geom_point(data = events,
aes(x = Lon, y = Lat,
colour = ID, group = ID, shape = Event),
size = 3, alpha = 0.8) +
transition_time(Date) +
labs(title = paste("Day", "{round(frame_time,0)}")) +
shadow_wake(wake_length = 0.1)
animate(ggm, fps = 24, duration = 16)
========================================================
Step-by-step
You have lots of moving parts there. Let's break it down a bit:
0. Load libraries
library(ggplot2)
library(ggmap)
library(gganimate)
library(ggrepel) # will be useful for data exploration in step 1
1. Data exploration
ggplot(data = events, aes(x = ID, y = Date, colour = Event)) +
geom_point()
We see, that the arrival and departure events are each quite close together for each plane. Also, there is always a gap of a couple of days inbetween. That seems reasonable.
Let's check the Date variable:
> length(unique(events$Date))
[1] 24
> min(events$Date)
[1] 2
> max(events$Date)
[1] 33
Okay, this means two things:
Our data points are unevenly spaced.
We don't have data for all Dates.
Both things will make the animation part quite challenging.
ggplot(data = unique(events[, 4:5]), aes(x = Lon, y = Lat)) +
geom_point()
Furthermore, we only have 11 unique locations (== airports). This will probaly lead to overlapping data. Let's plot it by day:
ggplot(data = unique(events[, 3:5]), aes(x = Lon, y = Lat, label = Date)) +
geom_point() +
geom_text_repel()
Yup, this will be fun... Lots of things happening at that airport in the middle.
2. Basic animation
gga <- ggplot(data = events, aes(x = Lon, y = Lat)) +
geom_point() +
transition_time(Date)
animate(gga)
We used transition_time() and not transition_states(), because the former is used for linear time variables (e.g., second, day, year) and automatic interpolation, while the latter gives more manual control to the user.
3. Let's add colour
gga <- ggplot(data = events, aes(x = Lon, y = Lat, colour = ID)) +
geom_point() +
transition_time(Date)
animate(gga)
It's starting to look like something!
4. Add title, transparency, increase size
gga <- ggplot(data = events, aes(x = Lon, y = Lat, col = ID)) +
geom_point(size = 3, alpha = 0.5) +
transition_time(Date) +
labs(title = paste("Day", "{round(frame_time, 0)}"))
Note the rounded {round(frame_time, 0)}. Try using {frame_time} and see what happens!
5. Add some pizzaz
gga <- ggplot(data = events, aes(x = Lon, y = Lat, col = ID, group = ID,
shape = Event)) +
geom_point(size = 3, alpha = 0.5) +
transition_time(Date) +
labs(title = paste("Day", "{round(frame_time, 0)}")) +
shadow_wake(wake_length = 0.05)
animate(gga)
Looks good, let's finish it up!
6. Add the map, make animation slower, tweak some details
ggm <- ggmap(europe) +
geom_point(data = events,
aes(x = Lon, y = Lat,
colour = ID, group = ID, shape = Event),
size = 3, alpha = 0.8) +
transition_time(Date) +
labs(title = paste("Day", "{round(frame_time,0)}")) +
shadow_wake(wake_length = 0.1)
animate(ggm, fps = 24, duration = 16)
Not too shabby, eh? As a side note: animate(ggm, nframes = 384) would have had the same effect on the animation as fps = 24 with duration = 16.
If you have any question please do not hesitate to shoot me a comment.
I will try my best to help or clarify things.
I saw yesterday this beautiful map of McDonalds restaurants in USA. I wanted to replicate it for France (I found some data that can be downloaded here).
I have no problem plotting the dots:
library(readxl)
library(ggplot2)
library(raster)
#open data
mac_do_FR <- read_excel("./mcdo_france.xlsx")
mac_do_FR_df <- as.data.frame(mac_do_FR)
#get a map of France
mapaFR <- getData("GADM", country="France", level=0)
#plot dots on the map
ggplot() +
geom_polygon(data = mapaFR, aes(x = long, y = lat, group = group),
fill = "transparent", size = 0.1, color="black") +
geom_point(data = mac_do_FR_df, aes(x = lon, y = lat),
colour = "orange", size = 1)
I tried several methods (Thiessen polygons, heat maps, buffers), but the results I get are very poor. I can't figure out how the shaded polygons were plotted on the American map. Any pointers?
Here's my result, but it did take some manual data wrangling.
Step 1: Get geospatial data.
library(sp)
# generate a map of France, along with a fortified dataframe version for ease of
# referencing lat / long ranges
mapaFR <- raster::getData("GADM", country="France", level=0)
map.FR <- fortify(mapaFR)
# generate a spatial point version of the same map, defining your own grid size
# (a smaller size yields a higher resolution heatmap in the final product, but will
# take longer to calculate)
grid.size = 0.01
points.FR <- expand.grid(
x = seq(min(map.FR$long), max(map.FR$long), by = grid.size),
y = seq(min(map.FR$lat), max(map.FR$lat), by = grid.size)
)
points.FR <- SpatialPoints(coords = points.FR, proj4string = mapaFR#proj4string)
Step 2: Generate a voronoi diagram based on store locations, & obtain the corresponding polygons as a SpatialPolygonsDataFrame object.
library(deldir)
library(dplyr)
voronoi.tiles <- deldir(mac_do_FR_df$lon, mac_do_FR_df$lat,
rw = c(min(map.FR$long), max(map.FR$long),
min(map.FR$lat), max(map.FR$lat)))
voronoi.tiles <- tile.list(voronoi.tiles)
voronoi.center <- lapply(voronoi.tiles,
function(l) data.frame(x.center = l$pt[1],
y.center = l$pt[2],
ptNum = l$ptNum)) %>%
data.table::rbindlist()
voronoi.polygons <- lapply(voronoi.tiles,
function(l) Polygon(coords = matrix(c(l$x, l$y),
ncol = 2),
hole = FALSE) %>%
list() %>%
Polygons(ID = l$ptNum)) %>%
SpatialPolygons(proj4string = mapaFR#proj4string) %>%
SpatialPolygonsDataFrame(data = voronoi.center,
match.ID = "ptNum")
rm(voronoi.tiles, voronoi.center)
Step 3. Check which voronoi polygon each point on the map overlaps with, & calculate its distance to the corresponding nearest store.
which.voronoi <- over(points.FR, voronoi.polygons)
points.FR <- cbind(as.data.frame(points.FR), which.voronoi)
rm(which.voronoi)
points.FR <- points.FR %>%
rowwise() %>%
mutate(dist = geosphere::distm(x = c(x, y), y = c(x.center, y.center))) %>%
ungroup() %>%
mutate(dist = ifelse(is.na(dist), max(dist, na.rm = TRUE), dist)) %>%
mutate(dist = dist / 1000) # convert from m to km for easier reading
Step 4. Plot, adjusting the fill gradient parameters as needed. I felt the result of a square root transformation looks quite good for emphasizing distances close to a store, while a log transformation is rather too exaggerated, but your mileage may vary.
ggplot() +
geom_raster(data = points.FR %>%
mutate(dist = pmin(dist, 100)),
aes(x = x, y = y, fill = dist)) +
# optional. shows outline of France for reference
geom_polygon(data = map.FR,
aes(x = long, y = lat, group = group),
fill = NA, colour = "white") +
# define colour range, mid point, & transformation (if desired) for fill
scale_fill_gradient2(low = "yellow", mid = "red", high = "black",
midpoint = 4, trans = "sqrt") +
labs(x = "longitude",
y = "latitude",
fill = "Distance in km") +
coord_quickmap()
I'm getting the following error when using ggmap: Error in if (is.waive(data) || empty(data)) return(cbind(data, PANEL = integer(0))) :
missing value where TRUE/FALSE needed
I've been using ggmap for quite some time now, but can't figure out what the problem is - tried running it on different versions of R (3.3.2, 3.3.3), still getting the same problem. Other datasets with the same spatial extent plot ok...
toy dataset
sub <- structure(list(Lat = c(49.3292885463864, 49.3316446084215,
49.3300452342386, 49.3317620975044, 49.3304515659156, 49.3305117886863,
49.3283736754004, 49.3307167462002, 49.3318995940679, 49.333169419547,
49.3309562839252, 49.3317698899629, 49.3281374770165, 49.3316554590127,
49.3326735200194, 49.331519408234, 49.3280156106529, 49.3291709916829,
49.3328300103323, 49.3306140984074), Lon = c(-117.657207875892,
-117.672957375133, -117.66331506511, -117.672862630678, -117.66304525751,
-117.668207331581, -117.655158806988, -117.66229183045, -117.673965605927,
-117.673707660621, -117.662873110863, -117.673069192809, -117.655568553898,
-117.674182492008, -117.673907352374, -117.675914855, -117.65485127671,
-117.657316414995, -117.671748537091, -117.662937333234), z =
c(9.27369836928302, 2.39183027404169, -1.93395087707449, -3.18890166171755,
-0.97968656067399, 2.2968631268102, 8.25209737911514, -1.44955530148785,
-1.16576549902187, 0.341268832113262, -1.15519233610136, 10.2579242298728,
-4.65813764430002, 0.301315621593428, 5.25169173852741, -5.37463429849591,
4.70020657978266, -4.64139357200872, -1.38702225667279, 9.38668592801448)),
.Names = c("Lat", "Lon", "z"), row.names = c(266748L, 266749L, 266750L,
266756L, 266758L, 266760L, 266768L, 266770L, 266771L, 266772L, 266778L,
266782L, 266783L, 266784L, 266787L, 266791L, 266792L, 266796L,
266801L, 266802L), class = "data.frame")
code
library(ggmap)
library(ggplot2)
prep <- get_googlemap(center = c(-117.660, 49.329), zoom = 14,
maptype = 'satellite', scale = 2)
map <- ggmap(prep, size = c(100, 200),
extent='device', darken = 0, legend = "bottom",
base_layer = ggplot(data = sub, aes(x = Lon, y = Lat)))
map
map + geom_point(data = sub, aes(x = Lon, y = Lat, colour = z), size = 1)
EDIT
I need to use facets, which is why the base_layer call is there.
Why the base_layer bit?
This works fine for me:
map <- ggmap(prep, size = c(100, 200),
extent='device', darken = 0, legend = "bottom")
map + geom_point(data = sub, aes(x = Lon, y = Lat, colour = z), size = 1)
Update:
Works with facet_wrap, too!
sub$facet <- sample(x = 1:4, size = nrow(sub), replace = TRUE)
map2 <- ggmap(ggmap = get_googlemap(maptype = 'satellite',
center = c(-117.660, 49.329),
zoom = 14)) +
geom_point(data = sub, aes(x = Lon, y = Lat, colour = z), size = 1) +
facet_wrap(~ facet, nrow = 2)
I have a table containing all the latitudes and longitudes of some locations in a city called queryResult and I do the following:
1 - Get the Raster map of the city[Blackpool for instance]
cityMapRaster = get_map(location = 'Blackpool', zoom = 12, source = 'google', maptype = 'roadmap')
dataToShow <- ggmap(cityMapRaster) + geom_point(aes(x = Longitude, y = Latitude), data = queryResult, alpha = .5, color = "darkred", size = 1)
print(dataToShow)
and this will return the following points on the map
Now I want to draw the outer boundary [city border line] of all these latitude and longitudes similar to the following expected result
Update 1 : Providing input data and applying suggested ahull solution:
ggmap(cityMapRaster) + geom_point(aes(x = Longitude, y = Latitude), data = queryResult, alpha = .5, color = "darkred") + ahull.gg
I applied the ahull solution suggested by #spacedman and #cuttlefish44 and got the following result which is far different than the expected polygon:
You can download the .csv file containing all latitudes and longitudes from the following link : Blackpool Lat,Lon
Googles suggested area boundary looks like the following :
If you don't want a simple convex hull (and the polygon you've drawn is far from convex) then look at alpha-shapes in the alphahull package.
I wrote an example of how to get a polygon from an alpha-shape using that package and some points that make up a complex Norway boundary:
http://rpubs.com/geospacedman/alphasimple
You should be able to follow that to get a polygon for your data, and it might even be simpler now since that was a few years ago.
Here's a reproducible example of how to use chull to calculate a convex hull solution to this. I just generate some random points for queryResult, as you did not provide data.
If you prefer a concave hull boundary, then see the answer from #Spacedman
library(ggmap)
cityMapRaster = get_map(location = 'Blackpool', zoom = 12, source = 'google', maptype = 'roadmap')
extent = attr(cityMapRaster, "bb")
queryResult = data.frame(Longitude = rnorm(200, as.numeric(extent[2] + extent[4])/2, 0.01),
Latitude = rnorm(200, as.numeric(extent[1] + extent[3])/2, 0.02))
boundary = chull(as.matrix(queryResult))
ggmap(cityMapRaster) +
geom_point(aes(x = Longitude, y = Latitude),
data = queryResult, alpha = .5, color = "darkred", size = 2) +
geom_path(aes(x = Longitude, y = Latitude), data = queryResult[c(boundary, boundary[1]),])
I suppose queryResult is x and y datasets. As far as I see, your boundary isn't convex hull, so I used alphahull package.
## example `queryResult`
set.seed(1)
df <- data.frame(Longitude = runif(200, -3.05, -2.97), Latitude = rnorm(200, 53.82, 0.02))
library(alphahull)
ahull.obj <- ahull(df, alpha = 0.03)
plot(ahull.obj) # to check
# ahull_track() returns the output as a list of geom_path objs
ahull.gg <- ahull_track(df, alpha=0.03, nps = 1000)
## change graphic param
for(i in 1:length(ahull.gg)) ahull.gg[[i]]$aes_params$colour <- "green3"
ggmap(cityMapRaster) +
geom_point(aes(x = Longitude, y = Latitude), data = df, alpha = .5, color = "darkred") +
ahull.gg
## if you like not curve but linear
ashape.obj <- ashape(df, alpha = 0.015)
plot(ashape.obj) # to check
ashape.df <- as.data.frame(ashape.obj$edge[,c("x1", "x2", "y1", "y2")])
ggmap(cityMapRaster) +
geom_point(aes(x = Longitude, y = Latitude), data = df, alpha = .5, color = "darkred") +
geom_segment(aes(x = x1, y = y1, xend = x2, yend = y2), data = ashape.df, colour="green3", alpha=0.8)
I have a dataset like
latitude longitude Class prediction
9.7 21.757 244732 1
12.21 36.736 112206 0
-15.966 126.844 133969 1
Now i am trying to group all '1' at prediction column and take their latitude and longitude, later i want to display the all points on a single map.
Actually the code i wrote its takes each '1' on prediction column and takes lat and long respectively and display one point on map each time. But I want to collect all lat and long where prediction is 1 and display all points on a one map.
library(ggplot2)
library(ggmap) #install.packages("ggmap")
#data set name testData1
for (i in 1:100){
if (testData1$prediction[i]==1) {
lat <- testData1$latitude[i]
lon <- testData1$longitude[i]
df <- as.data.frame(cbind(lon,lat))
# getting the map
mapgilbert <- get_map(location = c(lon = mean(df$lon), lat = mean(df$lat)), zoom = 4,
maptype = "satellite", scale = 2)
# plotting the map with some points on it
ggmap(mapgilbert) +
geom_point(data = df, aes(x = lon, y = lat, fill = "red", alpha = 0.8), size = 5, shape = 21) +
guides(fill=FALSE, alpha=FALSE, size=FALSE)
}
}
I think you're overcomplicating things. You could simply subset df like so:
ggmap(mapgilbert) +
geom_point(data = subset(df, prediction == 1), aes(x = lon, y = lat, fill = "red", alpha = 0.8), size = 5, shape = 21) +
guides(fill = FALSE, alpha = FALSE, size = FALSE)