I’m trying to use geom_curve() and scale_alpha() together, but the resulting legend guide is not cool =D.
In short, I want to plot a legend for scale_alpha() similar to the legend of scale_color_gradient().
Here is my reprex:
library(ggplot2)
library(dplyr)
theme_set(theme_void())
data_joined <- read.csv("https://gist.githubusercontent.com/kguidonimartins/6f49bf6ae13410799fb2eede56345fa5/raw/43486c44aee2aedf951e661ac576e46a5576a0da/country_data.csv", header = TRUE)
base_map <- borders(database = "world")
So, my first try was something like this. Not ideal due to the overlap. But the legend guide is ok!
data_joined %>%
ggplot() +
base_map +
geom_curve(
data = data_joined,
aes(
x = origin_x,
y = origin_y,
xend = destination_x,
yend = destination_y,
color = flow
),
arrow = arrow(length = unit(0.2, "cm")),
size = 1.5
)
So, I tried to simulate a scale_alpha() to maintain the legend guide.
data_joined %>%
ggplot() +
base_map +
geom_curve(
data = data_joined,
aes(
x = origin_x,
y = origin_y,
xend = destination_x,
yend = destination_y,
color = flow
),
arrow = arrow(length = unit(0.2, "cm")),
size = 1.5,
alpha = 0.5
) +
scale_color_gradient(low = "grey95", high = "blue", n.breaks=10)
Not good yet, maybe using a fixed color and applying alpha (in aes()) as a gradient:
data_joined %>%
ggplot() +
base_map +
geom_curve(
data = data_joined,
aes(
x = origin_x,
y = origin_y,
xend = destination_x,
yend = destination_y,
alpha = flow
),
arrow = arrow(length = unit(0.2, "cm")),
size = 1,
color = "blue"
) +
scale_alpha(n.breaks = 10)
I liked that solution but I was unable to change the legend guide. I want to maintain the legend guide similar when using scale_color_gradient(). I’m trying this from scratch changing the legend key, but the guides() don’t change the shape of the arrows in the legend.
data_joined %>%
ggplot() +
base_map +
geom_curve(
data = data_joined,
aes(
x = origin_x,
y = origin_y,
xend = destination_x,
yend = destination_y,
alpha = flow
),
arrow = arrow(length = unit(0.2, "cm")),
size = 1,
color = "blue"
) +
scale_alpha(n.breaks = 10) +
guides(alpha = guide_legend(reverse = TRUE, override.aes = list(shape = 22)))
Can someone help me with this?
Created on 2020-03-26 by the reprex package (v0.3.0)
Related
I have horizontal dots plot replotted via ggplotly
df <- data.frame (origin = c("A","B","C","D","E","F","G","H","I","J"),
Percentage = c(23,16,32,71,3,60,15,21,44,60),
rate = c(10,12,20,200,-25,12,13,90,-105,23),
change = c(10,12,-5,12,6,8,0.5,-2,5,-2)
library(ggplot2)
plt <- ggplot(df, aes(x = rate, y = factor(origin, rev(origin)))) +
geom_hline(aes(yintercept = origin), color = 'gray') +
geom_vline(xintercept = 0, linetype = 2, color = 'gray') +
geom_point(aes(color = 'Rate'), size = 10) +
geom_text(aes(label = rate), color = 'white') +
geom_point(aes(x = change, color = 'Change'), size = 10) +
geom_text(aes(label = change, x = change)) +
theme_minimal(base_size = 16) +
scale_x_continuous(labels = ~paste0(.x, '%'), name = NULL) +
scale_color_manual(values = c('#aac7c4', '#5f9299')) +
theme(panel.grid = element_blank(),
axis.text.y = element_text(color = 'gray50')) +
labs(color = NULL, y = NULL)
ggplotly(plt)
The only issue is that when I hide one of the dot from the figure, texts are still appeared (see below), so is there way to tackle this issue and hide text with circle by clicking on legend?
P.S
(setting text colour in white color = 'white' is not option for me)
You can use the fill aesthetic for the points (as long as they are shape = 21) and use the color aesthetic for the text. As long as these have the same labels for aesthetic mapping, the interactivity for both points and text will be linked.
One minor annoyance is that this changes the plotly legend labels, even though they are correct in the ggplot version. This requires a little direct manipulation of the plotly object itself:
plt <- ggplot(df, aes(x = rate, y = factor(origin, rev(origin)))) +
geom_segment(aes(x = -100, xend = 200,
y = origin, yend = origin), color = 'gray') +
geom_vline(xintercept = 0, linetype = 2, color = 'gray') +
geom_point(aes(fill = 'Rate'), shape = 21, size = 10, color = NA) +
geom_text(aes(label = rate, color = 'Rate')) +
geom_point(aes(x = change, fill = 'Change'),
color = NA, shape = 21, size = 10) +
geom_text(aes(label = change, x = change, color = "Change")) +
theme_minimal(base_size = 16) +
scale_x_continuous(labels = ~paste0(.x, '%'), name = NULL) +
scale_fill_manual(values = c('#aac7c4', '#5f9299')) +
scale_color_manual(values = c("black", "white")) +
theme(panel.grid = element_blank(),
axis.text.y = element_text(color = 'gray50')) +
labs(color = NULL, y = NULL, fill = NULL)
p <- ggplotly(plt)
p$x$data[[3]]$name <- p$x$data[[3]]$legendgroup <-
p$x$data[[4]]$name <- p$x$data[[4]]$legendgroup <- "Rate"
p$x$data[[5]]$name <- p$x$data[[5]]$legendgroup <-
p$x$data[[6]]$name <- p$x$data[[6]]$legendgroup <- "Change"
p
This gives us the following plot:
Now clicking on Rate we get:
And clicking on Change we get
I am trying to plot a polygon hull using ggplot and plotly.
While without label polygons are shown in the plot, when I add extra labels in aesthetics the polygons disappear.
library(data.table)
library(ggplot2)
library(dplyr)
library(plotly)
df <- data.table(continent = c(rep("America",3), rep("Europe",4)),
state = c("USA", "Brasil", "Chile", "Italy", "Swiss", "Spain", "Greece"),
X = rnorm(7, 5, 1),
Y = rnorm(7, -13, 1)
)
df$X_sd = sd(df$X)
df$Y_sd = sd(df$Y)
hull2 <- df %>%
group_by(continent) %>%
slice(chull(X,Y))
p <- df %>%
ggplot( aes(x=X,
y=Y,
fill = continent,
color = continent,
label=state))+
geom_polygon(data = hull2,
lwd = 1,
alpha = 0.1,
linetype = "dashed")+
geom_errorbarh(aes(xmin = X - X_sd,
xmax = X + X_sd),
size = 0.5,
alpha = 0.3) +
geom_errorbar(aes(ymin = Y - Y_sd,
ymax = Y + Y_sd),
size = 0.5,
alpha = 0.3) +
geom_point(shape=21,
color="black",
size=3)+
theme_bw()+
theme(legend.position = "none")
ggplotly(p)
How odd! If you most label = state to the aes for the last geom_ you'll get the standard warning, but it works and the state shows up in the tooltip.
The designation of color = continent shows up, as well. I am going to guess that you're not interested in having that in your tooltip, so I've added how you could change that at the end. There is a tooltip with the continent listed two times, but with the information about how to remove the color, you'll see how you might make further adjustments depending on the trace.
p <- df %>%
ggplot(aes(x = X, y = Y,
fill = continent,
color = continent #,
# label = state)
)) +
geom_polygon(data = hull2, lwd = 1,
alpha = 0.1, linetype = "dashed") +
geom_errorbarh(aes(xmin = X - X_sd,
xmax = X + X_sd),
size = 0.5, alpha = 0.3) +
geom_errorbar(aes(ymin = Y - Y_sd,
ymax = Y + Y_sd),
size = 0.5, alpha = 0.3) +
geom_point(shape = 21,
color = "black",
size = 3, aes(label = state)) +
theme_bw() + theme(legend.position = "none")
p
ggplotly(p)
To remove the color from the tooltip, assign ggplotly to an object. Then you can remove the string from the 7th and 8th trace.
p1 = ggplotly(p)
lapply(7:8,
function(i){
p1$x$data[[i]]$text <<- stringr::str_replace(p1$x$data[[i]]$text,
"continent: black<br />",
"")
})
p1
FYI, there are 8 traces that make up your plot. The first trace has the double continent text.
I would like to create a raincloud plot. I have successfully done it. But I would like to know if instead of the density curve, I can put a histogram (it's better for my dataset).
This is my code if it can be usefull
ATSC <- ggplot(data = data, aes(y = atsc, x = numlecteur, fill = numlecteur)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .5) +
geom_point(aes(y = atsc, color = numlecteur), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
geom_point(data = sumld, aes(x = numlecteur, y = mean), position = position_nudge(x = 0.25), size = 2.5) +
geom_errorbar(data = sumld, aes(ymin = lower, ymax = upper, y = mean), position = position_nudge(x = 0.25), width = 0) +
guides(fill = FALSE) +
guides(color = FALSE) +
scale_color_brewer(palette = "Spectral") +
scale_y_continuous(breaks=c(0,2,4,6,8,10), labels=c("0","2","4","6","8","10"))+
scale_fill_brewer(palette = "Spectral") +
coord_flip() +
theme_bw() +
expand_limits(y=c(0, 10))+
xlab("Lecteur") + ylab("Age total sans check")+
raincloud_theme
I think we can maybe put the "geom_histogram()" but it doesn't work
Thank you in advance for your help !
(sources : https://peerj.com/preprints/27137v1.pdf
https://neuroconscience.wordpress.com/2018/03/15/introducing-raincloud-plots/)
This is actually not quite easy. There are a few challenges.
geom_histogram is "horizontal by nature", and the custom geom_flat_violin is vertical - as are boxplots. Therefore the final call to coord_flip in that tutorial. In order to combine both, I think best is switch x and y, forget about coord_flip, and use ggstance::geom_boxploth instead.
Creating separate histograms for each category is another challenge. My workaround to create facets and "merge them together".
The histograms are scaled way bigger than the width of the points/boxplots. My workaround scale via after_stat function.
How to nudge the histograms to the right position above Boxplot and points - I am converting the discrete scale to a continuous by mapping a constant numeric to the global y aesthetic, and then using the facet labels for discrete labels.
library(tidyverse)
my_data<-read.csv("https://data.bris.ac.uk/datasets/112g2vkxomjoo1l26vjmvnlexj/2016.08.14_AnxietyPaper_Data%20Sheet.csv")
my_datal <-
my_data %>%
pivot_longer(cols = c("AngerUH", "DisgustUH", "FearUH", "HappyUH"), names_to = "EmotionCondition", values_to = "Sensitivity")
# use y = -... to position boxplot and jitterplot below the histogram
ggplot(data = my_datal, aes(x = Sensitivity, y = -.5, fill = EmotionCondition)) +
# after_stat for scaling
geom_histogram(aes(y = after_stat(count/100)), binwidth = .05, alpha = .8) +
# from ggstance
ggstance::geom_boxploth( width = .1, outlier.shape = NA, alpha = 0.5) +
geom_point(aes(color = EmotionCondition), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
# merged those calls to one
guides(fill = FALSE, color = FALSE) +
# scale_y_continuous(breaks = 1, labels = unique(my_datal$EmotionCondition))
scale_color_brewer(palette = "Spectral") +
scale_fill_brewer(palette = "Spectral") +
# facetting, because each histogram needs its own y
# strip position = left to fake discrete labels in continuous scale
facet_wrap(~EmotionCondition, nrow = 4, scales = "free_y" , strip.position = "left") +
# remove all continuous labels from the y axis
theme(axis.title.y = element_blank(), axis.text.y = element_blank(),
axis.ticks.y = element_blank())
Created on 2021-04-15 by the reprex package (v1.0.0)
I have an NMDS ordination that I've plotted using ggplot2. I've added environmental vectors on top (from the envfit() function in vegan) using geom_segment() and added corresponding labels to the same coordinates as the segments using geom_text() (code below):
ggplot() +
geom_point(data = nmds.sites.plot, aes(x = NMDS1, y = NMDS2, col = greening), size = 2) +
labs(title = "Study Area",
col = "Sites") +
geom_polygon(data = hull.data, aes(x = NMDS1, y = NMDS2, fill = grp, group = grp), alpha = 0.2) +
scale_fill_discrete(name = "Ellipses",
labels = c("High", "Moderate", "Control")) +
xlim(c(-1, 1)) +
guides(shape = guide_legend(order = 1),
colour = guide_legend(order = 2)) +
geom_segment(data = env.arrows,
aes(x = 0, xend = NMDS1, y = 0, yend = NMDS2),
arrow = arrow(length = unit(0.25, "cm")),
colour = "black", inherit.aes = FALSE) +
geom_text(data = env.arrows, aes(x = NMDS1, y = NMDS2, label = rownames(env.arrows))) +
coord_fixed() +
theme_bw() +
theme(text = element_text(size = 14))
However, since the labels are justified to centre, part of the label sometimes overlaps with the end of the arrow. I want to have the text START at the end of the arrow. In some other cases, if the arrow is pointing up, it pushes into the middle of the text. Essentially, I want to be able to see both the arrow head AND the text.
I have tried using geom_text_repel() from the ggrepel package but the placement seems random (and will also repel from other points or text in the plot (or just not do anything at all).
[EDIT]
Below are the coordinates of the NMDS vectors (this is the env.arrows object from the example code above):
NMDS1 NMDS2
Variable1 -0.46609087 0.27567532
Variable2 -0.21524887 -0.10128795
Variable3 0.59093184 0.03423775
Variable4 -0.00136418 0.46550043
Variable5 -0.30900813 -0.19659929
Variable6 0.53510347 -0.36387227
Variable7 0.66376246 -0.05220685
In the code below, we create a radial shift function to move the labels away from the arrows. The shift includes a constant amount plus an additional shift that varies with the absolute value of the cosine of the label's angle to the x-axis. This is because labels with theta near 0 or 180 degrees have a larger length of overlap with the arrows, and therefore need to be moved farther, than labels with theta near 90 or 270 degrees.
You may need to tweak the code a bit to get the labels exactly where you want them. Also, you'll likely need to add an additional adjustment if the variable names can have different widths.
One additional note: I've turned the variable names into a data column. You should do this with your data as well and then map that data column to the label argument of aes. Using rownames(env.arrows) for the labels reaches outside the ggplot function environment to the external data frame env.arrows and breaks the mapping to the data frame you've provided in the data argument to geom_text (although it likely won't cause a problem in this particular case).
library(tidyverse)
library(patchwork)
# data
env.arrows = read.table(text=" var NMDS1 NMDS2
Variable1 -0.46609087 0.27567532
Variable2 -0.21524887 -0.10128795
Variable3 0.59093184 0.03423775
Variable4 -0.00136418 0.46550043
Variable5 -0.30900813 -0.19659929
Variable6 0.53510347 -0.36387227
Variable7 0.66376246 -0.05220685", header=TRUE)
# Radial shift function
rshift = function(r, theta, a=0.03, b=0.07) {
r + a + b*abs(cos(theta))
}
# Calculate shift
env.arrows = env.arrows %>%
mutate(r = sqrt(NMDS1^2 + NMDS2^2),
theta = atan2(NMDS2,NMDS1),
rnew = rshift(r, theta),
xnew = rnew*cos(theta),
ynew = rnew*sin(theta))
p = ggplot() +
geom_segment(data = env.arrows,
aes(x = 0, xend = NMDS1, y = 0, yend = NMDS2),
arrow = arrow(length = unit(0.25, "cm")),
colour = "black", inherit.aes = FALSE) +
geom_text(data = env.arrows, aes(x = NMDS1, y = NMDS2, label = var)) +
coord_fixed() +
theme_bw() +
theme(text = element_text(size = 14))
pnew = ggplot() +
geom_segment(data = env.arrows,
aes(x = 0, xend = NMDS1, y = 0, yend = NMDS2),
arrow = arrow(length = unit(0.2, "cm")),
colour = "grey60", inherit.aes = FALSE) +
geom_text(data = env.arrows, aes(x = xnew, y = ynew, label = var), size=3.5) +
coord_fixed() +
theme_bw() +
theme(text = element_text(size = 14)) +
scale_x_continuous(expand=expansion(c(0.12,0.12))) +
scale_y_continuous(expand=expansion(c(0.07,0.07)))
p / pnew
I need to create a European map to show the distribution of a variable across countries. I need the map in black and white. I rely on ggplot and followed this approach as an example. I changed the legend based on this blogpost. All this works fine with this result:
My question is how to change the map in a way that the countries where I am missing the information for fill and are shown as pure white have a texture over-them (I am thinking diagonal lines)?
Since my script is a bit messy, I just show the ggplot here, without the data preparation part:
require(ggplot2)
plotCoords <- read.csv("http://eborbath.github.io/stackoverflow/PlotCoords.csv")
showCoords <- read.csv("http://eborbath.github.io/stackoverflow/showCoords.csv")
ggplot() +
geom_polygon(
data = plotCoords,
aes(x = long, y = lat, group = group),
fill = "white", colour = "darkgrey", size = 0.6) +
geom_polygon(
data = showCoords,
aes(x = long, y = lat, group = group),
fill = "grey", colour = "black", size = 0.6) +
geom_polygon(
data = showCoords,
aes(x = long, y = lat, group = group, fill = sh_left),
colour = "black", size = 0.1) +
scale_fill_gradient(
low = "gray90", high = "gray0",
name = "Share of left-wing protesters",
guide = guide_colorbar(
direction = "horizontal",
barheight = unit(2, units = "mm"),
barwidth = unit(50, units = "mm"),
draw.ulim = F,
title.position = 'top',
title.hjust = 0.5,
label.hjust = 0.5
)) +
scale_x_continuous(element_blank(), breaks = NULL) +
scale_y_continuous(element_blank(), breaks = NULL) +
coord_map(xlim = c(-26, 47), ylim = c(32.5, 73)) +
theme_bw() +
theme(legend.justification = c(-0.4, 1.2), legend.position = c(0, 1))
The first geom_polygon is for the background, I assume I have to edit the fill there. Obviously, this is important to differentiate no information from low values of the variable I plot. Given I have to rely on black and white I came up with the idea of using textures, but I am open to alternative suggestions.
Thanks!
it's technically possible with gridSVG, but not sure it's worth the effort.
I created a new geom based on GeomPolygon, and modified the draw_panel method to return,
gl <- by(munched, munched$group,
function(m){
g <- polygonGrob(m$x, m$y, default.units = "native")
patternFillGrob(g,
pattern = pattern(linesGrob(gp=gpar(col="red",lwd=3)),
width = unit(2, "mm"), height = unit(2, "mm"),
dev.width = 1, dev.height = 1))
}, simplify = FALSE)
gTree(children = do.call(gList, gl))