Converting corrplot output to grob - r

I am trying to use grid.arrange to combine multiple types of graph/table, one of which is a correlation matrix using corrplot. Is there a way to convert a corrplot to a grob or export/import as an image compatible with grid.arrange? Since the other plots I'm combining are from ggplot and tableGrob, I can't seem to use par(mfrow = c(2, 2)) or layout(matrix(1:2)) as suggested in other posts.
P1 <- corrplot(PANAcor, order="hclust", addgrid.col = "gray",
type="full", col = col2(50), tl.cex=1.5, tl.col="black",
method="color", tl.pos="lt", tl.srt=45, hclust.method = "average",
cl.ratio = 0.25, cl.align = "l", number.cex = 2)
summary <- grid.arrange(
top=textGrob(sprintf("%s Summary",subject), gp=gpar(fontsize=16,font=8)),
blank, P1, P2,
blank, T1, T2,
ncol=3, widths = c(0.1, 3, 3),
nrow=2, heights= c(1, 1),
bottom = textGrob(sprintf("%s run %s",version,runtime),
gp=gpar(fontsize=6,font=8), hjust=-1)
)
Error in gList(list(1, 0.45, 0.62, 0.55, 0.68, 0.64, -0.13, -0.37,
-0.22, : only 'grobs' allowed in "gList" In addition: Warning message: In grob$wrapvp <- vp : Coercing LHS to a list
Data:
PANAcor <- structure(c(1, 0.56, 0.68, -0.49, -0.4, -0.39, 0.56, 1, 0.64, -0.55,
-0.49, -0.54, 0.68, 0.64, 1, -0.69, -0.57, -0.65, -0.49,
-0.55, -0.69, 1, 0.82, 0.73, -0.4, -0.49, -0.57, 0.82, 1,
0.71, -0.39, -0.54, -0.65, 0.73, 0.71, 1),
.Dim = c(6L, 6L),
.Dimnames = list(c("Anxious", "Irritable", "Upset", "Happy",
"Enthusiastic", "Outgoing"),
c("Anxious", "Irritable", "Upset", "Happy",
"Enthusiastic", "Outgoing")))
col2 <- colorRampPalette(c("#7bffff","#7bbdff","#0000ff","black",
"#ff1a1a","#ff8000","#ffff4d"))

grid.echo + grid.grab from the gridGraphics package will convert a graphic drawn by corrplot into an identical-looking grob. Trouble is, the grob only looks identical at the exact same graphics device size.
Reproducing the problem:
library(gridGraphics)
library(grid)
corrplot(PANAcor, order="hclust", addgrid.col = "gray",
type="full", col = col2(50), tl.cex=1.5, tl.col="black",
method="color", tl.pos="lt", tl.srt=45, hclust.method = "average",
cl.ratio = 0.25, cl.align = "l", number.cex = 2)
## grab the scene as a grid object & save it to P1
grid.echo()
P1 <- grid.grab()
grid.draw(P1) # looks fine, until you resize the graphics device
Original size (looks identical to the graphic generated by corrplot:
Larger size (coloured regions remain squares, even though the matrix has extended to rectangular cells, & don't extend to the edge of each cell):
Smaller size (coloured regions have a minimum height / width, which cause them to spill out beyond the confines of each cell):
And if we arrange multiple grobs together, it's almost certainly going to look weird:
library(gridExtra)
grid.arrange(P1, P1, P1, layout_matrix = matrix(c(1, 1, 2, 3), nrow = 2, ncol = 2))
In short, due to the way corrplot draws the graphic, all other children grobs in P1 adjust in sync when the graphics device is re-sized, except for the grob responsible for colour.
Solution:
# save correlation matrix colors to a vector, then make coloured matrix grob transparent
matrix.colors <- getGrob(P1, gPath("square"), grep = TRUE)[["gp"]][["fill"]]
P1 <- editGrob(P1,
gPath("square"), grep = TRUE,
gp = gpar(col = NA,
fill = NA))
# apply the saved colours to the underlying matrix grob
P1 <- editGrob(P1,
gPath("symbols-rect-1"), grep = TRUE,
gp = gpar(fill = matrix.colors))
# convert the background fill from white to transparent, while we are at it
P1 <- editGrob(P1,
gPath("background"), grep = TRUE,
gp = gpar(fill = NA))
Replace gPath("square") with gPath("circle") if you use corrplot's default method. I haven't tested the other method options for the corresponding grob names, but the general principle should be similar.
Check that everything's aligned now:
grid.arrange(P1, P1, P1, layout_matrix = matrix(c(1, 1, 2, 3), nrow = 2, ncol = 2))
By the way, you may want to adjust the text size arguments in corrplot. Based on your current code, the labels appear rather large, and are liable to be cut off when you arrange multiple plots together.

Related

How to make a regular label in levelplot (lattice) with non-regular numbers?

I need make meteorological maps with package lattice. But i found a problem in comand levelplot(). I can make maps with the comand using a regular label. E.g: Correlation maps with label 0, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35 0.4... In this example the label skip five by five (Fig.1).
h1<- levelplot(var~x*y,data = idw.msk.dfr,contour=F,at=seq(0,0.5,0.05),
par.settings = paleta1,main = "correlation map",
xlab = NULL, ylab = NULL, ylim = c(-60,15), xlim = c(-90,-30))
Figure 1:
But, i need make maps with non-regular values. E.g: 0, 0.1, 0.15, 0.2, 0.22, 0.25, 0.40... When put this values in code, i get this result (Fig.2):
h1<- levelplot(var~x*y,data = idw.msk.dfr,contour=F,at=c(0,0.1,0.15,0.2,0.22,0.25,0.4,0.5),
par.settings = paleta1,main = "correlation map",
xlab = NULL, ylab = NULL, ylim = c(-60,15), xlim = c(-90,-30))
Figure 2
Note that the label of map is very strange and inrregular.
So. How do i solve this problem? I will apreciate your help.
You need to specify a custom colorkey. Add colorkey to the levelplot function.
x <- seq(pi/4, 5 * pi, length = 100)
y <- seq(pi/4, 5 * pi, length = 100)
r <- as.vector(sqrt(outer(x^2, y^2, "+")))
grid <- expand.grid(x=x, y=y)
grid$z <- cos(r^2) * exp(-r/(pi^3))
breaks <- c(0, 0.1, 0.15, 0.2, 0.22, 0.25, 0.4, 0.5)
levelplot(z~x*y, grid, at=breaks)
myColorkey=list(at=breaks, labels=list(at=breaks, labels=breaks))
levelplot(z~x*y, grid, colorkey=myColorkey)
To have the same size for the intervals change the at argument:
ats=seq(0, 0.5, by=0.07)
myColorkey=list(at=ats, labels=list(at=ats, labels=breaks))
levelplot(z~x*y, grid, colorkey=myColorkey)

Removing upper and lower CI from annotations in Metafor

I'm using the Metafor package to plot forest plots and I was wondering if anyone knew a way to omit the upper and lower CIs from the text annotations, for example where one group is a reference and outcome is fixed at 1.
Here is an example:
library(metafor)
par(mar=c(5,4,1,2))
forest(x = c(1, 0.9, 1.1),
ci.ub = c(1, 0.98, 1.18),
ci.lb = c(1, 0.82, 1.02),
refline = 1)
I would like to remove [1.00, 1.00] from the Study 1 row only, leaving just 1.00.
The only possibility I can think of would be to plot something in white over the top of these, but this would be fiddly, and I have a large complex plot with many groups.
You could play around with the graph produced by the call to the forest function, removing the annotation on the right-hand side with the option annotate = FALSE. After that, you could opt to add your own text with the function text (with limited possibilities) like in the code below.
library(metafor)
par(mar=c(5,4,1,2))
forest(x = c(1, 0.9, 1.1),
ci.ub = c(1, 0.98, 1.18),
ci.lb = c(1, 0.82, 1.02),
refline = 1,
annotate = FALSE, ### added
)
text(x = c(1.25, 1.25, 1.25), y = c(3, 2, 1),
label=c("1.00", "0.90", "1.10"))
This yields the following graph:

How to find an intersection of curve and circle?

I have a curve, derived from empirical data, and I can obtain a reasonable model of it. I need to identify a point (x, y) where the curve intersects a circle of known center and radius. The following code illustrates the question.
x <- c(0.05, 0.20, 0.35, 0.50, 0.65, 0.80, 0.95,
1.10, 1.25, 1.40, 1.55, 1.70, 1.85, 2.00,
2.15, 2.30, 2.45, 2.60, 2.75, 2.90, 3.05)
y <- c(1.52, 1.44, 1.38, 1.31, 1.23, 1.15, 1.06,
0.96, 0.86, 0.76, 0.68, 0.61, 0.54, 0.47,
0.41, 0.36, 0.32, 0.29, 0.27, 0.26, 0.26)
fit <- loess(y ~ x, control = loess.control(surface = "direct"))
newx <- data.frame(x = seq(0, 3, 0.01))
fitline <- predict(fit, newdata = newx)
est <- data.frame(newx, fitline)
plot(x, y, type = "o",lwd = 2)
lines(est, col = "blue", lwd = 2)
library(plotrix)
draw.circle(x = 3, y = 0, radius = 2, nv = 1000, lty = 1, lwd = 1)
To obtain the point of intersection we can use the optim function in r to do so:
circle=function(x){
if(4<(x-3)^2) return(NA)# Ensure it is limited within the radius
sqrt(4-(x-3)^2)
}
fun=function(x)predict(fit,data.frame(x=x))
g=function(x)(circle(x)-fun(x))# We need to set this to zero. Ie solve this
sol1=optimise(function(x)abs(g(x)),c(1,5))$min
[1] 1.208466
Thus the two functions should evaluate to the same value at x=1.208466..
To make it even more precise, you can use the optim function:
sol2= optim(1,function(x)abs(g(x)),g,method="Brent",upper=5,lower=1)$par
[1] 1.208473
Now you can evaluate:
circle(sol1)
[1] 0.889047
fun(sol1)
1
0.8890654
circle(sol2)
[1] 0.889061
fun(sol2)
1
0.889061
From the above, you can tell that solution 2 is very close..
Plotting this point on the graph will be challenging since the draw.circle function draws circles in proportionality with the zxes.. Thus changing everytime depending on how big the plot region is.
If you were to write your own circle function:
circleplot=function(x,y,r){
theta=seq(0,2*pi,length.out = 150)
cbind(x+r*cos(theta),y+r*sin(theta))
}
Then you can do:
plot(x, y, type = "o",lwd = 2)
lines(est, col = "blue", lwd = 2)
lines(circleplot(3,0,2))
abline(v=sol2,col=2)
points(sol2,fun(sol2),col=2,pch=16)
It's straightforward to find the intersection using functions from the sf package.
Calculate the circle values (inspired by this answer and as done by #Onyambu)
circ <- function(xc = 0, yc = 0, r = 1, n = 100){
v <- seq(0, 2 * pi, len = n)
cbind(x = xc + r * cos(v),
y = yc + r * sin(v))
}
m <- circ(xc = 3, yc = 0, r = 2)
Convert the predicted values and the circle values to "simple features" (LINESTRING), and find their intersection (a POINT):
library(sf)
int <- st_intersection(st_linestring(as.matrix(est)),
st_linestring(m))
int
# POINT (1.2091 0.8886608)
Add the intersection to your plot:
plot(x, y, type = "o", lwd = 2)
lines(est, col = "blue", lwd = 2)
lines(m)
points(int[1], int[2], col = "red", pch = 19)

Creating umbrella titles for aligned graphs in R

I have succeeded in creating and aligning three scatter-plots in R, using the following code:
par(mfrow = c(3,1))
plot(CGP.GOSL ~ FPT.MAF.GOSL, data = all.locs, main = "A. Place I")
abline(h=c(0.5))
abline(v=c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), lty=2)
plot(CGP.IRE ~ FPT.MAF.IRE, data = all.locs, main = "B. Place II")
abline(h=c(0.5))
abline(v=c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), lty=2)
plot(CGP.BAR ~ FPT.MAF.BAR, data = all.locs, main = "C. Place III")
abline(h=c(0.5))
abline(v=c(0.05, 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5), lty=2)
What I would like to do now is save space by having a single Axis label for the x and y axis. I have tried experimenting with the par() function, inserting x and ylab functions, but it seems that as these are not graphical parameters is will not accept them. I suspect the problem lies in where I place this information in the code, as using the xlab and ylab seems to make sense, and I can write x and ylab = "" in the individual plot codes.
I am also struggling to change the position of the main titles so that the appear on the left, to remove the values from the x-axis so that they only show at the bottom of the whole figure, and to arrange the figure so that there is less space.
This figure shows the current layout and the layout I want to achieve:
I am sorry to post so many questions at once. I am very new to R and programming am still finding the helpfiles a bit daunting, although I am getting there. Some suggestions on functions, where to put them and how to use them to achieve some of these aims would be great.
The documentation can be a bit challenging at times. Here's a skeleton for what I think you're looking for:
# 3 rows
par(mfrow=c(3,1))
# tighter margins
par(mar = c(0, 0, 0, 0), oma = c(4, 4, 0.5, 0.5))
# need some data
data(cars)
# 3 plots, no axis junk
plot(cars, ann=FALSE)
plot(cars, ann=FALSE)
plot(cars, ann=FALSE)
# outer labels
mtext("x axis", side = 1, outer = TRUE, cex = 0.7, line = 2.2)
mtext("y axis", side = 2, outer = TRUE, cex = 0.7, line = 2.2)
This answer is based on hrbrmstr's answer, but the result is closer to the requested layout:
# 3 rows
par(mfrow=c(3,1))
# Adjust margins. Each vector element refers to one side of the plot;
# the order is c(bottom, left, top, right). (See ?par)
par(mar = c(2.5, 4.1, 1, 2.1), oma = c(3, 3, 2, 0))
# need some data
data(cars)
# 3 plots. On the first two: Suppress axis labels (ann = FALSE) and
# the x axis (xaxt = "n"), then add the ticks using axis() and the
# title using mtext(). On the last one, do not suppress x axis.
# Note that repeating arguments could be set globally using par().
plot(cars, ann = FALSE, xaxt = "n")
axis(side = 1, labels = FALSE)
mtext(text = "A. Place I", side = 3, at = par("usr")[1], line = 1)
plot(cars, ann=FALSE, xaxt = "n")
axis(side = 1, labels = FALSE)
mtext(text = "B. Place II", side = 3, at = par("usr")[1], line = 1)
plot(cars, ann=FALSE)
mtext(text = "C. Place III", side = 3, at = par("usr")[1], line = 1)
# outer labels
mtext("X Axis label", side = 1, outer = TRUE)
mtext("Y Axis label", side = 2, outer = TRUE)

Offset size and overlay of plots in R

I have two plots that I would like to overlay in a particular way. Instead of side by side like when using par(), I would like one to sit inside the other, but be about a quarter the size.
More details: one of my plots is a map, another is a scatterplot with colored quadrants. The colored quadrants represent the colors plotted onto the map, so I would like to inset it nicely in the same plot as the map so that it serves as a legend.
Thanks in advance
Here's an example, although the links in comments point to similar approaches.
Grab a shapefile:
download.file(file.path('http://www.naturalearthdata.com/http/',
'www.naturalearthdata.com/download/50m',
'cultural/ne_50m_admin_1_states_provinces_lakes.zip'),
{f <- tempfile()})
unzip(f, exdir=tempdir())
Plotting:
library(rgdal)
shp <- readOGR(tempdir(), 'ne_50m_admin_1_states_provinces_lakes')
plot(subset(shp, admin=='Australia'),
col=sample(c('#7fc97f', '#beaed4', '#fdc086', '#ffff99'),
9, repl=TRUE))
opar <- par(plt=c(0.75, 0.95, 0.75, 0.95), new=TRUE)
plot.new()
plot.window(xlim=c(0, 1), ylim=c(0, 1), xaxs='i', yaxs='i')
rect(0, 0, 0.5, 0.5, border=NA, col='#7fc97f')
rect(0.5, 0, 1, 0.5, border=NA, col='#beaed4')
rect(0, 0.5, 0.5, 1, border=NA, col='#fdc086')
rect(0.5, 0.5, 1, 1, border=NA, col='#ffff99')
points(runif(100), runif(100), pch=20, cex=0.8)
box(lwd=2)
par(opar)
See plt under ?par for clarification.
This is how I did it in the past
grid.newpage()
vp <- viewport(width = 1, height = 1)
submain <- viewport(width = 0.9, height = 0.9, x = 0.5, y = 1,just=c("center","top"))
print(p, vp = submain)
subvp2 <- viewport(width = 0.2, height = 0.2, x = 0.39, y = 0.35,just=c("right","top"))
print(hi, vp = subvp2)
subvp1 <- viewport(width = 0.28, height = 0.28, x = 0.0, y = 0.1,just=c("left","bottom"))
print(ak, vp = subvp1)
in my case p, ak and hi were gg objects (maps created with ggplot) and I was inserting a small version of each near the main use map (p) - as it is typically done

Resources