Problem
I would like to insert an image in between some text in the caption of my ggplot.
What I found on sofar is this solution using some gtable hacking.
But this solution is somewhat unviable for me, because I want to add text before and after the image. Besides, it doesn't resize the image to the actual fontsize of the caption.
library(tidyverse)
library(magick)
library(grid)
library(gtable)
ggplot(iris,
aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
theme(plot.caption = element_text(hjust=0,
size = 10)) +
labs(caption = "\uA9 *INSERT MY COMPANY LOGO HERE* My fabulous company, 2019")
my_logo <- image_read("https://upload.wikimedia.org/wikipedia/commons/3/3e/Phalaenopsis_JPEG.png")
print(my_logo)
Goal
What I want to achieve is this. Note that the logo's (my_logo) vertical size is equal to the fontsize of the caption.
The answer you link to provides all the ingredients,
library(ggplot2)
library(grid)
library(dplyr)
library(gtable)
lg <- textGrob(label = "\uA9", x = unit(0, "npc"), just = "left")
rg <- textGrob(label = "My fabulous company, 2019", x = unit(0, "npc"), just = "left")
mg <- png::readPNG(system.file("img", "Rlogo.png", package="png")) %>%
rasterGrob(interpolate = TRUE, height = grobHeight(rg))
p <- ggplot(mtcars, aes(wt, mpg)) +
geom_point() +
labs(caption="") # to create space for title
# convert to grob
gt <- ggplotGrob(p)
# create new title as a tableGrob with separate cells for image & text
new.title <- gtable_row('caption', grobs = list(lg,mg,rg),
widths = unit.c(grobWidth(lg), grobWidth(mg), unit(1,"null")),
height=unit(1,"null")) %>%
# optional: adda fixed amt of space between image & text
gtable_add_col_space(width = unit(5, "pt"))
# assign new title back to gt
gt$grobs[[which(gt$layout$name == "caption")]] <- new.title
grid.newpage()
grid.draw(gt)
Related
For the sake of simplicity, let's assume I have four graphs:
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
grid.arrange(p1,p2,p3,p4,ncol=2)
Now, I want to create a title (TITLE 1, TITLE 2) between each two titles,, as presented below:
Any ideas how to do it?
Here is a gtable solution to your problem. There might be easier solutions out there, but this should work.
First we'll bake in some titles in the leftmost plots
library(grid) # needed later for plotting
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 1")
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 2")
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
Then we can cbind and rbind the plots together as we see fit.
p12 <- cbind(ggplotGrob(p1), ggplotGrob(p2), size = "first")
p34 <- cbind(ggplotGrob(p3), ggplotGrob(p4), size = "first")
all <- rbind(p12, p34, size = "first")
grid.newpage(); grid.draw(all)
Note that we'd have to work with grid.newpage() and grid.draw() to get our plots, since we've left the ggplot sphere and are now in the realm of gtables and grid. Anyway, resulting plot looks like the following:
From your example I expect that you want these titles to be centered. This will be a bit more finicky:
# Decide what is a title
is_title <- grep("^title$", all$layout$name)
# Grab all titles
titles <- all$grobs[is_title]
# Exclude empty titles
is_title <- is_title[!sapply(titles, inherits, "zeroGrob")]
# Center title
all$grobs[is_title] <- lapply(all$grobs[is_title], function(title) {
title$children[[1]]$hjust <- 0.5
title$children[[1]]$x <- unit(0.5, "npc")
title
})
# Spread title over all panels
# You can see the number you'd need from the l/r coordinates of the 'panel' grobs
# which you can find by printing `all` or `all$layout`.
all$layout[is_title, "r"] <- 14
grid.newpage(); grid.draw(all)
EDIT: added example for adding extra titles
You can add extra titles, but you would need the gtable package for this.
library(gtable)
# First make extra titles
left <- textGrob("Left Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
right <- textGrob("Right Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
# Find a height that was 0, assign new height based on extra title
all$heights[[2]] <- unit(1, "grobheight", left)
# Add the titles (t = top position, l = left position)
all <- gtable_add_grob(all, left, t = 2, l = 5, clip = "off")
all <- gtable_add_grob(all, right, t = 2, l = 14, clip = "off")
grid.newpage(); grid.draw(all)
I am trying to add my company logo under all of our charts. I managed to do so however the end result looks a bit disappointing. The logo looks all blurry despite me using high res image.
Is there any way I can improve this?
(Note that the R logo I use has the same resolution as my company logo's res. They are all 1000*1000px)
Below is my code:
library(ggplot2)
library(png)
library(gridExtra)
library(grid)
dev.off(dev.list()["RStudioGD"])
gg <- ggplot(mtcars, aes(x = mpg, y = wt)) +
theme_minimal() +
geom_count() +
labs(title = "Title Goes Here", x = "", y = "")
img <- readPNG("R-logo.png")
gg = gg +
annotation_custom(rasterGrob(img),
xmin=0.95*min(mtcars$mpg)-1, xmax=0.95*min(mtcars$mpg)+1,
ymin=0.6*min(mtcars$wt)-0.7, ymax=0.6*min(mtcars$wt)+0.5) +
theme(plot.margin=margin(5,10,40,5))
# Turn off clipping
gt <- ggplot_gtable(ggplot_build(gg))
gt$layout$clip[gt$layout$name=="panel"] <- "off"
png('chart.png', width = 600, height = 500, units = "px",type='cairo',res=72)
grid.draw(gt)
dev.off()
Actually, I found the way to properly scale the logo before laying over the plot. The magick package works wonderfully.
library(magick)
img <- image_read("R-logo.png")
img <- image_scale(img, "50")
How to add image logo outside the plotting areas for ggplot2. Tried rasterGrob function from 'grid' package, but that keep's the image inside plot area.
Here is the starter script:
library(ggplot2)
library(png)
library(gridExtra)
library(grid)
gg <- ggplot(df1, aes(x = mpg, y = wt)) +
theme_minimal() +
geom_count() +
labs(title = "Title Goes Here", x = "", y = "")
img <- readPNG("fig/logo.png")
Here is the outcome I am looking for.
I can add the annotation on the right side, but the logo on the left is where I am getting challenged.
You can add the elements with annotation_custom but you need to turn off clipping for the images to show up when they're outside the plot area. I've changed your example slightly in order to make it reproducible.
library(ggplot2)
library(png)
library(gridExtra)
library(grid)
gg <- ggplot(mtcars, aes(x = mpg, y = wt)) +
theme_minimal() +
geom_count() +
labs(title = "Title Goes Here", x = "", y = "")
img = readPNG(system.file("img", "Rlogo.png", package="png"))
gg = gg +
annotation_custom(rasterGrob(img),
xmin=0.95*min(mtcars$mpg)-1, xmax=0.95*min(mtcars$mpg)+1,
ymin=0.62*min(mtcars$wt)-0.5, ymax=0.62*min(mtcars$wt)+0.5) +
annotation_custom(textGrob("Footer goes here", gp=gpar(col="blue")),
xmin=max(mtcars$mpg), xmax=max(mtcars$mpg),
ymin=0.6*min(mtcars$wt), ymax=0.6*min(mtcars$wt)) +
theme(plot.margin=margin(5,5,30,5))
# Turn off clipping
gt <- ggplot_gtable(ggplot_build(gg))
gt$layout$clip[gt$layout$name=="panel"] <- "off"
grid.draw(gt)
Another option is to use ggplot's caption feature to add the text footer, which saves some code:
gg = gg +
annotation_custom(rasterGrob(img),
xmin=0.95*min(mtcars$mpg)-1, xmax=0.95*min(mtcars$mpg)+1,
ymin=0.62*min(mtcars$wt)-0.5, ymax=0.62*min(mtcars$wt)+0.5) +
labs(caption="Footer goes here") +
theme(plot.margin=margin(5,5,15,5),
plot.caption=element_text(colour="blue", hjust=1.05, size=15))
# Turn off clipping
gt <- ggplot_gtable(ggplot_build(gg))
gt$layout$clip[gt$layout$name=="panel"] <- "off"
grid.draw(gt)
Jut adding an updated method from the terrific package Magick:
library(ggplot2)
library(magick)
library(here) # For making the script run without a wd
library(magrittr) # For piping the logo
# Make a simple plot and save it
ggplot(mpg, aes(displ, hwy, colour = class)) +
geom_point() +
ggtitle("Cars") +
ggsave(filename = paste0(here("/"), last_plot()$labels$title, ".png"),
width = 5, height = 4, dpi = 300)
# Call back the plot
plot <- image_read(paste0(here("/"), "Cars.png"))
# And bring in a logo
logo_raw <- image_read("http://hexb.in/hexagons/ggplot2.png")
# Scale down the logo and give it a border and annotation
# This is the cool part because you can do a lot to the image/logo before adding it
logo <- logo_raw %>%
image_scale("100") %>%
image_background("grey", flatten = TRUE) %>%
image_border("grey", "600x10") %>%
image_annotate("Powered By R", color = "white", size = 30,
location = "+10+50", gravity = "northeast")
# Stack them on top of each other
final_plot <- image_append(image_scale(c(plot, logo), "500"), stack = TRUE)
# And overwrite the plot without a logo
image_write(final_plot, paste0(here("/"), last_plot()$labels$title, ".png"))
I am creating a graphic using facet_grid to facet a categorical variable on the y-axis. I decided not to use facet_wrap because I need space = 'free' and labeller = label_parsed. My labels are long and I have a legend on the right so I would like to move the labels from the right of the panel to the top of the panel.
Here is an example to show where I'm getting stuck.
library(ggplot2)
library(gtable)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
theme_minimal() +
theme(panel.margin = unit(0.5, 'lines'), strip.text.y = element_text(angle = 0))
Now I would like to move the strip text from the right of each panel to the top of each panel. I can store the grobs for the strip labels and remove them from the plot:
grob <- ggplotGrob(mt)
strips.y <- gtable_filter(grob, 'strip-right')
grob2 <- grob[,-5]
But now I'm stuck when it comes to rbind-ing the grobs back so the labels go to the top of the panels.
Another possible solution would be to use facet_wrap and then re-size the panels as discussed in another question, but in that case I would have to manually change the labels on the facets because there is no labeller = label_parsed for facet_wrap.
I'd appreciate suggestions on either approach!
Thanks for reading,
Tom
This takes your first approach. It inserts a row above each of the panels, grabs the strip grobs (on the right), and inserts them into the new rows.
library(ggplot2)
library(gtable)
library(grid)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_grid(manufacturer ~ ., scales = 'free', space = 'free') +
theme(panel.spacing = unit(0.5, 'lines'),
strip.text.y = element_text(angle = 0))
# Get the gtable
gt <- ggplotGrob(mt)
# Get the position of the panels in the layout
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), se=t:r))
# Add a row above each panel
for(i in rev(panels$t-1)) gt = gtable_add_rows(gt, unit(.5, "lines"), i)
# Get the positions of the panels and the strips in the revised layout
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), se=t:r))
strips <- c(subset(gt$layout, grepl("strip-r", gt$layout$name), se=t:r))
# Get the strip grobs
stripText = gtable_filter(gt, "strip-r")
# Insert the strip grobs into the new rows
for(i in 1:length(strips$t)) gt = gtable_add_grob(gt, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=4)
# Remove the old strips
gt = gt[,-5]
# For this plot - adjust the heights of the strips and the empty row above the strips
for(i in panels$t) {
gt$heights[i-1] = unit(0.8, "lines")
gt$heights[i-2] = unit(0.2, "lines")
}
# Draw it
grid.newpage()
grid.draw(gt)
OR, you can achieve the second approach using a facet_wrap_labeller function available from here.
library(ggplot2)
library(gtable)
mt <- ggplot(mpg, aes(x = cty, y = model)) + geom_point() +
facet_wrap(~ manufacturer, scales = "free_y", ncol = 1) +
theme(panel.margin = unit(0.2, 'lines'))
facet_wrap_labeller <- function(gg.plot, labels=NULL) {
require(gridExtra)
g <- ggplotGrob(gg.plot)
gg <- g$grobs
strips <- grep("strip_t", names(gg))
for(ii in seq_along(labels)) {
modgrob <- getGrob(gg[[strips[ii]]], "strip.text",
grep=TRUE, global=TRUE)
gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii])
}
g$grobs <- gg
class(g) = c("arrange", "ggplot",class(g))
return(g)
}
## Number of y breaks in each panel
g <- ggplot_build(mt)
N <- sapply(lapply(g$panel$ranges, "[[", "y.major"), length)
# Some arbitrary strip texts
StripTexts = expression(gamma[1], sqrt(gamma[2]), C, `A really incredibly very very very long label`, gamma[5], alpha[1], alpha[2], `Land Rover`, alpha[1], beta[2], gamma^2, delta^2, epsilon[2], zeta[3], eta[4] )
# Apply the facet_wrap_labeller function
gt = facet_wrap_labeller(mt, StripTexts)
# Get the position of the panels in the layout
panels <- gt$layout$t[grepl("panel", gt$layout$name)]
# Replace the default panel heights with relative heights
gt$heights[panels] <- lapply(N, unit, "null")
# Draw it
gt
I was struggling with a similar problem but putting the labels on the bottom. I've used a code adaptation of this answer. And recently found that
ggplot2 ver.2.2.1.0 (http://docs.ggplot2.org/current/facet_grid.html)
~facet_grid(.~variable,switch='x')
option which has worked beautifully for me.
It seems that the strips are always above the plot created by ggplot2. Can they be moved below the plot?
For example:
library(ggplot2)
qplot(hwy, cty, data = mpg) + facet_grid( . ~ manufacturer)
displays the car information on top. Can they be displayed be at the bottom?
Update: Using ggplot2 version 2.1.0, consider using switch = 'x'. See ?facet_grid for details.
Using gtable functions, it is easy to move the strip. (Or see here for anther version - swapping x-axis and strip)
library(ggplot2)
library(gtable)
library(grid)
p <- ggplot(mpg, aes(hwy, cty)) + geom_point() + facet_grid( . ~ manufacturer) +
theme(strip.text.x = element_text(angle = 90, vjust = 1),
strip.background = element_rect(fill = NA))
# Convert the plot to a grob
gt <- ggplotGrob(p)
# Get the positions of the panels in the layout: t = top, l = left, ...
panels <-c(subset(gt$layout, grepl("panel", gt$layout$name), select = t:r))
# Add a row below the x-axis tick mark labels,
# the same height as the strip
gt = gtable_add_rows(gt, gt$height[min(panels$t)-1], max(panels$b) + 2)
# Get the strip grob
stripGrob = gtable_filter(gt, "strip-t")
# Insert the strip grob into the new row
gt = gtable_add_grob(gt, stripGrob, t = max(panels$b) + 3, l = min(panels$l), r = max(panels$r))
# remove the old strip
gt = gt[-(min(panels$t)-1), ]
grid.newpage()
grid.draw(gt)