I am trying to make my beautiful ggplot map interactive with a tooltip using ggplotly. But the map rendered with ggploty is not beautiful.
Here is a picture of my map with only ggplot:
Here is a picture of my map when using ggplotly. It removes the legend and make the map ugly:
Is there another way of making my ggplot map interactive with a tooltip? And also ggplotly takes some time to render the interactive map:
Here is my sample code for my ggplot:
ggplot(data = sdpf_f, aes( fill = n,x = long, y = lat, group = group, text = tooltip)) +
geom_polygon(color = "white") +
theme_void() +
scale_fill_continuous(low="#c3ffff", high="#0291da",
guide = guide_legend(title.position = "top", label.position = "bottom", keywidth = 2,
keyheight = 0.5,
title = "Number of agreements"),na.value="lightgrey"
) +
theme(legend.position="bottom") +
coord_map()
Thanks & kind regards,
Akshay
I don't have your data and this isn't exactly the same, but it's fairly close to what I think you're expecting.
The libraries:
I called tidyverse for the plotting and piping. I called maps for the data I used and plotly for the Plotly graph.
I used a function that is derived from one of the ways ggplot sets the aspect ratio. I know I found this function on SO, but I don't remember who wrote it.
library(tidyverse)
library(maps)
library(plotly)
map_aspect = function(x, y) {
x.center <- sum(range(x)) / 2
y.center <- sum(range(y)) / 2
x.dist <- ggplot2:::dist_central_angle(x.center + c(-0.5, 0.5), rep(y.center, 2))
y.dist <- ggplot2:::dist_central_angle(rep(x.center, 2), y.center + c(-0.5, 0.5))
y.dist / x.dist
}
I had to create data as your question is not reproducible. I figured I would include it, so that my answer was reproducible.
ms <- map_data("state") %>%
mutate(n = ifelse(str_detect(region, "^a"), 1.0,
ifelse(str_detect(region, "^o"), 1.5,
ifelse(str_detect(region, "^t"), 2.0,
ifelse(str_detect(region, "^s"), 2.5,
ifelse(str_detect(region, "^w"),
3.0,
NA))))))
I modified your ggplot call. The only change is coord_fixed instead of coord_map. I did this so that Plotly could interpret the aspect ratio correctly. Within coord_fixed, I used the function map_aspect.
gp <- ggplot(data = ms, aes(fill = n, x = long, y = lat,
group = group, text = tooltip)) +
geom_polygon(color = "white") +
theme_void() +
scale_fill_continuous(low="#c3ffff", high="#0291da",
guide = guide_legend(title.position = "top",
label.position = "bottom",
keywidth = 2,
keyheight = 0.5,
title = "Number of agreements"),
na.value="lightgrey"
) +
theme(legend.position="bottom") +
coord_fixed(with(ms, map_aspect(long, lat)))
Then I created a Plotly object. I set some requirements for the layout, as well (horizontal legend at the bottom, with the legend title above the elements—similar to the legend in your ggplot call).
pp <- ggplotly(gp) %>%
layout(legend = list(orientation = "h", valign = "bottom",
title = list(side = "top"),
x = .02),
xaxis = list(showgrid = F), yaxis = list(showgrid = F),
showlegend = T)
Next, I needed to add the information for the legend. I chose to name the traces (which are split by color). I started by creating a vector of the names of the traces (which is what you see in the legend). I added a "" at the end, so that the NA-colored states wouldn't have a named trace (so they won't show in the legend).
This is likely something you'll need to change for your data.**
# the color values and the last one, which is for NAs, no legend
nm <- seq(1, 3, by = .5) %>% sprintf(fmt = "%.1f") %>% append(., "")
Then I wanted to ensure that showlegend was true for all but the NA (light gray) states. I created a vector of T and F.
legs <- c(rep(TRUE, 5), FALSE)
Then I added these to the plot.
invisible(lapply(1:length(pp$x$data),
function(i){
pp$x$data[[i]]$name <<- nm[i]
pp$x$data[[i]]$showlegend <<- legs[i]
}))
Related
I am trying to do something similar to what is described in the blog here but using R with ggtree, ggmap, and ggplot2.
I want to be able to combine the plots of the phylogenetic tree and the map showing the sampling locations of the tips on a geographical map, and link the tips to the sampling locations by segments. That would allow to see ie. if some clusters appears to specific geographical locations (ie north, south of an area) and would allow also to display different data with tips colors/symbols. This would be at first used as exploratory graphs, but this can also be used later on for publication ...
I would like to use the gg* libraries (ggplot2, ggtree, ggmap ...) to do that, because then it is easy to modify plots to display different variables. Here is a dummy script to describe how I do that so far. I do the tree and map plot separately and combine them. I want also to be able to have a common legend for the two plots. I am stuck after combining, I do not find out how to link the points from the tree plot to the points on the map plot with segments.
Anyone with ideas / possible solutions on how to do that or an alternative approach ?
Here is the dummy dataset to illustrate for creating the plots
library(patchwork)
library(ggpubr)
library(ggtree)
library(tidyverse)
library(ggmap)
library(ggplot2)
mytree <- ggtree::rtree(100)
mymap <- ggmap::get_map(c(left = 0.903, bottom = 44.56, right = 6.72, top = 49.38),
scale = 4, maptype = "terrain",
source = "stamen",
color = "bw")
save(mymap, file = "dummy_map.Rdata")
ggmap require API key to create the map (sorry I cannot share the API key, but you can make one for free on google cloud). I saved the map object and its downloadable from here.
# Loading the map
load("dummy_map.Rdata")
# creating dummy metadata
mytree_data <- tidytree::as_tibble(mytree)
mymetadata <- mytree_data %>%
dplyr::filter(!is.na(label)) %>%
tibble::add_column(year = sample(seq(1990, 2020, by = 1), 100, replace = T),
lon = sample(seq(0.91, 6.7, by = 0.01), 100, replace = T),
lat = sample(seq(44.56, 49.38, by = 0.01), 100, replace = T)) %>%
dplyr::rename(id = label) %>%
dplyr::select(id, year, lat, lon)
# plotting the phylogenetic tree
# phylogenetic tree example
mytree_plot <-
ggtree::ggtree(mytree, layout = "rectangular", ladderize = T, lwd = .2) %<+%
mymetadata +
geom_tippoint(aes(color = year), size = 1, show.legend = T) +
scale_color_gradient(low='red', high="blue", space = "Lab",
limits = c(NA, NA), na.value = "black",
n.breaks = 8,
guide = "colorbar") +
geom_tiplab(aes(label = label), size = 1, offset = -1E-10) +
geom_treescale(fontsize = 2, linesize = 0.5, offset = 1) +
theme(legend.position = c(0.9,0.15),
legend.title = element_text(size = 8),
legend.text = element_text(size = 6),
plot.title = element_text(hjust = 1))
mytree_plot
For some reason, I have to add the theme to be able to see the legend for the points, it is not created automatically. This should not occur. If anyone see what I am doing wrong here please let me know.
Then I add the sampling locations on the map, and deactivate the legend that is common with the tree legend
mymap_plot <- ggmap(mymap, n_pix = 340, darken = c(0.6, "white"))+
geom_point(data = mymetadata,
aes(x = lon, y = lat, color = year),
size = 2, alpha = .8, na.rm = T) +
scale_color_gradient(low='red', high="blue", space = "Lab",
limits = c(NA, NA),
n.breaks = 8,
guide = "colorbar") +
guides(color = F)
mymap_plot
Then I combine the tree plot and the map plot together. I tried with "patchwork" and "ggpubr" packages.
So far it appear easier to combine plots and draw a single legend with ggpubr, so this is currently my first choice at combining plot
# combining plots with patchwork
combined_plot <- mytree_plot + mymap_plot
# combining plots with ggpubr
# which I like better because it allows to combine the legends which is usefull
# when more variables are used ie shape for uncertainty location
other_combined <- ggarrange(mytree_plot, mymap_plot,
ncol = 2,
labels = c("A", "B"),
align = "hv",
legend = "bottom",
common.legend = T)
Here is the combined plot of the phylogenetic tree (ggtree) and the map (ggmap) obtained with ggpubr.
I am stuck at this point.
I need a way to add segments between corresponding points at the tips of the tree to the corresponding sampling locations of each tip on the map
Any solutions/ideas on how I could do that?
I really like the aesthetics of The Economist magazine and I use the theme_economist often. However, I am curious as to how they create the red lines in the top left in a lot of their charts. See image below and where I circled.
This question is a mix of "how to annotate outside the plot area" and "how to annotate in npc coordinates". Therefore, I offer two options.
Both unfortunately require a bit of trial and error in order to correctly place the segment. For option 1, it is the y coordinate which we have to "guess", and for option 2 it's x!
In order to make y slightly less guess work, I tried an approach to position is relative to the default axis breaks. using the fabulous information from this answer. This is of course not necessary, one can also simply trial and error.
For option 2, I modified a function from user Allan Cameron's answer here. He mentions a way to figure out x and y, I guess one could use the title, and then place the annotation based on that.
library(ggplot2)
p <-
ggplot(mtcars, aes(mpg, wt)) +
geom_point() +
ggtitle("lorem ipsum") +
theme(plot.margin = margin(t = 1.5, unit = "lines")) # this is always necessary
# OPTION 1
# semi-programmatic approach to figure out y coordinates
y_defaultticks <- with(mtcars, labeling::extended(range(wt)[1], range(wt)[2], m = 5))
y_default <- y_defaultticks[2] - y_defaultticks[1]
y_seg <- max(mtcars$wt) + 0.75 * y_default
p +
annotate(geom = "segment", x = - Inf, xend = 12, y = y_seg, yend = y_seg,
color = "red", size = 5) +
coord_cartesian(clip = "off", ylim = c(NA, max(mtcars$wt)),
xlim = c(min(mtcars$mpg), NA))
# OPTION 2
annotate_npc <- function(x, y, height, width, ...) {
grid::grid.draw(grid::rectGrob(
x = unit(x, "npc"), y = unit(y, "npc"), height = unit(height, "npc"), width = unit(width, "npc"),
gp = grid::gpar(...)
))
}
p
annotate_npc(x = 0.07, y = 1, height = 0.05, width = 0.05, fill = "red", col = NA)
Created on 2021-01-02 by the reprex package (v0.3.0)
I'm trying to combine ggplot and plotly together to make a timeline.
It's working great, but have an issue using the legend. The code below replicates what I'm trying to do.
library(ggplot2)
library(plotly)
x=1:10
df2 = data.frame(x,y = 2*x+rnorm(length(x)),lab = as.factor(c("col1","col2")))
status_colors <- c("#0070C0", "#00B050", "#FFC000", "#C00000","darkgreen","purple","darkgrey","blue","salmon","darkorange","black","navy","darkblue")
status_levels <- c(sort(unique(df2$lab)))
p= ggplot(df2,aes(x=x, y=y, col = lab)) + geom_point() + labs(col="labtest") +
scale_color_manual(values=status_colors,
labels=status_levels, drop = FALSE)
fig = ggplotly(p, tooltip = NULL)
fig %>%
add_text(
x = df2$x,
y = ifelse(df2$y>0,df2$y+0.05,df2$y-0.05),
text = df2$lab,
hovertext = df2$lab,
hoverinfo = 'text',
mode ="text",
textfont = list(color=status_colors[df2$lab], size =10),
marker = list(color=status_colors[df2$lab], size = 0.00001),
showlegend = T,
textposition = ifelse(df2$y>0,"top center","bottom center")
)
Basically, as you can see in the image, the label of each point is the same colour as the point that it is attached to. But whenever I add the legend of the label text from plotly, there is a new legend that appears that controls all the points regardless of their colour.
Thus, is there a way to combine the ggplot legend with the plotly legend so that it's only written col1 and col2 with the right colour and that whenever I interact with the points of a certain colour, the label attached to it stays there?
In other words, is there a way to remove the "trace 2" legend and make the "add_text" know that there is a legend already created in ggplot?
If I got you right, besides getting rid of the second legend (which can be simply achievd by setting showlegend = FALSE) you want one legend to control both the points and the labels. This can be achieved via legendgroups. Instead of adding labels with one add_text you could (or have to? Sorry. Still a plotly newbie so perhaps there is a simpler approach) add the labels via two add_text calls one for each col. Instead of copy and paste (which is probably okay for just two cols, but with more cols ...) you can add these via the magic of purrr::reduce to the ggplotly object. Try this:
library(ggplot2)
library(plotly)
library(purrr)
x=1:10
df2 = data.frame(x,y = 2*x+rnorm(length(x)),lab = as.factor(c("col1","col2")))
status_colors <- c("#0070C0", "#00B050", "#FFC000", "#C00000","darkgreen","purple","darkgrey","blue","salmon","darkorange","black","navy","darkblue")
status_levels <- c(sort(unique(df2$lab)))
p= ggplot(df2,aes(x=x, y=y, col = lab)) + geom_point() +
labs(col="labtest") +
scale_color_manual(values=status_colors,
labels=status_levels, drop = FALSE)
fig = ggplotly(p, tooltip = NULL)
purrr::reduce(c("col1", "col2"), ~ .x %>% add_text(
data = filter(df2, lab == .y),
x = ~x,
y = ~ifelse(y > 0, y + 0.05, y-0.05),
text = ~lab,
hovertext = ~lab,
hoverinfo = 'text',
mode ="text",
textfont = list(color= ~status_colors[lab], size =10),
marker = list(color= ~status_colors[lab], size = 0.00001),
showlegend = FALSE,
textposition = ~ifelse(y>0, "top center","bottom center"),
legendgroup = .y
), .init = fig)
BTW: I also simplified the code a little bit. You don't need df2$... because (gg)plotly already knows the data.
I have a fairly simple and probably common task, plotting a raster dataset with countour lines and adding country borders together in one plot, however I did not find a solution anywhere. There are a a few hints available (such as this one), but no raster dataset is used there and I can't get it to work.
The dataset I am using is actually in netcdf format and available here (15mb in size) and contains about 40 years of gridded precipitation data.
Here is my line of code:
setwd("...netcdf Data/GPCP")
library("raster")
library("maps")
nc_brick79_17 <- brick("precip.mon.mean.nc") # load in the ncdf data as a
raster brick
newextent <- c(85, 125, -20, 20) # specify region of interest
SEA_brick <- crop(nc_brick79_17, newextent) # crop the region
day1 <- SEA_brick[[1]] # select very first day as example
colfunc<-colorRampPalette(c("white","lightblue","yellow","red","purple")) # colorscale for plotting
So it works of course when I just plot the raster data together with a map overlaid:
plot(day1, col=(colfunc(100)), interpolate=F, main="day1",legend.args=list(text='mm/hr', side=4,font=1, line=2.5, cex=1.1))
map("world", add=TRUE, lwd=0.5, interior = FALSE, col = "black")
We get this plot (Raster Plot with country borders added)
Now the code I use to generate the contour plot is the following:
filledContour(day1,zlim=c(0,20),color=colorRampPalette(c("white","lightblue","yellow","red","purple")),
xlab = "Longitude (°)", ylab = "Latitude (°)")
map("world", add=TRUE, lwd=0.5, interior = FALSE, col = "black") # add map overlay
I end up with a plot where obviously the country borders do not align and are even covering the colorbar.
Contour plot with map overlay shifted
In this last part I am trying to add the country boundaries to the contour plot, but it does not work, even though it should I assume. The map is simply not there, no error though:
filledContour(day1, zlim=c(0,20),
color.palette = colorRampPalette(c("white","lightblue","yellow","red","purple")),
xlab = "Longitude (°)", ylab = "Latitude (°)",
xlim = c(90, 120), ylim = c(-20, 20), nlevels = 25,
plot.axes = {axis(1); axis(2);
map('world', xlim = c(90, 120), ylim = c(-20, 20), add = TRUE, lwd=0.5, col = "black")})
From that line of code I get this plot.
Contour plot but no country borders added
What could I improve or is there any mistake somewhere? Thank you!
I chose to use ggplot here. I leave two maps for you. The first one is the one you created. This is a replication with ggplot. The second one is the one you could not produce. There are many things to explain. But I am afraid I do not have enough time to write all. But I left some comments in my code below. Please check this question to learn more about the second graphic. Finally, I'd like to give credit to hrbrmstr who wrote a great answer in the linked question.
library(maptools)
library(akima)
library(raster)
library(ggplot2)
# This is a data set from the maptools package
data(wrld_simpl)
# Create a data.frame object for ggplot. ggplot requires a data frame.
mymap <- fortify(wrld_simpl)
# This part is your code.
nc_brick79_17 <- brick("precip.mon.mean.nc")
newextent <- c(85, 125, -20, 20)
SEA_brick <- crop(nc_brick79_17, newextent)
day1 <- SEA_brick[[1]]
# Create a data frame with a raster object. This is a spatial class
# data frame, not a regular data frame. Then, convert it to a data frame.
spdf <- as(day1, "SpatialPixelsDataFrame")
mydf <- as.data.frame(spdf)
colnames(mydf) <- c("value", "x", "y")
# This part creates the first graphic that you drew. You draw a map.
# Then, you add tiles on it. Then, you add colors as you wish.
# Since we have a world map data set, we trim it at the end.
ggplot() +
geom_map(data = mymap, map = mymap, aes(x = long, y = lat, map_id = id), fill = "white", color = "black") +
geom_tile(data = mydf, aes(x = x, y = y, fill = value), alpha = 0.4) +
scale_fill_gradientn(colors = c("white", "lightblue", "yellow", "red", "purple")) +
scale_x_continuous(limits = c(85, 125), expand = c(0, 0)) +
scale_y_continuous(limits = c( -20, 20), expand = c(0, 0)) +
coord_equal()
ggplot version of filled.contour()
# As I mentioned above, you want to study the linked question for this part.
mydf2 <- with(mydf, interp(x = x,
y = y,
z = value,
xo = seq(min(x), max(x), length = 400),
duplicate = "mean"))
gdat <- interp2xyz(mydf2, data.frame = TRUE)
# You need to draw countries as lines here. You gotta do that after you draw
# the contours. Otherwise, you will not see the map.
ggplot(data = gdat, aes(x = x, y = y, z = z)) +
geom_tile(aes(fill = z)) +
stat_contour(aes(fill = ..level..), geom = "polygon", binwidth = 0.007) +
geom_contour(color = "white") +
geom_path(data = mymap, aes(x = long, y = lat, group = group), inherit.aes = FALSE) +
scale_x_continuous(limits = c(85, 125), expand = c(0, 0)) +
scale_y_continuous(limits = c(-20, 20), expand = c(0, 0)) +
scale_fill_gradientn(colors = c("white", "lightblue", "yellow", "red", "purple")) +
coord_equal() +
theme_bw()
Given the following code using the ggbiplot library available via devtools::install.github() :
library(ggbiplot)
data(iris)
log.ir <- log(iris[, 1:4])
ir.species <- iris[, 5]
ir.pca <- prcomp(log.ir, center = TRUE, scale. = TRUE)
g <- ggbiplot(ir.pca, obs.scale = 1, var.scale = 1, groups = ir.species)
g <- g + theme(legend.direction = 'vertical', legend.position = 'right')
g <- g + scale_color_manual(values=c("blue", "red", "green"))
print(g)
what is the best way to customize the border of the data points based on the grouping? I used scale_color_manual() to customize the color of those data points, but I can't think of a way to do that for the border.
Thanks
Assuming you want to adjust the border of the data points themselves...
The ggbiplot() call itself won't give you this flexibility but setting alpha = 0 will make the points plotted by ggbiplot invisible or really 100% transparent. Then you can make a separate layer with a geom_point() call where you specify shape as one of the 5 shapes (21-25) that have a fill (the middle) and a color (the boarder) aesthetic.
ggbiplot(ir.pca, obs.scale = 1, var.scale = 1, groups = ir.species, alpha = 0) +
theme(legend.direction = 'vertical', legend.position = 'right') +
scale_color_manual(values=c("blue", "red", "green")) +
scale_fill_manual(values = c("red", "green", "blue")) + # just offset by one to show
geom_point(size = 3, shape = 21, aes(fill = groups, color = groups))
PS It's probably always a good idea to include in your question that the package you are using is only available via devtools::install.github() and not the standard install.packages()