Related
I am working on making a pictogram using r where the categories are along the x axis and the amount of the thing that belongs in each category is represented by the number of icons. I would like to leave the ticks on the y axis to make it easy to see how many of the thing there are, but the icons start a little above 0 and finish a little above the real value, giving the appearance that the value is higher than it really is.
# install.packages("waffle", repos = "https://cinc.rud.is")
library(waffle)
data <- data.frame(
x = c('John', 'James', 'Jeff', 'Joe', 'Jake'),
ht = c(72, 71, 73, 69, 66),
icon = rep('rocket', 5)
)
ggplot(data, aes(label= x,
values = ht,
color=icon)) +
geom_pictogram(n_rows=5, make_proportional=FALSE, size=5, flip=TRUE) +
facet_wrap(~x, nrow = 1, strip.position = "bottom") +
scale_x_discrete() +
scale_y_continuous(labels=function(x) x * 5, # multiplyer should be same as n_rows
expand = c(0,0),
limits = c(0,20)) +
scale_label_pictogram(
name = NULL,
values = c(
'rocket' = 'rocket'
)) +
theme(legend.position = "none")
This results in a good approximation of what I'm looking for, but without adjusting the alignment of the icons and the y-axis ticks/labels, it doesn't work.
I have been unable to find any way to move the y-axis ticks/labels higher or to shift the icons lower, either of which would work for this purpose. I have considered removing the y-axis ticks/labels and labeling the amount of the data just above each set of icons, but have been unable to get annotate or geom_text to work. I expect there's something simple I'm missing, but have no idea what it is at this point. I've also tried making this chart with echarts4r and waffle, though I've run into different issues with each that led me back to geom_pictogram.
One option would be to use geom_text with stat="waffle". Doing so allows to shift the icons aka labels via position_nudge:
library(ggplot2)
library(waffle)
ggplot(data, aes(
label = x,
values = ht,
color = icon
)) +
geom_text(
stat = "waffle", n_rows = 5, make_proportional = FALSE, size = 5, flip = TRUE,
family = "Font Awesome 5 Free",
position = position_nudge(y = -.9), vjust = 0
) +
facet_wrap(~x, nrow = 1, strip.position = "bottom") +
scale_x_discrete() +
scale_y_continuous(
labels = function(x) x * 5,
expand = c(0, 0),
limits = c(0, 20)
) +
scale_label_pictogram(
name = NULL,
values = c(
"rocket" = "rocket"
)
) +
theme(legend.position = "none")
If you want to use geom_pictogram (which always seems to start at 1), you could set the scale limits and add a custom label function to remove 1 from the values.
library(ggplot2)
library(waffle)
ggplot(data, aes(label= x,
values = ht,
color=icon)) +
geom_pictogram(n_rows=5,
size=5,
flip=TRUE) +
facet_wrap(~x, nrow = 1, strip.position = "bottom") +
scale_x_discrete() +
scale_label_pictogram(
name = NULL,
values = c(
'rocket' = 'rocket'
)) +
scale_y_continuous(
expand = c(0,0),
## here
limits = c(1, NA), labels = ~ .x-1, breaks = seq(1,20,5)) +
theme(legend.position = "none")
I would like to add labels to the end of lines in ggplot, avoid them overlapping, and avoid them moving around during animation.
So far I can put the labels in the right place and hold them static using geom_text, but the labels overlap, or I can prevent them overlapping using geom_text_repel but the labels do not appear where I want them to and then dance about once the plot is animated (this latter version is in the code below).
I thought a solution might involve effectively creating a static layer in ggplot (p1 below) then adding an animated layer (p2 below), but it seems not.
How do I hold some elements of a plot constant (i.e. static) in an animated ggplot? (In this case, the labels at the end of lines.)
Additionally, with geom_text the labels appear as I want them - at the end of each line, outside of the plot - but with geom_text_repel, the labels all move inside the plotting area. Why is this?
Here is some example data:
library(dplyr)
library(ggplot2)
library(gganimate)
library(ggrepel)
set.seed(99)
# data
static_data <- data.frame(
hline_label = c("fixed_label_1", "fixed_label_2", "fixed_label_3", "fixed_label_4",
"fixed_label_5", "fixed_label_6", "fixed_label_7", "fixed_label_8",
"fixed_label_9", "fixed_label_10"),
fixed_score = c(2.63, 2.45, 2.13, 2.29, 2.26, 2.34, 2.34, 2.11, 2.26, 2.37))
animated_data <- data.frame(condition = c("a", "b")) %>%
slice(rep(1:n(), each = 10)) %>%
group_by(condition) %>%
mutate(time_point = row_number()) %>%
ungroup() %>%
mutate(score = runif(20, 2, 3))
and this is the code I am using for my animated plot:
# colours for use in plot
condition_colours <- c("red", "blue")
# plot static background layer
p1 <- ggplot(static_data, aes(x = time_point)) +
scale_x_continuous(breaks = seq(0, 10, by = 2), expand = c(0, 0)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10), limits = c(2, 3), expand = c(0, 0)) +
# add horizontal line to show existing scores
geom_hline(aes(yintercept = fixed_score), alpha = 0.75) +
# add fixed labels to the end of lines (off plot)
geom_text_repel(aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0) +
coord_cartesian(clip = 'off') +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank(),
plot.margin = margin(5.5, 120, 5.5, 5.5))
# animated layer
p2 <- p1 +
geom_point(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
geom_line(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition),
show.legend = FALSE) +
scale_color_manual(values = condition_colours) +
geom_segment(data = animated_data,
aes(xend = time_point, yend = score, y = score, colour = condition),
linetype = 2) +
geom_text(data = animated_data,
aes(x = max(time_point) + 1, y = score, label = condition, colour = condition),
hjust = 0, size = 4) +
transition_reveal(time_point) +
ease_aes('linear')
# render animation
animate(p2, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)
Suggestions for consideration:
The specific repelling direction / amount / etc. in geom_text_repel is determined by a random seed. You can set seed to a constant value in order to get the same repelled positions in each frame of animation.
I don't think it's possible for repelled text to go beyond the plot area, even if you turn off clipping & specify some repel range outside plot limits. The whole point of that package is to keep text labels away from one another while remaining within the plot area. However, you can extend the plot area & use geom_segment instead of geom_hline to plot the horizontal lines, such that these lines stop before they reach the repelled text labels.
Since there are more geom layers using animated_data as their data source, it would be cleaner to put animated_data & associated common aesthetic mappings in the top level ggplot() call, rather than static_data.
Here's a possible implementation. Explanation in annotations:
p3 <- ggplot(animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
# static layers (assuming 11 is the desired ending point)
geom_segment(data = static_data,
aes(x = 0, xend = 11, y = fixed_score, yend = fixed_score),
inherit.aes = FALSE, colour = "grey25") +
geom_text_repel(data = static_data,
aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0, inherit.aes = FALSE,
seed = 123, # set a constant random seed
xlim = c(11, NA)) + # specify repel range to be from 11 onwards
# animated layers (only specify additional aesthetic mappings not mentioned above)
geom_point() +
geom_line() +
geom_segment(aes(xend = time_point, yend = score), linetype = 2) +
geom_text(aes(x = max(time_point) + 1, label = condition),
hjust = 0, size = 4) +
# static aesthetic settings (limits / expand arguments are specified in coordinates
# rather than scales, margin is no longer specified in theme since it's no longer
# necessary)
scale_x_continuous(breaks = seq(0, 10, by = 2)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10)) +
scale_color_manual(values = condition_colours) +
coord_cartesian(xlim = c(0, 13), ylim = c(2, 3), expand = FALSE) +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank()) +
# animation settings (unchanged)
transition_reveal(time_point) +
ease_aes('linear')
animate(p3, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)
I having some trouble in text annotation using ggplot2. I hope someone here, can help me out.
I want to annotate differing text to fix position on all faceted plots. I could not find any solutions, how to do this when I use "free_y" scale.
I used this code:
library(ggplot2)
library(grid)
## Data.
d1 = data.frame(sim1 = runif(100), n1 = 500, y1 = runif(100),
group1 = rep(c("A", "B"), each = 250))
d2 = d1[!duplicated(d1$group1), ]
## Consistent number for all plot.
grob1 <- grobTree(textGrob(paste("N = ", d2[, 2]),
x = 0.01, y = 0.95, hjust = 0,
gp = gpar(col = "black", fontsize = 13,
fontface = "bold")))
## Varying number for facets.
grob2 <- grobTree(textGrob(d2$sim1, x = 0.01, y = 0.85, hjust = 0,
gp = gpar(col = "black", fontsize = 13,
fontface = "bold")))
grob3 <- grobTree(textGrob(d2$y1, x = 0.01, y = 0.75, hjust = 0,
gp = gpar(col = "black", fontsize = 13,
fontface = "bold")))
## Plot.
ggplot(d1, aes(log2(sim1))) +
geom_density() +
scale_x_continuous("") +
scale_y_continuous("") +
facet_wrap(~ group1, ncol = 1, scales = "free_y") +
annotation_custom(grob1) +
annotation_custom(grob2) +
annotation_custom(grob3)
However, it always annotates the first element to all plots.
Well, I agree with #baptiste. Here is an idea -- first create a data frame.
ann_text = data.frame(x= c(...), value= c(...), lab=c(...) )
In this, first two vectors will locate the positions and last one is vector of labels. Then use --
geom_text(data = ann_text, aes(label=lab), size= 5, colour = "red", fontface= ...)
etc.
I have 6 plots which I want to align neatly in a two-step manner (see picture). Preferably, I'd like to add nice arrows.
Any ideas?
UPD. As my question started to gather negative feedback, I want to clarify that I've checked all the (partially) related questions at SO and found no indication on how to position ggplots freely on a "canvas". Moreover, I cannot think of a single way to draw arrows between the plots. I'm not asking for a ready made solution. Please, just indicate the way.
Here's an attempt at the layout you want. It requires some formatting by hand, but you can probably automate much of that by taking advantage of the coordinate system built into the plot layout. Also, you may find that grid.curve is better than grid.bezier (which I used) for getting the arrow curves shaped exactly the way you want.
I know just enough about grid to be dangerous, so I'd be interested in any suggestions for improvements. Anyway, here goes...
Load the packages we'll need, create a couple of utility grid objects, and create a plot to lay out:
library(ggplot2)
library(gridExtra)
# Empty grob for spacing
#b = rectGrob(gp=gpar(fill="white", col="white"))
b = nullGrob() # per #baptiste's comment, use nullGrob() instead of rectGrob()
# grid.bezier with a few hard-coded settings
mygb = function(x,y) {
grid.bezier(x=x, y=y, gp=gpar(fill="black"),
arrow=arrow(type="closed", length=unit(2,"mm")))
}
# Create a plot to arrange
p = ggplot(mtcars, aes(wt, mpg)) +
geom_point()
Create the main plot arrangement. Use the empty grob b that we created above for spacing the plots:
grid.arrange(arrangeGrob(p, b, p, p, heights=c(0.3,0.1,0.3,0.3)),
b,
arrangeGrob(b, p, p, b, p, heights=c(0.07,0.3, 0.3, 0.03, 0.3)),
ncol=3, widths=c(0.45,0.1,0.45))
Add the arrows:
# Switch to viewport for first set of arrows
vp = viewport(x = 0.5, y=.75, width=0.09, height=0.4)
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add top set of arrows
mygb(x=c(0,0.8,0.8,1), y=c(1,0.8,0.6,0.6))
mygb(x=c(0,0.6,0.6,1), y=c(1,0.4,0,0))
# Up to "main" viewport (the "full" canvas of the main layout)
popViewport()
# New viewport for lower set of arrows
vp = viewport(x = 0.6, y=0.38, width=0.15, height=0.3, just=c("right","top"))
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add bottom set of arrows
mygb(x=c(1,0.8,0.8,0), y=c(1,0.9,0.9,0.9))
mygb(x=c(1,0.7,0.4,0), y=c(1,0.8,0.4,0.4))
And here's the resulting plot:
Probably using ggplot with annotation_custom here is a more convenient approach. First, we generate sample plots.
require(ggplot2)
require(gridExtra)
require(bezier)
# generate sample plots
set.seed(17)
invisible(
sapply(paste0("gg", 1:6), function(ggname) {
assign(ggname, ggplotGrob(
ggplot(data.frame(x = rnorm(10), y = rnorm(10))) +
geom_path(aes(x,y), size = 1,
color = colors()[sample(1:length(colors()), 1)]) +
theme_bw()),
envir = as.environment(1)) })
)
After that we can plot them inside a bigger ggplot.
# necessary plot
ggplot(data.frame(a=1)) + xlim(1, 20) + ylim(1, 32) +
annotation_custom(gg1, xmin = 1, xmax = 9, ymin = 23, ymax = 31) +
annotation_custom(gg2, xmin = 11, xmax = 19, ymin = 21, ymax = 29) +
annotation_custom(gg3, xmin = 11, xmax = 19, ymin = 12, ymax = 20) +
annotation_custom(gg4, xmin = 1, xmax = 9, ymin = 10, ymax = 18) +
annotation_custom(gg5, xmin = 1, xmax = 9, ymin = 1, ymax = 9) +
annotation_custom(gg6, xmin = 11, xmax = 19, ymin = 1, ymax = 9) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 25, 25)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 18, 18)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 11)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 12), y = c(12, 10.5, 10.5, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
theme(rect = element_blank(),
line = element_blank(),
text = element_blank(),
plot.margin = unit(c(0,0,0,0), "mm"))
Here we use bezier function from bezier package to generate coordinates for geom_path. Maybe one should look for some additional information about bezier curves and their control points to make connections between plots look prettier. Now the resulting plot is following.
Thanks a lot for your tips and especially #eipi10 for an actual implementation of them - the answer is great.
I found a native ggplot solution which I want to share.
UPD While I was typing this answer, #inscaven posted his answer with basically the same idea. The bezier package gives more freedom to create neat curved arrows.
ggplot2::annotation_custom
The simple solution is to use ggplot's annotation_custom to position the 6 plots over the "canvas" ggplot.
The script
Step 1. Load the required packages and create the list of 6 square ggplots. My initial need was to arrange 6 maps, thus, I trigger theme parameter accordingly.
library(ggplot2)
library(ggthemes)
library(gridExtra)
library(dplyr)
p <- ggplot(mtcars, aes(mpg,wt))+
geom_point()+
theme_map()+
theme(aspect.ratio=1,
panel.border=element_rect(color = 'black',size=.5,fill = NA))+
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0)) +
labs(x = NULL, y = NULL)
plots <- list(p,p,p,p,p,p)
Step 2. I create a data frame for the canvas plot. I'm sure, there is a better way to this. The idea is to get a 30x20 canvas like an A4 sheet.
df <- data.frame(x=factor(sample(1:21,1000,replace = T)),
y=factor(sample(1:31,1000,replace = T)))
Step 3. Draw the canvas and position the square plot over it.
canvas <- ggplot(df,aes(x=x,y=y))+
annotation_custom(ggplotGrob(plots[[1]]),
xmin = 1,xmax = 9,ymin = 23,ymax = 31)+
annotation_custom(ggplotGrob(plots[[2]]),
xmin = 13,xmax = 21,ymin = 21,ymax = 29)+
annotation_custom(ggplotGrob(plots[[3]]),
xmin = 13,xmax = 21,ymin = 12,ymax = 20)+
annotation_custom(ggplotGrob(plots[[4]]),
xmin = 1,xmax = 9,ymin = 10,ymax = 18)+
annotation_custom(ggplotGrob(plots[[5]]),
xmin = 1,xmax = 9,ymin = 1,ymax = 9)+
annotation_custom(ggplotGrob(plots[[6]]),
xmin = 13,xmax = 21,ymin = 1,ymax = 9)+
coord_fixed()+
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme_bw()
theme_map()+
theme(panel.border=element_rect(color = 'black',size=.5,fill = NA))+
labs(x = NULL, y = NULL)
Step 4. Now we need to add the arrows. First, a data frame with arrows' coordinates is required.
df.arrows <- data.frame(id=1:5,
x=c(9,9,13,13,13),
y=c(23,23,12,12,12),
xend=c(13,13,9,9,13),
yend=c(22,19,11,8,8))
Step 5. Finally, plot the arrows.
gg <- canvas + geom_curve(data = df.arrows %>% filter(id==1),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==2),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==3),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.15,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==4),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==5),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.3,
arrow = arrow(type="closed",length = unit(0.25,"cm")))
The result
ggsave('test.png',gg,width=8,height=12)
I would like to have to colours in the same same group. It would also be nice to select line type.
I would like the colour to be a bit different in the same group in geom_point for a given line type than the points plotted with geom_point. I would like to have the line for a given given group be different from the points. How would I go about doing this?
I have created some sample data.
Note: I'm getting errors when I try to use linetype in geom_smooth().
#test data
obs=rep(1:3, each=30)
length(obs)
set.seed(50)
x=sample(seq(from = 20, to = 50, by = 5), size = 90, replace = TRUE)
y=sample(seq(from = 200, to = 500, by = 5), size = 90, replace = TRUE)
df = data.frame(obs,x,y)
ggplot(df, aes(x, y, color = factor(obs)))+
geom_point()+
theme(legend.position="bottom")+
scale_x_continuous(breaks = seq(0, 50, by = 4),expand = c(0, 0), labels = comma_format())+
scale_y_continuous(breaks = seq(0, 500, by = 10),limits = c(0, 500),expand = c(0, 0), labels = comma_format())+
geom_smooth(aes(group=obs), method="lm")+
scale_colour_manual(values = c("wheat3", "slategray1","dimgray"),name = "Average Density Band:")
I'm not sure this is a particularly good idea as you lose a visual clue as to what points are connected to what regression line, however the following does work for me. Essentially I took the colour aesthetic out of the ggplot() call and pass it to geom_point() and geom_smooth() individually.
library(ggplot2)
library(scales)
#test data
obs=rep(1:3, each=30)
length(obs)
set.seed(50)
x=sample(seq(from = 20, to = 50, by = 5), size = 90, replace = TRUE)
y=sample(seq(from = 200, to = 500, by = 5), size = 90, replace = TRUE)
df = data.frame(obs,x,y)
ggplot(df, aes(x, y))+
geom_point(color = factor(obs))+
theme(legend.position="bottom")+
scale_x_continuous(breaks = seq(0, 50, by = 4),expand = c(0, 0), labels = comma_format())+
scale_y_continuous(breaks = seq(0, 500, by = 10),limits = c(0, 500),expand = c(0, 0), labels = comma_format())+
geom_smooth(aes(group=obs, color = factor(obs)), method="lm")+
scale_colour_manual(values = c("orange", "yellow","blue"),name = "Average Density Band:")
I changed your line colours as I couldn't see them with my eyesight.
I suspect this isn't meant to work like this and to be frank I'm not 100% sure as to why it does.