Multiple Venn diagrams in one ".EPS" file in R - r

I want to have two (or more) Venn diagrams in a ".eps" file. I used this post by fridaymeetssunday, which refers to this post by mnel, and I just changed the code from "pdf" to "eps" by postscript.
The problem is, when I run the code and open the file the diagrams are colorless and do not have any colors. Should I have done something else?
# libraries
library(VennDiagram)
library(grid)
library(gridBase)
library(lattice)
# create the diagrams
temp1 <- venn.diagram(list(B = 1:1800, A = 1571:2020),
fill = c("red", "green"), alpha = c(0.5, 0.5), cex = 1,cat.fontface = 2,
lty =2, filename = NULL)
temp2 <- venn.diagram(list(A = 1:1800, B = 1571:2020),
fill = c("red", "green"), alpha = c(0.5, 0.5), cex = 1,cat.fontface = 2,
lty =2, filename = NULL)
# start new page
plot.new()
#pdf("testpdf", width = 14, height = 7)
postscript("test.eps", height=8, width=8, paper="special", family="Helvetica", fonts=c("serif","Helvetica"), horizontal=FALSE)
# setup layout
gl <- grid.layout(nrow=1, ncol=2)
# grid.show.layout(gl)
# setup viewports
vp.1 <- viewport(layout.pos.col=1, layout.pos.row=1)
vp.2 <- viewport(layout.pos.col=2, layout.pos.row=1)
# init layout
pushViewport(viewport(layout=gl))
# access the first position
pushViewport(vp.1)
# start new base graphics in first viewport
par(new=TRUE, fig=gridFIG())
grid.draw(temp2)
# done with the first viewport
popViewport()
# move to the next viewport
pushViewport(vp.2)
grid.draw(temp2)
# done with this viewport
popViewport(1)
dev.off()

Related

Editing symbol attributes with R::grid

For grid practice purposes, I am trying to adjust the plot symbol. The idea is to connect min/max values with a vertical line, and give both symbols & line the same color fill without visible outline.
I've figured out most steps. My problem is with removing the symbol outline and changing the symbol.
library(grid)
n <- 10
mins <- 10*runif(n)
maxs <- mins + 5*runif(n)
grid.newpage()
pushViewport(plotViewport(c(5.1, 4.1, 4.1, 2.1)))
vp <- dataViewport( xData = 1:n , yData = c(mins,maxs) , name = "theRegion")
pushViewport(vp)
grid.rect()
grid.points(1:n,mins , gp = gpar(pch=2,col="blue",fill="blue"))
grid.edit("dataSymbols",pch=2)
# --------------------------------
# Error in editDLfromGPath(gPath, specs, strict, grep, global, redraw) :
# 'gPath' (dataSymbols) not found
# --------------------------------
grid.points(1:n,maxs, gp = gpar(pch=2,col="yellow"))
grid.xaxis()
grid.yaxis()
for(i in 1:n){
grid.lines(x = unit(c(i,i),"native"),
y = unit(c(mins[i],maxs[i]),"native"),
gp = gpar(col = "green",lwd=6))
}
First, a couple of issues:
1. pch is not a gpar parameter - move pch outside gpar.
2. pch=2 has a 'col' but does not have a 'fill'. A triangle-shaped symbol with both fill and col is pch=24.
3. If you want to edit a named grob, you need a grob with that name.
library(grid)
n <- 10
mins <- 10*runif(n)
maxs <- mins + 5*runif(n)
grid.newpage()
pushViewport(plotViewport(c(5.1, 4.1, 4.1, 2.1)))
vp <- dataViewport(xData = 1:n, yData = c(mins,maxs), name = "theRegion")
pushViewport(vp)
grid.rect()
# Symbols are triangles with blue border and yellow fill.
# Note the grob's name
grid.points(1:n, mins, pch = 24, gp = gpar(col = "blue", fill = "yellow"), name = "dataSymbols")
# Edit that grob so that the symbols do not have a border
grid.edit("dataSymbols", gp = gpar(col = NA))
# Edit that grob so that the symbol changes to pch = 2
grid.edit("dataSymbols", pch = 2)
# OOPS! The symbols have only a fill assigned, but pch = 2 does not have a fill
# So, give the symbols a blue border
grid.edit("dataSymbols", gp = gpar(col = "blue"))

White space generated in grid.arrange

I need to arrange several plots for a figure. I am creating individual plots using base and grid graphics. In order to arrange them in a single figure I have been using grid.echo(), grid.grab() to convert to grobs and then arrangeGrob() and grid.arrange() to build the final figure. A few weeks ago my tentative figure was working fine but now when I rerun the code it produces a figure with whitespace in the margins of the plots.
I add a minimal example that shows the problem that I am facing...
##minimal example
library(grid)
library(gridExtra)
library(gridGraphics)
##test plot
plot_n1<-plot(1:10,1:10, asp=1)
##convert test plot to grob
grid.echo()
test_p<-grid.grab()
##simulate several plots arranged in a more complex layout
multi<-arrangeGrob(test_p, test_p, test_p, test_p, ncol=1, heights=c(1/4,1/4,1/4,1/4))
##create graph
png(filename="minimal_multiplot.png", res=300, width=20, height=20, units="cm")
grid.arrange(test_p, multi, ncol=2, widths=c(2/3,1/3))
dev.off()
What am I doing wrong?
There does indeed appear to be a problem when converting a graphics plot into a grid plot, then using grid.grab() to grab and then draw the plot into a smaller regions (i.e., using your method). For instance, using viewports to define a slightly smaller region (coloured grey in the image below), axis material is missing.
# Packages
library(grid)
library(gridGraphics)
plot(1:10,1:10)
grid.echo()
test_p = grid.grab()
grid.newpage()
pushViewport(viewport(x = 0, width = .85, just = "left"))
grid.rect(gp = gpar(col = NA, fill = "grey90"))
grid.draw(test_p)
upViewport()
grid.rect(gp = gpar(col = "grey90", size = .1, fill = NA))
But Paul Murrell (author of the gridGraphics package) offers an alternative (see the examples at ?gridGraphics::grid.echo, and pp. 156-157 of The gridGraphics package in The R Journal v7/1). One can define a function that draws the plot, then that function becomes the argument of grid.echo() at the time of drawing the plot within the viewport. newpage = FALSE stops grid from opening a new page. Note that none of the axis material is chopped off.
pf = function() {
plot(1:10,1:10)
}
grid.newpage()
pushViewport(viewport(x = 0, width = .85, just = "left"))
grid.rect(gp = gpar(col =NA, fill = "grey90"))
grid.echo(pf, newpage=FALSE)
upViewport()
grid.rect(gp = gpar(col = "grey90", size = .1, fill = NA))
So to get your desired plot, I would do something like this - but still using viewports.
pf = function() {
par(mar=c(7.2, 7.2, 1, 1), mex = .3, tcl = .15, mgp = c(3, .15, 0))
plot(1:10, 1:10, cex.axis = .75, cex.lab = .75)
}
grid.newpage()
pushViewport(viewport(layout = grid.layout(3, 2,
widths = unit(c(2, 1), "null"),
heights = unit(c(1, 1, 1), "null"))))
pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1:3))
grid.echo(pf, newpage = FALSE)
upViewport()
for(i in 1:3) {
pushViewport(viewport(layout.pos.col = 2, layout.pos.row = i))
grid.echo(pf, newpage = FALSE)
upViewport()
}
upViewport()
grid.rect(gp = gpar(col = "grey90", size = .1, fill = NA))

Single colorkey for raster and points Levelplot R

Using the sample data below, how can I generate rasters and spatial points plot with the same colorkey as in the "manually" joined plot shown below?
library(rasterVis)
library(raster)
library(colorRamps)
col=colorRampPalette(matlab.like2(255))
s <- stack(replicate(2, raster(matrix(runif(100), 10))))
xy <- data.frame(coordinates(sampleRandom(s, 10, sp=TRUE)),
z1=runif(10), z2=runif(10))
levelplot(s, margin=FALSE, at=seq(0, 1, 0.05),col.regions=col)
x=xy$x;y=xy$y;z=xy$z1
levelplot(z ~ x + y,contour=F, panel = panel.levelplot.points,
margin=FALSE,col.regions=col,
par.settings=list(axis.line=list(lwd=3), strip.border=list(lwd=3)),
cex=1.4, scales=list(x=list(cex=1.7),y=list(cex=1.7)),xlab=list(label="Longitude",cex=2),
ylab=list(label="Latitude",cex=2))
Thanks to #fdestch I was able to generate the following plot using:
latticeCombineGrid(mget(rep("pp", 24)), layout = c(3, 8))
following my comments on printing multiple plots with the same colorkey.
An issue that remains to be clarified:
1) How can one decide on the order of panels? That is, which row & column to place a particular plot just as in levelplot using index.cond.
First of all, you should probably make sure that the breaks in the points plot are identical with those defined in the first levelplot.
## raster plot with colorkey disabled
pr <- levelplot(s, margin = FALSE, at = seq(0, 1, 0.05), col.regions = col,
colorkey = FALSE, xlab = list("Longitude", col = "transparent"))
## points plot
pp <- levelplot(z ~ x + y, panel = panel.levelplot.points, cex = 1.4,
contour = FALSE, margin = FALSE, col.regions = col,
colorkey = list(at = seq(0, 1, .05), width = .6, height = .6),
xlab = "Longitude", ylab = "Latitude")
Please note the definition of a transparent xlab when creating the raster plot. This little workaround comes in quite handy when using downViewport later on to ensure that the actual plot boundaries of pr and pp overlap (feel free to run grid.rect() right after print(pr, newpage = FALSE) to see what I mean).
The actual plot arrangement can then easily be achieved by using viewports from the grid package.
library(grid)
library(lattice)
## initialize new grid device
grid.newpage()
## add raster plot
vp1 <- viewport(x = 0, y = 0, width = .5, height = 1,
just = c("left", "bottom"))
pushViewport(vp1)
print(pr, newpage = FALSE)
## add points plot
downViewport(trellis.vpname("page"))
vp2 <- viewport(x = 1, y = 0, width = .75, height = 1,
just = c("left", "bottom"))
pushViewport(vp2)
print(pp, newpage = FALSE)
Here is my solution using latticeExtra::c.trellis:
library(raster)
library(rasterVis)
s <- stack(replicate(2, raster(matrix(runif(100), 10))))
xy <- data.frame(coordinates(sampleRandom(s, 10, sp=TRUE)),
z1=runif(10), z2=runif(10))
## Define theme and breaks
myTheme <- BTCTheme()
my.at <- seq(0, 1, 0.05)
Plot the Raster* object, using rasterVis::levelplot:
p1 <- levelplot(s, margin=FALSE,
at = my.at,
par.settings = myTheme)
Plot the points, using lattice::levelplot:
p2 <- levelplot(z1 ~ x + y, data = xy,
at = my.at,
panel = panel.levelplot.points,
par.settings = myTheme)
Join them with latticeExtra::c.trellis:
p3 <- c(p1, p2, layout = c(3, 1))
Unfortunately, c.trellis does not assign the strip labels correctly, so you have to define them directly:
update(p3,
strip = strip.custom(factor.levels = c(names(s), "Points")))

pseudocolors in R

I'd like to take this kind of 16-bit TIFF image as input:
then turn the grayscale into rainbow pseudocolors like this:
and add a color key before exporting the resulting image again as TIFF image.
Is there a way to turn a grayscale image to a pseudocolor image in R?
Or, if you take gif as input:
library(caTools)
y <- read.gif("the.gif")
# create color palette based on brightness of colors (bright = red, dark = blue)
brightness <- colSums(col2rgb(y$col))
pal <- colorRampPalette(c("darkblue", "skyblue", "yellow", "red", "darkred"),
bias=1)(max(brightness)+1)
# prepare export
tiff("the.tiff", compression = "lzw")
par(mfrow=c(2,1), mar=rep(1,4))
# plot original image
image(y$image, col=y$col,
xaxt="n", yaxt="n", bty="n", asp = 1)
# plot rotated image with new pal below
image(apply(y$image, 1, rev), col=pal[brightness+1],
xaxt="n", yaxt="n", bty="n", asp = 1)
# create dummy legend with reduced 5 color palette
clusters <- kmeans(t(col2rgb(pal[brightness+1])),
centers = k <- 5)
legend(x="right", fill=rgb(clusters$centers/255),
legend=replicate(k,
paste(letters[sample(1:10, 5)],
collapse="")))
# export to tiff
dev.off()
I've worked out the following solution for this problem (using the following image http://www.biomedimaging.org/BookImages/GeneExpressionCy3.tif as an example). The following code reads the grayscale TIFF image, rotates it 90° counterclockwise and uses a colour palette to generate an image with pseudocolors.
library(tiff)
library(RColorBrewer)
img <- readTIFF("example.tif")
colnum <- 256
cols <- ceiling(img[,,1] * (colnum - 1) + 1)
# If img consists of a 2D-array: cols <- ceiling(img * (colnum - 1) + 1).
# Use cols <- ceiling(t(img[,,1] * (colnum - 1) + 1)) if you don't want to
# rotate the image.
#pal <- colorRampPalette(c("darkblue", "skyblue", "yellow", "red", "darkred"),
# bias = 1)(colnum) as suggested by #lukeA
pal <- colorRampPalette(brewer.pal(9, "YlOrBr"), space = 'rgb')(colnum)
# Create lookup-table to match the palette colours with the numeric values
lut <- data.frame(col = 1:colnum, pal, stringsAsFactors = FALSE)
cols2 <- lut[match(cols, lut[,1]),2]
dim(cols2) <- dim(cols)
img.width <- dim(cols)[1]
img.height <- dim(cols)[2]
tiff("example_coloured.tiff", width = img.width, height = img.height,
units = "px", res = 300)
layout(matrix(c(1,2), nrow = 1), widths = c(4,1), heights = c(4,4))
layout.show(2)
par(mar = c(0,0,0,0))
image(matrix(1:(img.height * img.width), ncol = img.height, nrow = img.width),
col = cols2, xaxt = "n", yaxt = "n", frame.plot = FALSE)
par(mar = c(0,0.1,0,0))
image(t(matrix(1:img.width, ncol = 1, nrow = img.width)),
col = pal, xaxt = "n", yaxt = "n", frame.plot = FALSE)
dev.off()
The only thing I'm still missing is how to add some text (e.g. -high / -low at the ends) to the colour key. I would be grateful for any hints.

How to plot multiple 'image' and 'plot.default' graphics in a same device?

I have a function, which uses spatstat's colourmap function to generate a color scale to a plot. The colourmap function uses the image function to plot the color scale. Here is an example:
library(spatstat)
set.seed(1)
dat <- data.frame(x = 1:10, y = 10:1, z = rnorm(10,6,8))
plot_this <- function(x,y,z) {
colpal <- colorRampPalette(c("red", "blue"), bias=1)(20)
colmap <- colourmap(colpal, range = range(z))
layout(matrix(c(1,2), nrow = 1), widths = c(9,1))
par(mar = c(4, 4, 2.5, 1) + 0.1)
plot(x, y, type = "p", bg = colmap(z), pch = 21, cex = 3)
par(mar=c(1,0.5,3,2))
plot(colmap, vertical = TRUE)}
plot_this(dat$x, dat$y, dat$z)
I would like to plot several of these plots side-by-side, but my attempts fail:
par(mfcol = c(1,2))
plot_this(dat$x, dat$y, dat$z)
plot_this(dat$x, dat$y, dat$z)
dev.off()
layout(matrix(c(1,2), nrow = 1))
plot_this(dat$x, dat$y, dat$z)
plot_this(dat$x, dat$y, dat$z)
dev.off()
library(gridExtra)
grid.arrange(grob(plot_this(dat$x, dat$y, dat$z)), grob(plot_this(dat$x, dat$y, dat$z)), ncol = 2)
I found a tread, where Dr. Paul Murrell says that image.plot is incompatible with layout. However, I do believe that the problem is solvable. How can I improve the code to enable plotting using layout or par?
I would like to do something like following, but to include the color scale for each plot separately:
plot_this2 <- function(x,y,z) {
colpal <- colorRampPalette(c("red", "blue"), bias=1)(20)
colmap <- colourmap(colpal, range = range(z))
plot(x, y, type = "p", bg = colmap(z), pch = 21, cex = 3)
}
layout(matrix(c(1,2), nrow = 1))
plot_this2(dat$x, dat$y, dat$z)
plot_this2(dat$x, dat$y, dat$z)
EDIT: #IShouldBuyABoat suggested looking into gridBase. There is a nice SO answer for mixing base and ggplot graphics, but I cannot find a working combination of grid functions to make the plot. Here is one of the trials:
library(gridBase)
plot_this <- function(x,y,z) {
plot.new()
colpal <- colorRampPalette(c("red", "blue"), bias=1)(20)
colmap <- colourmap(colpal, range = range(dat$z))
gl <- grid.layout(nrow=1, ncol=2, widths = c(9,1))
vp.1 <- viewport(layout.pos.col=1, layout.pos.row=1)
vp.2 <- viewport(layout.pos.col=2, layout.pos.row=1)
pushViewport(viewport(layout=gl))
pushViewport(vp.1)
par(new=TRUE, fig=gridFIG(), mar = c(4, 4, 2.5, 1) + 0.1)
plot(dat$x, dat$y, type = "p", bg = colmap(dat$z), pch = 21, cex = 3)
popViewport(1)
pushViewport(vp.2)
par(new=TRUE, fig=gridFIG(), mar = c(1,0.5,3,2))
print(plot(colmap, vertical = TRUE))
popViewport(0)}
graphics.off()
plot.new()
gl <- grid.layout(ncol = 2, nrow = 1)
vp.1 <- viewport(layout.pos.col=1, layout.pos.row=1)
vp.2 <- viewport(layout.pos.col=2, layout.pos.row=1)
pushViewport(viewport(layout=gl))
pushViewport(vp.1)
plot_this(dat$x, dat$y, dat$z)
popViewport()
pushViewport(vp.2)
par(new=TRUE, fig=gridFIG())
plot_this(dat$x, dat$y, dat$z)
popViewport(1)
The main problem is that you can only use one kind of layout-control mechanism at a time. The command layout is not compatible with manipulating the layout using par(mfrow) etc.
A solution would be to remove the layout call from the function plot_this. Instead, inside plot_this, first create a basic plot coordinate system by
plot(0,0,xlim=c(0,1), ylim=c(0,1), type="n", axes=FALSE)
Then add the scatterplot using points(...., add=TRUE)
and add the colour map using plot(..., add=TRUE, xlim, ylim) where the latter is a call to the spatstat function plot.colourmap.

Resources