I'm trying to write a function wherein our company logo is automatically added to each graph on export as part of a function, next to the title and subtitle. The dimensions of each output will depend on the needs at the time, so having a set size won't be particularly helpful unfortunately.
To do this, I've generated a series of grids to slot everything together, as per the below (using the iris dataset).
library(datasets)
library(tidyverse)
library(gridExtra)
library(grid)
library(png)
m <- readPNG("Rlogo.png") # download from: https://www.r-project.org/logo/Rlogo.png
plot <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_col() +
ggtitle("Title goes here",
subtitle = "subtitle down here")
txtTitle <- plot$labels$title
txtSubTitle <- plot$labels$subtitle
plot$labels$title <- NULL
plot$labels$subtitle <- NULL
buffer <- grobTree(rectGrob(gp = gpar(fill = "white", col = "white")))
Title <- grobTree(textGrob(label = txtTitle,
hjust = 1,
x = 0.98))
SubTitle <- textGrob(label = txtSubTitle,
hjust = 1,
x = 0.98)
Logo <- grobTree(rasterGrob(m, x = 0.02, hjust = 0))
TitlesGrid <- grid.arrange(Title, SubTitle, ncol = 1)
TopGrid <- grid.arrange(Logo, TitlesGrid, widths = c(1, 7), ncol = 2)
AllGrid <- grid.arrange(TopGrid, arrangeGrob(plot), heights = c(1,7))
This provides the following outputs at different aspect ratios.
The first example has a nice gap between the title and subtitle whereas there is too much for the second one. How would I make it so that the height of TopGrid is fixed to an absolute size, but the rest fills to the size desired?
Grid graphics has the concept of absolute and relative units. Absolute units (such as "cm", "in", "pt") always stay the same size, regardless of the viewport size. Relative units (called "null") expand or shrink as needed. In a regular ggplot2 object, the plot panel is specified in relative units while the various elements around the panel, such as title, axis ticks, etc. are specified in absolute units.
You specify absolute or relative units with the unit() function:
> library(grid)
> unit(1, "cm")
[1] 1cm
> unit(1, "null")
[1] 1null
In your case, the heights argument of grid.arrange can take arbitrary grid unit objects, so you just have to give the top height an absolute unit:
grid.arrange(TopGrid, arrangeGrob(plot), heights = unit(c(1, 1), c("cm", "null")))
I have been attempting to specify absolute positions for rasterGrobs in gtable cells without success. I would like to be able to have the extents of an image align to values on the y axis. The script aligns drill-core images alongside multi-sensor data plotted in ggplot2 facets. For example, a particular radiograph core image needs to have its top at 192 mm, and bottom at 1482 mm, but I want the scale to go from 0 to 1523 mm. Please see the included link for an example of what I am doing, but for simplicity I have only posted an MWE here. Is it possible to specify an absolute position for a rasterGrob inside a gtable cell?
sample of intended output
In terms of the MWE below, my only solution thus far has been to move Rlogo.png around using relative positions set when using rasterGrob(). Using "native" coordinates does not appear to be what I need either. Similarly, I can't make sense of the position parameters called in gtable_add_grob().
library(png)
library(ggplot2)
library(gtable)
# read Image
img <- readPNG(system.file("img", "Rlogo.png", package = "png"))
# convert to rastergrob
g <- rasterGrob(img, y = unit(0.5, "npc"), x = unit(0.5, "npc"))
# create plot
tp <- qplot(1:5, 1:5, geom="blank") + scale_y_reverse()
# convert plot to gtable
tt <- ggplot_gtable(ggplot_build(tp))
# add column to gtable to hold image
tt <- gtable_add_cols(tt, tt$width[[.5*4]], 3)
# add grob to cell 3, 4
tt <- gtable_add_grob(tt,g,3,4)
# render
grid.draw(tt)
Did a lot of searching before coming up with this solution of using rasterGrob to add images to panels in a ggplot. Perhaps though there is a more elegant solution someone can suggest?
The grob can set its position within a cell, as illustrated below
library(gridExtra)
library(grid)
library(gtable)
# quick shortcut to create a 2x2 gtable filled with 4 rectGrobs
tg <- arrangeGrob(grobs=replicate(4, rectGrob(), FALSE))
# red rect of fixed size with default position (0.5, 0.5) npc
rg1 <- rasterGrob("red", width=unit(1,"cm"), height=unit(1,"cm"))
# blue rect with specific x position (0) npc, left-justified
rg2 <- rasterGrob("blue", width=unit(1,"cm"), height=unit(1,"cm"),
x = 0, hjust=0)
# green rect at x = 1cm left-justified, y=-0.5cm from middle, top-justified
rg3 <- rasterGrob("green", width=unit(1,"cm"), height=unit(1,"cm"),
x = unit(1,"cm"), y=unit(0.5, "npc") - unit(0.5, "cm"),
hjust=0, vjust=1)
# place those on top
tg <- gtable_add_grob(tg, rg1, 1, 2, z = Inf, name = "default")
tg <- gtable_add_grob(tg, rg2, 1, 2, z = Inf, name = "left")
tg <- gtable_add_grob(tg, rg3, 1, 2, z = Inf, name = "custom")
grid.newpage()
grid.draw(tg)
I have written the following code to plot my x-y data on a set of re-scaleable axes, the values contained in pointSize are the correctly scaled vertical/horizontal diameters of the point I want at each plotted coordinate. How do I go about getting this to work? Right now I am just plotting points with whatever scaling is used by default in geom_point(aes(size)) and the points don't scale with the axes. Once I rescale the axes with coord_cartesian I want the plotted points to increase/decrease relative to the axes accordingly.
For example, if the point size is say 5, that means I want the horizontal and vertical diameter of the point to be 5 relative to the axes regardless of specified xyScaling.
EDIT: min in pointSize should have been min = 0, not min = -10
Minimal reproducible code:
# Sample size & x-y axes plot boundaries
sampleSize <- 100
# Set scale factor of x-y axes
xyScaling <- 1
# Set to false once sampled to rescale axis with same distributions
resample <- TRUE
if (resample == TRUE){
xSample <- replicate(sampleSize, runif(1, min = -sampleSize/2, max = sampleSize/2))
ySample <- replicate(sampleSize, runif(1, min = -sampleSize/2, max = sampleSize/2))
pointSize <- replicate(sampleSize, runif(1, min = 0, max = 10))
}
sampleDataFrame <- data.frame(xSample, ySample, pointSize)
samplePlot <- ggplot(sampleDataFrame, aes(xSample, ySample))
samplePlot +
geom_point(data = sampleDataFrame, aes(size = sampleDataFrame$pointSize[])) +
coord_cartesian(xlim = c((xyScaling*(-sampleSize/2)),(xyScaling*(sampleSize/2))),
ylim = c((xyScaling*(-sampleSize/2)),(xyScaling*(sampleSize/2)))) +
xlab("x") +
ylab("y") +
scale_size_identity(guide=FALSE)
EDIT: So I almost managed to solve the problem by using geom_rect, the following code does what I want with the caveat that the points are rectangles as opposed to ellipses/circles, I couldn't get this to work with ellipses, if anyone could guide me to the right function I would be very grateful.
sampleDataFrame <- data.frame(xSample, ySample, pointSize)
samplePlot <- ggplot(sampleDataFrame)
samplePlot +
geom_point(aes(xSample, ySample, size = 0)) +
geom_rect(aes(xmin = xSample-(pointSize/2), xmax = xSample+(pointSize/2), ymin = ySample-(pointSize/2), ymax = ySample+(pointSize/2))) +
coord_cartesian(xlim = c((xyScaling*(-sampleSize/2)),(xyScaling*(sampleSize/2))),
ylim = c((xyScaling*(-sampleSize/2)),(xyScaling*(sampleSize/2)))) +
xlab("x") +
ylab("y") +
scale_size_identity(guide=FALSE)
this has been suggested in the past, but I don't think it got implemented. One problem is that circles are only circular in the special case of cartesian coordinates with unit aspect ratio. The easiest workaround is probably to create a data.frame with xy positions describing circles (ellipses) and draw these as polygons.
library(gridExtra)
library(ggplot2)
circle <- polygon_regular(50)
pointy_points <- function(x, y, size){
do.call(rbind, mapply(function(x,y,size,id)
data.frame(x=size*circle[,1]+x, y=size*circle[,2]+y, id=id),
x=x,y=y, size=size, id=seq_along(x), SIMPLIFY=FALSE))
}
test <- pointy_points(1:10, 1:10, size=seq(0.2, 1, length.out=10))
ggplot(test, aes(x,y,group=id, fill=id)) + geom_polygon()
You could try to edit the points at the lowest-level, but it's quite fiddly,
library(ggplot2); library(grid)
p <- qplot(1:10, 1:10, size=I(10))
g <- ggplotGrob(p)
points <- g$grobs[[4]][["children"]][[2]]
g$grobs[[4]][["children"]][[2]] <-
editGrob(points, size = convertUnit(points$size, unitTo = "npc"))
grid.newpage()
grid.draw(g)
How to fill area under and above (sp)line with gradient color?
This example has been drawn in Inkscape - BUT I NEED vertical gradient - NOT horizontal.
Interval from zero to positive == from white to red.
Interval from zero to negative == from white to red.
Is there any package which could do this?
I fabricated some source data....
set.seed(1)
x<-seq(from = -10, to = 10, by = 0.25)
data <- data.frame(value = sample(x, 25, replace = TRUE), time = 1:25)
plot(data$time, data$value, type = "n")
my.spline <- smooth.spline(data$time, data$value, df = 15)
lines(my.spline$x, my.spline$y, lwd = 2.5, col = "blue")
abline(h = 0)
And here's an approach in base R, where we fill the entire plot area with rectangles of graduated colour, and subsequently fill the inverse of the area of interest with white.
shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...) {
# x, y: the x and y coordinates
# col: a vector of colours (hex, numeric, character), or a colorRampPalette
# n: the vertical resolution of the gradient
# ...: further args to plot()
plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
e <- par('usr')
height <- diff(e[3:4])/(n-1)
y_up <- seq(0, e[4], height)
y_down <- seq(0, e[3], -height)
ncolor <- max(length(y_up), length(y_down))
pal <- if(!is.function(col)) colorRampPalette(col)(ncolor) else col(ncolor)
# plot rectangles to simulate colour gradient
sapply(seq_len(n),
function(i) {
rect(min(x), y_up[i], max(x), y_up[i] + height, col=pal[i], border=NA)
rect(min(x), y_down[i], max(x), y_down[i] - height, col=pal[i], border=NA)
})
# plot white polygons representing the inverse of the area of interest
polygon(c(min(x), x, max(x), rev(x)),
c(e[4], ifelse(y > 0, y, 0),
rep(e[4], length(y) + 1)), col='white', border=NA)
polygon(c(min(x), x, max(x), rev(x)),
c(e[3], ifelse(y < 0, y, 0),
rep(e[3], length(y) + 1)), col='white', border=NA)
lines(x, y)
abline(h=0)
box()
}
Here are some examples:
xy <- curve(sin, -10, 10, n = 1000)
shade(xy$x, xy$y, c('white', 'blue'), 1000)
Or with colour specified by a colour ramp palette:
shade(xy$x, xy$y, heat.colors, 1000)
And applied to your data, though we first interpolate the points to a finer resolution (if we don't do this, the gradient doesn't closely follow the line where it crosses zero).
xy <- approx(my.spline$x, my.spline$y, n=1000)
shade(xy$x, xy$y, c('white', 'red'), 1000)
Here's one approach, which relies heavily on several R spatial packages.
The basic idea is to:
Plot an empty plot, the canvas onto which subsequent elements will be laid down. (Doing this first also lets you retrieve the user coordinates of the plot, needed in subsequent steps.)
Use a vectorized call to rect() to lay down a background wash of color. Getting the fiddly details of the color gradient is actually the trickiest part of doing this.
Use topology functions in rgeos to find first the closed rectangles in your figure, and then their complement. Plotting the complement with a white fill over the background wash covers up the color everywhere except within the polygons, just what you want.
Finally, use plot(..., add=TRUE), lines(), abline(), etc. to lay down whatever other details you'd like the plot to display.
library(sp)
library(rgeos)
library(raster)
library(grid)
## Extract some coordinates
x <- my.spline$x
y <- my.spline$y
hh <- 0
xy <- cbind(x,y)
## Plot an empty plot to make its coordinates available
## for next two sections
plot(data$time, data$value, type = "n", axes=FALSE, xlab="", ylab="")
## Prepare data to be used later by rect to draw the colored background
COL <- colorRampPalette(c("red", "white", "red"))(200)
xx <- par("usr")[1:2]
yy <- c(seq(min(y), hh, length.out=100), seq(hh, max(y), length.out=101))
## Prepare a mask to cover colored background (except within polygons)
## (a) Make SpatialPolygons object from plot's boundaries
EE <- as(extent(par("usr")), "SpatialPolygons")
## (b) Make SpatialPolygons object containing all closed polygons
SL1 <- SpatialLines(list(Lines(Line(xy), "A")))
SL2 <- SpatialLines(list(Lines(Line(cbind(c(0,25),c(0,0))), "B")))
polys <- gPolygonize(gNode(rbind(SL1,SL2)))
## (c) Find their difference
mask <- EE - polys
## Put everything together in a plot
plot(data$time, data$value, type = "n")
rect(xx[1], yy[-201], xx[2], yy[-1], col=COL, border=NA)
plot(mask, col="white", add=TRUE)
abline(h = hh)
plot(polys, border="red", lwd=1.5, add=TRUE)
lines(my.spline$x, my.spline$y, col = "red", lwd = 1.5)
Another possibility which uses functions from grid and gridSVG packages.
We start by generating additional data points by linear interpolation, according to methods described by #kohske here. The basic plot will then consist of two separate polygons, one for negative values and one for positive values.
After the plot has been rendered, grid.ls is used to show a list of grobs, i.e. all building block of the plot. In the list we will (among other things) find two geom_area.polygons; one representing the polygon for values <= 0, and one for values >= 0.
The fill of the polygon grobs is then manipulated using gridSVG functions: custom color gradients are created with linearGradient, and the fill of the grobs are replaced using grid.gradientFill.
The manipulation of grob gradients is nicely described in chapter 7 in the MSc thesis of Simon Potter, one of the authors of the gridSVG package.
library(grid)
library(gridSVG)
library(ggplot2)
# create a data frame of spline values
d <- data.frame(x = my.spline$x, y = my.spline$y)
# create interpolated points
d <- d[order(d$x),]
new_d <- do.call("rbind",
sapply(1:(nrow(d) -1), function(i){
f <- lm(x ~ y, d[i:(i+1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata = data.frame(y = 0))
if(d[i, ]$x < r & r < d[i+1, ]$x)
return(data.frame(x = r, y = 0))
else return(NULL)
})
)
# combine original and interpolated data
d2 <- rbind(d, new_d)
d2
# set up basic plot
ggplot(data = d2, aes(x = x, y = y)) +
geom_area(data = subset(d2, y <= 0)) +
geom_area(data = subset(d2, y >= 0)) +
geom_line() +
geom_abline(intercept = 0, slope = 0) +
theme_bw()
# list the name of grobs and look for relevant polygons
# note that the exact numbers of the grobs may differ
grid.ls()
# GRID.gTableParent.878
# ...
# panel.3-4-3-4
# ...
# areas.gTree.834
# geom_area.polygon.832 <~~ polygon for negative values
# areas.gTree.838
# geom_area.polygon.836 <~~ polygon for positive values
# create a linear gradient for negative values, from white to red
col_neg <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(1, "npc"), y1 = unit(0, "npc"))
# replace fill of 'negative grob' with a gradient fill
grid.gradientFill("geom_area.polygon.832", col_neg, group = FALSE)
# create a linear gradient for positive values, from white to red
col_pos <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
# replace fill of 'positive grob' with a gradient fill
grid.gradientFill("geom_area.polygon.836", col_pos, group = FALSE)
# generate SVG output
grid.export("myplot.svg")
You could easily create different colour gradients for positive and negative polygons. E.g. if you want negative values to run from white to blue instead, replace col_pos above with:
col_pos <- linearGradient(col = c("white", "blue"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
This is a terrible way to trick ggplot into doing what you want. Essentially, I make a giant grid of points that are under the curve. Since there is no way of setting a gradient within a single polygon, you have to make separate polygons, hence the grid. It will be slow if you set the pixels too low.
gen.bar <- function(x, ymax, ypixel) {
if (ymax < 0) ypixel <- -abs(ypixel)
else ypixel <- abs(ypixel)
expand.grid(x=x, y=seq(0,ymax, by = ypixel))
}
# data must be in x order.
find.height <- function (x, data.x, data.y) {
base <- findInterval(x, data.x)
run <- data.x[base+1] - data.x[base]
rise <- data.y[base+1] - data.y[base]
data.y[base] + ((rise/run) * (x - data.x[base]))
}
make.grid.under.curve <- function(data.x, data.y, xpixel, ypixel) {
desired.points <- sort(unique(c(seq(min(data.x), max(data.x), xpixel), data.x)))
desired.points <- desired.points[-length(desired.points)]
heights <- find.height(desired.points, data.x, data.y)
do.call(rbind,
mapply(gen.bar, desired.points, heights,
MoreArgs = list(ypixel), SIMPLIFY=FALSE))
}
xpixel = 0.01
ypixel = 0.01
library(scales)
grid <- make.grid.under.curve(data$time, data$value, xpixel, ypixel)
ggplot(grid, aes(xmin = x, ymin = y, xmax = x+xpixel, ymax = y+ypixel,
fill=abs(y))) + geom_rect()
The colours aren't what you wanted, but it is probably too slow for serious use anyway.
I'm trying to display 4 venn.diagramm plots in a grid. I need to increase the space between diagrams in order that my legends don't overlap with other diagrams (or be outside of the plots).
I tried to do so by playing with margin in the function venn.diagram but this lead to increase the distance between the diagrams and their respective subtitles (what is not good).
I have seen some questions related to mine (e.g. controlling the inner figure margin within grid.layout) but they didn't work in my case.
Here is my code:
library(VennDiagram)
library(grid)
library(gridBase)
library(lattice)
# data
l1 <- list(Deletion=1:1420, Insertion=967:2042)
l2 <- list(Deletion=1:502, Insertion=324:660)
l3 <- list(Deletion=1:142, Insertion=85:184)
l4 <- list(Deletion=1:161, Insertion=22:217)
venns <- list(Subtargets=l1, Targets=l2, Genes=l3, Promoters=l4)
# set up grid layout
gl <- grid.layout(nrow=2, ncol=2)
# setup viewports
vp.1 <- viewport(layout.pos.col=1, layout.pos.row=1)
vp.2 <- viewport(layout.pos.col=2, layout.pos.row=1)
vp.3 <- viewport(layout.pos.col=1, layout.pos.row=2)
vp.4 <- viewport(layout.pos.col=2, layout.pos.row=2)
# init layout
pushViewport(viewport(layout=gl))
for (i in 1:4){
# access the relevant viewport
vp <- paste("vp.", i, sep="")
pushViewport(get(vp))
# draw the venn diagram
temp <- venn.diagram(venns[[i]], fill = c("red", "green"), alpha = c(0.5, 0.5),
cex = 1,cat.fontface = 2, lty =2, filename = NULL, sub=names(venns)[i],
margin = 0.5, sub.pos = c(0.5, 0.78), sub.col="blue")
# plot the venn diagram on the viewport
grid.draw(temp)
# done with this viewport
popViewport()
}
Any idea? Maybe by increasing the margins between viewports without changing the parameters within wiewport?
I met this problem before and my solution is to create more grids.
gl <- grid.layout(nrow=3, ncol=3, widths = c(1, 0.2, 1), heights = c(1, 0.2, 1))
grid.show.layout(gl)
Then you can plot your venn diagram on the corner grids.