I am trying to create a map that to show some study sites in three states. I would like to get rid of the black border lines that go through the map. Like below:
lon <- c(-89.105917,-89.377778,-86.700278,-86.677361,-87.338083,-87.340444)
lat <- c(37.358694, 37.215278,38.460528,38.448389,37.594583,37.5945)
#crop
lon1 <- c(-86.6214142,-87.3423767,-87.6656265,-87.1565475,-87.8155823,-87.3194199,-87.3565598)
lat1 <- c(38.484581,37.7038918,37.7400513,38.0794983,37.6372185,37.4466667,37.3590546)
#CRP
lon2 <-c(-88.4263,-87.4707718,-86.435585,-87.9516907,-89.2439117,-88.3630524,-89.0109711)
lat2 <- c(37.3582993,37.5196114,37.5220261,37.4958801,37.3413811,37.2275009,37.3633308)
#Forest
lon3 <-c(-86.608551,-87.3794403,-88.9937515,-86.7436066,-86.7483826)
lat3 <- c(38.2506294,36.9505539,37.4111404,38.1277695,37.1684914)
#Pasture
lon4 <-c(-86.6036377,-86.2461395,-86.9746704,-87.4977493,-88.9970474,-86.2609634,-86.6067734,-86.9820709)
lat4 <- c(37.0606689,37.8114433,37.5391922,37.8073006,37.4703789,37.3089409,38.1600189,37.6018295)
df <- as.data.frame(cbind(lon,lat))
df1 <- as.data.frame(cbind(lon1,lat1))
df2 <- as.data.frame(cbind(lon2,lat2))
df3 <- as.data.frame(cbind(lon3,lat3))
df4 <- as.data.frame(cbind(lon4,lat4))
pdf("/Users/tribaker/Desktop/Thesis/RaCA/RaCASites.pdf")
al1 = get_map(location = c("posey county,indiana"),
zoom = 8, maptype = 'satellite')
mdat <- map_data('state',Fill=TRUE)
ggmap(al1) +
geom_path(data=mdat,aes(x=long,y=lat, regions=c('"Kentucky","Illinois","Indiana"')),colour="black",alpha=1)+
borders("county", colour="grey60", alpha=.5)+
borders("state", colour="black", alpha=.8)+
geom_point(data = df, aes(x = lon, y = lat,colour = "Study Site", alpha = 0.8), size = 8, shape = 15) +
geom_point(data = df1, aes(x = lon1, y = lat1,colour = "Crop",fill=TRUE, alpha = 0.8), size = 8, shape = 16) +
geom_point(data = df2, aes(x = lon2, y = lat2,colour = "CRP", fill = TRUE ,alpha = 0.8), size = 8, shape = 16) +
geom_point(data = df3, aes(x = lon3, y = lat3, colour = "Forest",fill = TRUE,alpha = 0.8), size = 8, shape =16) +
geom_point(data = df4, aes(x = lon4, y = lat4,colour = "Pasture",fill = TRUE,alpha = 0.8), size = 8, shape = 16) +
guides(fill=FALSE, alpha=FALSE, size=FALSE)
geom_text(aes(label = state), data = mdat, size = 2, angle = 45)
thanks in advance
I couldn't get the borders function to work correctly, but you can just do it manually...
Create an mdat2 dataframe with the county data and draw the borders yourself...
lon <- c(-89.105917,-89.377778,-86.700278,-86.677361,-87.338083,-87.340444)
lat <- c(37.358694, 37.215278,38.460528,38.448389,37.594583,37.5945)
#crop
lon1 <- c(-86.6214142,-87.3423767,-87.6656265,-87.1565475,-87.8155823,-87.3194199,-87.3565598)
lat1 <- c(38.484581,37.7038918,37.7400513,38.0794983,37.6372185,37.4466667,37.3590546)
#CRP
lon2 <-c(-88.4263,-87.4707718,-86.435585,-87.9516907,-89.2439117,-88.3630524,-89.0109711)
lat2 <- c(37.3582993,37.5196114,37.5220261,37.4958801,37.3413811,37.2275009,37.3633308)
#Forest
lon3 <-c(-86.608551,-87.3794403,-88.9937515,-86.7436066,-86.7483826)
lat3 <- c(38.2506294,36.9505539,37.4111404,38.1277695,37.1684914)
#Pasture
lon4 <-c(-86.6036377,-86.2461395,-86.9746704,-87.4977493,-88.9970474,-86.2609634,-86.6067734,-86.9820709)
lat4 <- c(37.0606689,37.8114433,37.5391922,37.8073006,37.4703789,37.3089409,38.1600189,37.6018295)
df <- as.data.frame(cbind(lon,lat))
df1 <- as.data.frame(cbind(lon1,lat1))
df2 <- as.data.frame(cbind(lon2,lat2))
df3 <- as.data.frame(cbind(lon3,lat3))
df4 <- as.data.frame(cbind(lon4,lat4))
al1 = get_map(location = c("posey county,indiana"),
zoom = 8, maptype = 'satellite')
mdat <- map_data('state', regions=c("Kentucky","Illinois","Indiana"))
mdat2 <- map_data('county', regions=c("Kentucky","Illinois","Indiana"))
ggmap(al1) +
geom_path(data=mdat2,aes(x=long,y=lat,group=group), colour="grey60", alpha=.5)+
geom_path(data=mdat,aes(x=long,y=lat,group=group), colour="black", alpha=.8)+
geom_point(data = df, aes(x = lon, y = lat,colour = "Study Site", alpha = 0.8), size = 8, shape = 15) +
geom_point(data = df1, aes(x = lon1, y = lat1,colour = "Crop",fill=TRUE, alpha = 0.8), size = 8, shape = 16) +
geom_point(data = df2, aes(x = lon2, y = lat2,colour = "CRP", fill = TRUE ,alpha = 0.8), size = 8, shape = 16) +
geom_point(data = df3, aes(x = lon3, y = lat3, colour = "Forest",fill = TRUE,alpha = 0.8), size = 8, shape =16) +
geom_point(data = df4, aes(x = lon4, y = lat4,colour = "Pasture",fill = TRUE,alpha = 0.8), size = 8, shape = 16) +
guides(fill=FALSE, alpha=FALSE, size=FALSE)
geom_text(aes(label = state), data = mdat, size = 2, angle = 45)
Related
I am trying to highlight single 1x1 degree grid squares on a map.
It works highlighting individual grid squares for the first 1 squares but after highlight the 4th square it begins to highlight multiple groups of squares and I am not sure why?
library(ggOceanMaps)
#devtools::install_github("MikkoVihtakari/ggOceanMapsData")
library(ggOceanMapsData)
dt <- data.frame(lon = c(35, 35, 60, 60), lat = c(-25, -25, -40, -40))
grid_2019_1 <- data.frame(lat=c(-28, -29), long=c(51, 52))
grid_2019_2 <- data.frame(lat=c(-28, -29), long=c(52, 53))
grid_2019_3 <- data.frame(lat=c(-28, -29), long=c(53, 54))
grid_2019_4 <- data.frame(lat=c(-30, -31), long=c(41, 42))
grid_2019_5 <- data.frame(lat=c(-30, -31), long=c(42, 43))
P4 = basemap(data = dt,bathymetry = T,
lon.interval = 1,
lat.interval = 1,
bathy.style = "contour_blues",
bathy.border.col = NA,
bathy.size = 0.1,
bathy.alpha = 1)
P4.1 = P4 + stat_density2d(data = grid_2019_1, aes(x = long, y = lat, fill = ..density..),
geom = 'tile', contour = F)
P4.2 = P4.1 + stat_density2d(data = grid_2019_2, aes(x = long, y = lat, fill = ..density..),
geom = 'tile', contour = F)
P4.3 = P4.2 + stat_density2d(data = grid_2019_3, aes(x = long, y = lat, fill = ..density..),
geom = 'tile', contour = F)
P4.4 = P4.3 + stat_density2d(data = grid_2019_4, aes(x = long, y = lat, fill = ..density..),
geom = 'tile', contour = F)
P4.5 = P4.4 + stat_density2d(data = grid_2019_5, aes(x = long, y = lat, fill = ..density..),
geom = 'tile', contour = F)
Fixed using geom_tile
P4 = basemap(data = dt,bathymetry = T,
lon.interval = 1,
lat.interval = 1,
bathy.style = "contour_blues",
bathy.border.col = NA,
bathy.size = 0.1,
bathy.alpha = 1)
grid_2019_1 <- data.frame(lat=c(-28.5), long=c(51.5))
grid_2019_8 <- data.frame(lat=c(-31.5), long=c(42.5))
P4.1 = P4 + geom_tile(data = grid_2019_8, aes(x= long, y = lat, fill= 'red' ))
P4.1
P4.8 = P4 + geom_tile(data = grid_2019_8, aes(x= long, y = lat, fill= 'red' ))
P4.8
I'm encountering an issue with the geom_errorbar argument where I receive the error Error: geom_errorbar requires the following missing aesthetics: x or y, xmin and xmax.
I have several datasets and would like to use them all to create a single geographical ggplot. Below is a workflow and some example data. The desired plot will have background location data in dat, the centroids in centroids and x and y errorbars/standard deviation ranges for for the centroids which are calculated in the centroids dataframe (i.e., "Longitude_weighted_sd" and "Latitude_weighted_sd".
#packages
packages<-c('tidyverse','sf','rgdal','rnaturalearth','ggspatial','raster','sp', 'cowplot',
'dplyr','ggplot2','lubridate','stargazer', 'purrr', 'geosphere', 'purrr')
lapply(packages, library, character.only = T)
library(ggplot2)
library(sf)
library(rnaturalearth)
library(rgdal)
library(ggspatial)
library(spData)
library(cowplot)
library(tidyverse)
#download geographical and upload personal/mock data
world <- ne_countries(scale = "medium", returnclass = "sf")
states <- map_data("state")
data("us_states", package = "spData")
dat <- data.frame(Latitude = c(35.8, 35.85, 36.7, 35.2, 36.1, 35.859, 36.0, 37.0, 35.1, 35.2),
Longitude = c(-89.4, -89.5, -89.4, -89.8, -90, -89.63, -89.7, -89, -88.9, -89),
Period = c("early", "early", "early", "early", "early", "late", "late", "late", "late", "late"),
State = c("A", "A", "A", "T", "T", "T", "T", "A", "A", "A"))
#function to calculate weighted variance, sd, and se
weighted.var <- function(x, w = NULL, na.rm = FALSE) {
if (na.rm) {
na <- is.na(x) | is.na(w)
x <- x[!na]
w <- w[!na]
}
sum(w * (x - weighted.mean(x, w)) ^ 2) / (sum(w) - 1)
}
weighted.sd <- function(x, w, na.rm = TRUE) sqrt(weighted.var(x, w, na.rm = TRUE))
weighted.se <- function(x, w, na.rm = TRUE) sqrt(weighted.var(x, w, na.rm = TRUE))/sqrt(length(x))
#calculate centroids for "early" and "late" periods weighted by "State" observations
centroids <- dat %>%
group_by(Period, State) %>%
mutate(weight = 1/n()) %>%
group_by(Period) %>%
summarise(across(starts_with("L"),
list(weighted_mean = ~ weighted.mean(.x, w = weight),
weighted_sd = ~ weighted.sd(.x, w = weight),
weighted_se = ~ weighted.se(.x, w = weight))))
If I take out the geom_errorbar argument everything works great. However when I add it in I receive the error that geom_error requires the following missing aesthetics:x or y, xmin and xmax however, I thought that I've specified everything. Below is the ggplot2 code. Any help would be greatly appreciated!
plot1 <- ggplot(data = world) +
geom_sf(fill = "gray92") + #light gray
geom_polygon(data = states, aes(x = long, y = lat, group = group), #states outline
color = "black", fill = NA) +
geom_point(data = dat, aes(x = Longitude, y = Latitude, color = Period), #background data
alpha = 0.2, size = 1) +
geom_point(data = centroids, aes(x = Longitude_weighted_mean, y = Latitude_weighted_mean,
fill = period), size = 6, pch = 21) + #centroids
geom_errorbar(data = centroids,
aes(ymin = Latitude_weighted_mean - Latitude_weighted_sd,
ymax = Latitude_weighted_mean + Latitude_weighted_sd,
xmin = Longitude_weighted_mean + Longitude_weighted_sd,
xmax = Longitude_weighted_mean + Longitude_weighted_sd), #errorbars
) +
theme_bw() +
coord_sf(crs = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs") +
coord_sf(xlim = c(-92, -88), ylim = c(33.5, 36.7), expand = TRUE) +
theme(plot.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 16),
axis.title = element_text(size = 20),
axis.text = element_text(size = 16),
axis.text.x = element_text(angle = 45, hjust = 1),
element_line(color = "black"))+
annotate("text", label = "TN", size = 7, x = -88.3, y = 35.3) +
annotate("text", label = "AR", size = 7, x = -91.7, y = 36) +
annotate("text", label = "MS", size = 7, x = -89, y = 34) +
xlab("Longitude") + ylab("Latitude")
plot1
Thank you in advance for anyone willing to assist. -nm
The issue is that you try two add the error bars via one geom_errorbar and as the error message is telling you you neither provided x nor y. Instead I would suggest to add your error bars via two geom_errorbars like so:
library(ggplot2)
library(rnaturalearth)
library(tidyverse)
ggplot(data = world) +
geom_sf(fill = "gray92") + # light gray
geom_polygon(
data = states, aes(x = long, y = lat, group = group), # states outline
color = "black", fill = NA
) +
geom_point(
data = dat, aes(x = Longitude, y = Latitude, color = Period), # background data
alpha = 0.2, size = 1
) +
geom_point(data = centroids, aes(
x = Longitude_weighted_mean, y = Latitude_weighted_mean,
fill = Period
), size = 6, pch = 21) + # centroids
geom_errorbar(
data = centroids,
aes(
x = Longitude_weighted_mean,
ymin = Latitude_weighted_mean - Latitude_weighted_sd,
ymax = Latitude_weighted_mean + Latitude_weighted_sd
)
) +
geom_errorbar(
data = centroids,
aes(
y = Latitude_weighted_mean,
xmin = Longitude_weighted_mean - Longitude_weighted_sd,
xmax = Longitude_weighted_mean + Longitude_weighted_sd
)
) +
theme_bw() +
coord_sf(xlim = c(-92, -88), ylim = c(33.5, 36.7), expand = TRUE) +
theme(
plot.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 16),
axis.title = element_text(size = 20),
axis.text = element_text(size = 16),
axis.text.x = element_text(angle = 45, hjust = 1),
element_line(color = "black")
) +
annotate("text", label = "TN", size = 7, x = -88.3, y = 35.3) +
annotate("text", label = "AR", size = 7, x = -91.7, y = 36) +
annotate("text", label = "MS", size = 7, x = -89, y = 34) +
xlab("Longitude") +
ylab("Latitude")
I want to created an animated heatmap on a map like this one. I am trying to use gganimate like:
library(readr)
library(dplyr)
url_csv <- 'https://raw.githubusercontent.com/d4tagirl/R-Ladies-growth-maps/master/rladies.csv'
rladies <- read_csv(url(url_csv)) %>%
select(-1)
library(DT)
datatable(rladies, rownames = FALSE,
options = list(pageLength = 5))
library(ggplot2)
library(maps)
library(ggthemes)
world <- ggplot() +
borders("world", colour = "gray85", fill = "gray80") +
theme_map()
map <- world +
geom_point(aes(x = lon, y = lat, size = followers),
data = rladies,
colour = 'purple', alpha = .5) +
scale_size_continuous(range = c(1, 8),
breaks = c(250, 500, 750, 1000)) +
labs(size = 'Followers')
library(tibble)
library(lubridate)
ghost_points_ini <- tibble(
created_at = as.Date('2011-09-01'),
followers = 0, lon = 0, lat = 0)
ghost_points_fin <- tibble(
created_at = seq(as.Date('2017-05-16'),
as.Date('2017-05-30'),
by = 'days'),
followers = 0, lon = 0, lat = 0)
map <- world +
geom_point(aes(x = lon, y = lat, size = followers,
frame = created_at,
cumulative = TRUE),
data = rladies, colour = 'purple', alpha = .5) +
geom_point(aes(x = lon, y = lat, size = followers, # this is the init transparent frame
frame = created_at,
cumulative = TRUE),
data = ghost_points_ini, alpha = 0) +
geom_point(aes(x = lon, y = lat, size = followers, # this is the final transparent frames
frame = created_at,
cumulative = TRUE),
data = ghost_points_fin, alpha = 0) +
scale_size_continuous(range = c(1, 8), breaks = c(250, 500, 750, 1000)) +
labs(size = 'Followers')
library(gganimate)
ani.options(interval = 0.2)
animate(map)
But I get : Error in animate.default(map) : animation of gg objects not supported
The other issue is that I would like the heatmap to have squares like the link I attached instead of those points.
Not sure this is what you want, but it works...
library(dplyr)
url_csv <- 'https://raw.githubusercontent.com/d4tagirl/R-Ladies-growth-maps/master/rladies.csv'
rladies <- read_csv(url(url_csv)) %>%
select(-1)
library(DT)
datatable(rladies, rownames = FALSE,
options = list(pageLength = 5))
library(ggplot2)
library(maps)
library(ggthemes)
world <- ggplot() +
borders("world", colour = "gray85", fill = "gray80") +
theme_map()
map <- world +
geom_point(aes(x = lon, y = lat, size = followers),
data = rladies,
colour = 'purple', alpha = .5) +
scale_size_continuous(range = c(1, 8),
breaks = c(250, 500, 750, 1000)) +
labs(size = 'Followers')
library(tibble)
library(lubridate)
map1 <- world +
geom_point(data = rladies, aes(x = lon, y = lat, size = followers),
colour = 'purple', alpha = .5) +
scale_size_continuous(range = c(1, 8), breaks = c(250, 500, 750, 1000)) +
labs(size = 'Followers')
library(gganimate)
map1 + transition_time(created_at)
I am creating a PDF in an R markdown file, and I have the following chunk:
PR_googlemap <- get_googlemap(center = c(lon = median(c(-67.95, -65.17)), lat = median(c(17.86, 18.41))), zoom = 9)
a <- ggmap(PR_googlemap, extent = "device") +
geom_point(data = subset(PR_2016_boat_logs, grepl("X", fieldid) == TRUE | grepl("J", fieldid) == TRUE), aes(x = lon, y = lat), size = 3, color = "red") +
annotate(geom = "text", label = "Benthics", y = 17.4, x = -66.5)
#b <- ggmap(PR_googlemap, extent = "device") +
# geom_point(data = subset(PR_2016_boat_logs, grepl("J", fieldid) == TRUE), aes(x = lon, y = lat), size = 3, color = "blue") +
# annotate(geom = "text", label = "LPI / Benthic Cover", y = 17.4, x = -66.5)
c <- ggmap(PR_googlemap, extent = "device") +
geom_point(data = subset(PR_2016_boat_logs, grepl("A", fieldid) == TRUE | grepl("B", fieldid) == TRUE), aes(x = lon, y = lat), size = 3, color = "darkgreen") +
annotate(geom = "text", label = "Fish", y = 17.4, x = -66.5)
blank<-rectGrob(gp=gpar(col="white"))
grid.arrange(a, blank, c, nrow =3, heights = c(2, 0.2, 2))
The relative dimensions look good, but when I knit the document, the plots are too small. How do I change the absolute width and height of the plots?
Thanks in advance.
The question relates to this: Line graph customization (add circles, colors), but since I got a new task, I created a new question.
So again my data frame is the same as in the question I've posted in a link. With code below and (little of my own modification) that was given to me by #beetroot
value <- c(9, 4, 10, 7, 10,
10, 10, 4, 10,
4, 10, 2, 5, 5, 4)
names <- c("a","b",
"c","d","e",
"f", "g","h",
"i","j","k","l",
"m","n","p")
df <- data.frame(value, names)
df$names <- as.character(df$names)
df$part <- rep(c("part3", "part2", "part1"), each = 5)
library(dplyr)
library(tidyr)
df2 <- df %>%
group_by(part, names) %>%
expand(value = min(df$value):max(df$value))
p <- ggplot() +
geom_point(data = df2, aes(x = value, y = names),
shape = 1) +
geom_point(data = df, aes(y = names, x = value, group = 1),
colour = I("red"), shape = 21, lwd = 3, fill = "red") +
geom_line(data = df, aes(y = names, x = value, group = 1),
group = I(1),color = I("red")) +
theme_bw() +
facet_wrap(~part, ncol = 1, scales = "free_y")
p + theme(strip.background = element_rect(fill="dodgerblue3"),
strip.text.x = element_text(colour = "white"))+xlab("") +ylab("")
df <- data.frame(value, names)
df$names <- as.character(df$names)
I get this output:
But now I would like to connect lines through (PART1, PART2 and PART3) so that my output would look like:
I used black color of a line just it will be more visible that I would like to connect this parts with lines.
Although I am not completely satisfied I've found solution. I computed the bounding box.
Firstly I removed facet_wrap(~part, ncol = 1, scales = "free_y") so my code looks like this:
p <- ggplot() +
geom_point(data = df2, aes(x = value, y = names),
shape = 1) +
geom_point(data = df, aes(y = names, x = value, group = 1),
colour = I("red"), shape = 21, lwd = 3, fill = "red") +
geom_line(data = df, aes(y = names, x = value, group = 1),
group = I(1),color = I("red")) +
theme_bw()
Then the trick was to create data frame and add the width and height of text directly:
# PART 1
TextFrame <- data.frame(X = 6, Y = 15.5, LAB = "PART 1")
TextFrame <- transform(TextFrame,
w = strwidth(LAB, 'inches') + 8,
h = strheight(LAB, 'inches') + 0.3
)
# PART 2
TextFrame.1 <- data.frame(X = 6, Y = 10.5, LAB = "PART 2")
TextFrame.1 <- transform(TextFrame.1,
w = strwidth(LAB, 'inches') + 8,
h = strheight(LAB, 'inches') + 0.3
)
# PART 3
TextFrame.2 <- data.frame(X = 6, Y = 4.5, LAB = "PART 3")
TextFrame.2 <- transform(TextFrame.2,
w = strwidth(LAB, 'inches') + 8,
h = strheight(LAB, 'inches') + 0.3
)
Then I've used geom_rectand geom_text to create the illusion I am after.
p + geom_rect(data = TextFrame, aes(xmin = X - w/2, xmax = X + w/2,
ymin = Y - h/2, ymax = Y + h/2), fill = "dodgerblue3") +
geom_text(data = TextFrame,aes(x = X, y = Y, label = LAB), size = 5) +
geom_rect(data = TextFrame.1, aes(xmin = X - w/2, xmax = X + w/2,
ymin = Y - h/2, ymax = Y + h/2), fill = "dodgerblue3") +
geom_text(data = TextFrame.1,aes(x = X, y = Y, label = LAB), size = 5) +
geom_rect(data = TextFrame.2, aes(xmin = X - w/2, xmax = X + w/2,
ymin = Y - h/2, ymax = Y + h/2), fill = "dodgerblue3") +
geom_text(data = TextFrame.2,aes(x = X, y = Y, label = LAB), size = 5)
And the output is: