Related
I have some data, of which this is a subset:
MyDataToSO <- data.frame(Age = c(2, 7, 12, 16, 21),
AgeGroup = c("0-4 years", "5-9 years", "10-14 years", "15-17 years", "18-24 years"),
Proportion = c(0.963, 0.965, 0.925, 0.701, 0.422))
I wish to plot the data so that, on the x-axis, I get the relevant AgeGroup showing under the Age tick mark. The Age values are the mid-points of the AgeGroup categories.
I have the plot I want, except for adding in the AgeGroup bands under the relevant parts of the x-axis:
ggplot(data = MyDataToSO, aes(x = Age, y = Proportion)) +
geom_point() +
geom_point(data = subset(MyDataToSO, Age %in% c(16,21)), color = "green")
scale_x_continuous(breaks=seq(0, 30, by = 10)) +
labs(x = "Age group", y = "Proportion")
The graph works, showing the relevant Age in the correct position, but there is no indication that the Age values arise from age-groups.
I thought it would be useful to show this by having a second label on the x-axis, so that the resulting x-axis looks a bit like:
|
|______________________________...
| | | ...
2 7 12 ...
|__________|_________|_________|...
"0-4 years 5-9 years 10-14 years"...
I will need to play around with the font size a bit to get this working. I'd also like to get the age groups lines lighter than the normal printing (e.g. 25% less opaque than normal). I've put the quote marks around the age group labels to stop SO from showing each number there as orange numeric.
How can I add this information onto my graph? I did a search for secondary labels, but only found questions relating to having a secondary axis. As you can see, the required grouping information is stored in AgeGroup so I would "just" need to extract the relevant values from there.
Edit: I loaded the ggh4x package and the ggplot code is now this:
ggplot(data = MyDataToSO, aes(interaction(Age, AgeGroup), Proportion)) +
geom_point() +
geom_point(data = subset(MyDataToSO, Age %in% c(16,21)), color = "green")
scale_x_continuous(breaks=seq(0, 30, by = 10)) +
guides(x = "axis_nested") +
labs(x = "Age group", y = "Proportion")
but it is giving an error because the x-axis is continuous.
Edit 2: the green points are interpolations. I now have interpolations for ages 17 through 20. But these repeat the same AgeGroup label. Is this a problem?
Another approach would be to add annotations, turn off clipping, and put in more space between the axis text and axis titles, like so:
ggplot(data = MyDataToSO, aes(x = Age, y = Proportion)) +
geom_point() +
geom_point(data = subset(MyDataToSO, Age %in% c(16,21)), color = "green") +
scale_x_continuous(breaks=seq(0, 30, by = 10)) +
labs(x = "Age group", y = "Proportion") +
annotate("rect", fill = "gray80",
xmin = c(0, 5, 10, 15, 18),
xmax = c(5, 10, 15, 18, 24) - 0.2,
ymin = 0.28, ymax = 0.32) +
annotate("text", size = 3,
x = MyDataToSO$Age + 0.5,
y = 0.3, label = MyDataToSO$AgeGroup) +
coord_cartesian(ylim = c(0.4, 1), clip = "off") +
theme(axis.title.x = element_text(margin = margin(t = 25, r = 0, b = 0, l = 0)))
Edit: Based on my understanding of additional comment, now splitting out 15:21 individually.
MyDataToSO <- data.frame(Age = c(2, 7, 12, 15:21),
AgeGroup = c("0-4 years", "5-9 years", "10-14 years", 15:21),
Proportion = c(0.963, 0.965, 0.925, 0.701, .740, .677, .610, .540, .470, .401))
ggplot(data = MyDataToSO, aes(x = Age, y = Proportion)) +
geom_point() +
geom_point(data = subset(MyDataToSO, Age %in% c(16,21)), color = "green") +
scale_x_continuous(breaks=seq(0, 30, by = 10)) +
labs(x = "Age group", y = "Proportion") +
annotate("rect", fill = "gray80",
xmin = c(0, 5, 10, 15:21) - 0.4,
xmax = c(5, 10, 15, 16:22) - 0.6,
ymin = 0.28, ymax = 0.32) +
annotate("text", size = 3,
x = MyDataToSO$Age,
y = 0.3, label = MyDataToSO$AgeGroup) +
coord_cartesian(ylim = c(0.4, 1), clip = "off") +
theme(axis.title.x = element_text(margin = margin(t = 25, r = 0, b = 0, l = 0)))
The ggh4x package has a function that extends ggplot2 to do this in a more automatic way (https://cran.r-project.org/web/packages/ggh4x/vignettes/PositionGuides.html, scroll down to "Nested Relations").
A quick and easy way to do this is to create a list or variable where you append the values from MyDataToSO$Age and MyDataToSO$AgeGroup separated by two carriage returns (i.e. \n). You will pass that list/variable to the 'labels' instruction for scale_x_continuous.
library(tidyverse)
MyDataToSO <- tibble(Age = c(2, 7, 12, 16, 21),
AgeGroup = c("0-4 years", "5-9 years", "10-14 years", "15-17 years", "18-24 years"),
Proportion = c(0.963, 0.965, 0.925, 0.701, 0.422)) %>%
mutate(custom_labels = paste0(Age, "\n\n", AgeGroup)) ## This is where you create the custom labels
ggplot(data = MyDataToSO, aes(x = Age, y = Proportion)) +
geom_point() +
geom_point(data = subset(MyDataToSO, Age %in% c(16,21)), color = "green") +
scale_x_continuous(breaks=seq(0, 30, by = 10)) +
labs(x = "Age group", y = "Proportion") +
scale_x_continuous(breaks = c(MyDataToSO$Age), ## Here you pass the relevant ages. Should be aligned with the custom_labels
labels = c(MyDataToSO$custom_labels)) ## Here you pass the custom label balues
I am trying to annotate both axes of my plot with some text, but when I do that, I am unable to position the text as I would like. By adding new text on one axis, the text on the other axis gets misplaced.
How to deal with that?
Here is an example to illustrate my issue:
set.seed(1234)
x <- rnorm(50, 5, 2)
y <- x + 1 + rnorm(50)
data <- cbind.data.frame(x,y)
#Create a plot in which I annotate in one axis (it works great)
plot <- ggplot(data = data, aes(x, y))+
geom_point() +
geom_hline(yintercept=median(data$x, na.rm = T), color = 'red') +
geom_vline(xintercept=median(data$y, na.rm = T), color = 'red') +
labs(y="Label y", x = "Label x") +
geom_smooth(method=lm, na.rm = TRUE, fullrange= TRUE,
aes(group=1),colour="black") +
theme_bw() +
theme(axis.title.y = element_text(margin = margin(t = 0, r = 30, b = 0, l = 0))) +
theme(axis.title.x = element_text(margin = margin(t = 30, r = 0, b = 0, l = 0))) +
annotate("text", x = 9, y = -3, label = "Helpful Text2") +
annotate("text", x = 0.5, y = -3, label = "Helpful Text1") +
coord_cartesian(ylim = c(0, 15), clip = "off")
#Trying to add annotation to the second axis (it alters the axis of the plot, thereby misplacing the annotation I have done prior)
plot + annotate("text", x = 0, y = 8.5, label = "Helpful Text3", angle = 90) +
annotate("text", x = 0, y = 2, label = "Helpful Text4", angle = 90) +
coord_cartesian(xlim = c(1, 9), clip = "off")
Ideas?
You could try:
plot + annotate("text", x = -1, y = 14, label = "Helpful Text3", angle = 90) +
annotate("text", x = -1, y = 0, label = "Helpful Text4", angle = 90) +
coord_cartesian(ylim = c(0, 15), xlim = c(0, 10), clip = "off")
Just make sure you set fullrange = FALSE in geom_smooth when defining your plot.
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)
For the main y-axis and x-axis, I have generic titles like "Tank's Ratio" and "Counts". I want a second line of label where I specify the ratio and counts. eg. Just below "Tank's Ratio" I want "# in water/# in sand" in a smaller font but along the y-axis. Similarly for the x-axis.
Here is the basic code
data <- data.frame(set = c(1, 1, 1, 2, 2, 3, 3, 3, 3, 3, 4, 4), density = c(1, 3, 3, 1, 3, 1, 1, 1, 3, 3, 1, 3), counts = c(100, 2, 3, 76, 33, 12, 44, 13, 54, 36, 65, 1), ratio = c(1, 2, 3, 4, 1, 2, 3, 4, 5, 6, 90, 1))
library(ggplot2)
ggplot(data, aes(x = counts, y = ratio)) +
geom_point() +
ylab("Tank's Ratio") +
xlab("Counts")
You can add x and main titles.
EDIT: This is ridiculously slooow!
#library(extrafont)
#loadfonts(dev="win")
library(tidyverse)
data %>%
ggplot(aes(x=counts, y=ratio)) + geom_point() +
labs(y=expression(atop(bold("Tank's Ratio"),atop(italic("#in water #in sand")))))+
theme_minimal()+
theme(axis.title.y = element_text(size=15,family="Comic Sans MS"))
ORIGINAL:
library(tidyverse)
data %>%
ggplot(aes(x=counts, y=ratio)) + geom_point() +
labs(y="Tank's Ratio \n #in Water#in sand")
It's not the most elegant solution, but hope it helps:
library(ggplot2)
library(gridExtra)
library(grid)
First, create plot without ylab:
g <- ggplot(data, aes(x = counts, y = ratio)) +
geom_point() +
ylab("") +
xlab("Counts")
Then add subtitle for both axis:
g2 <- grid.arrange(g,
bottom = textGrob("in water/ # in sand",
x = 0.55, y = 1, gp = gpar(fontsize = 9)),
left = textGrob("in water/ # in sand", rot = 90,
x = 1.5, gp = gpar(fontsize = 9)))
And finally, add description of y-axis
grid.arrange(g2,
left = textGrob("Tank's Ratio", rot = 90,
x = 1.7, gp = gpar(fontsize = 12)))
You could use the following code, defining the margins, the axis titles and sub-titles yourself:
We use theme to increase the bottom and left margin, and to suppress the automatically generated axis titles.
We use annotate to generate the text that serves as axis title and sub-title, if necessary, the text is rotated.
We generate the plot, turn it in a grob, and with this grob we can turn of clipping, and show the plot.
g1 <- ggplot(data = data, aes(x = counts, y = ratio, group = 1)) +
geom_point() +
## increase margin size for left and bottom and
## remove the axis titles
theme(plot.margin = unit(c(1, 1, 4, 4), "lines"),
axis.title.y = element_blank(),
axis.title.x = element_blank() ) +
## define the plotting area to NOT include the annotations
coord_cartesian(xlim = c(0, 100), ylim= c(0, 100), expand = FALSE) +
## annotate y axis
annotate(geom = "text", x = -9, y = 50, label = "Tank's Ratio", angle = 90, size = 5) +
annotate(geom = "text", x = -5, y = 50, label = "#in water/#in sand", angle = 90, size = 4) +
## annotate x axis
annotate(geom = "text", x = 50, y = -5, label = "Counts", size = 5) +
annotate(geom = "text", x = 50, y = -9, label = "#in water/#in sand", size = 4)
## turn off clipping for axis extra labels
g2 <- ggplot_gtable(ggplot_build(g1))
g2$layout$clip[g2$layout$name == "panel"] <- "off"
grid::grid.draw(g2)
This yields the following picture:
Please let me know whether this is what you want.
How can I make a plot like this with two different-sized half circles (or other shapes such as triangles etc.)?
I've looked into a few options: Another post suggested using some unicode symbol, that didn't work for me. And if I use a vector image, how can I properly adjust the size parameter so the 2 circles touch each other?
Sample data (I would like to make the size of the two half-circles equal to circle1size and circle2size):
df = data.frame(circle1size = c(1, 3, 2),
circle2size = c(3, 6, 5),
middlepointposition = c(1, 2, 3))
And ultimately is there a way to position the half-circles at different y-values too, to encode a 3rd dimension, like so?
Any advice is much appreciated.
What you're asking for is a bar plot in polar coordinates. This can be done easily in ggplot2. Note that we need to map y = sqrt(count) to get the area of the half circle proportional to the count.
df <- data.frame(x = c(1, 2),
type = c("Investors", "Assignees"),
count = c(19419, 1132))
ggplot(df, aes(x = x, y = sqrt(count), fill = type)) + geom_col(width = 1) +
scale_x_discrete(expand = c(0,0), limits = c(0.5, 2.5)) +
coord_polar(theta = "x", direction = -1)
Further styling would have to be applied to remove the gray background, remove the axes, change the color, etc., but that's all standard ggplot2.
Update 1: Improved version with multiple countries.
df <- data.frame(x = rep(c(1, 2), 3),
type = rep(c("Investors", "Assignees"), 3),
country = rep(c("Japan", "Germany", "Korea"), each = 2),
count = c(19419, 1132, 8138, 947, 8349, 436))
df$country <- factor(df$country, levels = c("Japan", "Germany", "Korea"))
ggplot(df, aes(x=x, y=sqrt(count), fill=type)) + geom_col(width =1) +
scale_x_continuous(expand = c(0, 0), limits = c(0.5, 2.5)) +
scale_y_continuous(expand = c(0, 0)) +
coord_polar(theta = "x", direction = -1) +
facet_wrap(~country) +
theme_void()
Update 2: Drawing the individual plots at different locations.
We can do some trickery to take the individual plots and plot them at different locations in an enclosing plot. This works, and is a generic method that can be done with any sort of plot, but it's probably overkill here. Anyways, here is the solution.
library(tidyverse) # for map
library(cowplot) # for draw_text, draw_plot, get_legend, insert_yaxis_grob
# data frame of country data
df <- data.frame(x = rep(c(1, 2), 3),
type = rep(c("Investors", "Assignees"), 3),
country = rep(c("Japan", "Germany", "Korea"), each = 2),
count = c(19419, 1132, 8138, 947, 8349, 436))
# list of coordinates
coord_list = list(Japan = c(1, 3), Germany = c(2, 1), Korea = c(3, 2))
# make list of individual plots
split(df, df$country) %>%
map( ~ ggplot(., aes(x=x, y=sqrt(count), fill=type)) + geom_col(width =1) +
scale_x_continuous(expand = c(0, 0), limits = c(0.5, 2.5)) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 160)) +
draw_text(.$country[1], 1, 160, vjust = 0) +
coord_polar(theta = "x", start = 3*pi/2) +
guides(fill = guide_legend(title = "Type", reverse = T)) +
theme_void() + theme(legend.position = "none") ) -> plotlist
# extract the legend
legend <- get_legend(plotlist[[1]] + theme(legend.position = "right"))
# now plot the plots where we want them
width = 1.3
height = 1.3
p <- ggplot() + scale_x_continuous(limits = c(0.5, 3.5)) + scale_y_continuous(limits = c(0.5, 3.5))
for (country in names(coord_list)) {
p <- p + draw_plot(plotlist[[country]], x = coord_list[[country]][1]-width/2,
y = coord_list[[country]][2]-height/2,
width = width, height = height)
}
# plot without legend
p
# plot with legend
ggdraw(insert_yaxis_grob(p, legend))
Update 3: Completely different approach, using geom_arc_bar() from the ggforce package.
library(ggforce)
df <- data.frame(start = rep(c(-pi/2, pi/2), 3),
type = rep(c("Investors", "Assignees"), 3),
country = rep(c("Japan", "Germany", "Korea"), each = 2),
x = rep(c(1, 2, 3), each = 2),
y = rep(c(3, 1, 2), each = 2),
count = c(19419, 1132, 8138, 947, 8349, 436))
r <- 0.5
scale <- r/max(sqrt(df$count))
ggplot(df) +
geom_arc_bar(aes(x0 = x, y0 = y, r0 = 0, r = sqrt(count)*scale,
start = start, end = start + pi, fill = type),
color = "white") +
geom_text(data = df[c(1, 3, 5), ],
aes(label = country, x = x, y = y + scale*sqrt(count) + .05),
size =11/.pt, vjust = 0)+
guides(fill = guide_legend(title = "Type", reverse = T)) +
xlab("x axis") + ylab("y axis") +
coord_fixed() +
theme_bw()
If you don't need to have ggplot2 map aesthetics other than x and y you could try egg::geom_custom,
# devtools::install_github("baptiste/egg")
library(egg)
library(grid)
library(ggplot2)
d = data.frame(r1= c(1,3,2), r2=c(3,6,5), x=1:3, y=1:3)
gl <- Map(mushroomGrob, r1=d$r1, r2=d$r2, gp=list(gpar(fill=c("bisque","maroon"), col="white")))
d$grobs <- I(gl)
ggplot(d, aes(x,y)) +
geom_custom(aes(data=grobs), grob_fun=I) +
theme_minimal()
with the following grob,
mushroomGrob <- function(x=0.5, y=0.5, r1=0.2, r2=0.1, scale = 0.01, angle=0, gp=gpar()){
grob(x=x,y=y,r1=r1,r2=r2, scale=scale, angle=angle, gp=gp , cl="mushroom")
}
preDrawDetails.mushroom <- function(x){
pushViewport(viewport(x=x$x,y=x$y))
}
postDrawDetails.mushroom<- function(x){
upViewport()
}
drawDetails.mushroom <- function(x, recording=FALSE, ...){
th2 <- seq(0,pi, length=180)
th1 <- th2 + pi
d1 <- x$r1*x$scale*cbind(cos(th1+x$angle*pi/180),sin(th1+x$angle*pi/180))
d2 <- x$r2*x$scale*cbind(cos(th2+x$angle*pi/180),sin(th2+x$angle*pi/180))
grid.polygon(unit(c(d1[,1],d2[,1]), "snpc")+unit(0.5,"npc"),
unit(c(d1[,2],d2[,2]), "snpc")+unit(0.5,"npc"),
id=rep(1:2, each=length(th1)), gp=x$gp)
}
# grid.newpage()
# grid.draw(mushroomGrob(gp=gpar(fill=c("bisque","maroon"), col=NA)))