Thanks to the excellent answer in "Combine a ggplot2 object with a lattice object in one plot" and some further thoughts I could plot a lattice plot next to a ggplot:
library(ggplot2)
library(lattice)
library(gtools)
library(plyr)
library(grid)
library(gridExtra)
set.seed(1)
mdat <- data.frame(x = rnorm(100), y = rnorm(100), veryLongName = rnorm(100),
cluster = factor(sample(5, 100, TRUE)))
cols <- c("x", "y", "veryLongName")
allS <- adply(combinations(3, 2, cols), 1, function(r)
data.frame(cluster = mdat$cluster,
var.x = r[1],
x = mdat[[r[1]]],
var.y = r[2],
y = mdat[[r[2]]]))
sc <- ggplot(allS, aes(x = x, y = y, color = cluster)) + geom_point() +
facet_grid(var.x ~ var.y) + theme(legend.position = "top")
sc3d <- cloud(veryLongName ~ x + y, data = mdat, groups = cluster)
scG <- ggplotGrob(sc)
sc3dG <- gridExtra:::latticeGrob(sc3d)
ids <- grep("axis-(l|b)-(1|2)|panel", scG$layout$name)
scG$grobs[ids[c(2, 5, 8)]] <- list(nullGrob(), nullGrob(), nullGrob())
grid.newpage()
grid.draw(scG)
pushViewport(viewport(0, 0, width = .515, height = .46,
just = c("left", "bottom")))
grid.rect()
grid.draw(sc3dG)
As you can see in the picture there is quite some margin around the lattice plot and on top of it the axis label for the z-axis is cut (which is not the case is I plot the lattice plot alone).
So how can I get rid of this behaviour, thus how to solve the follwing two problems:
Get rid of the inner margin between the viewport and the lattice plot
Avoid that the label in the lattice plot is cut.
I tried to play with the clip option of the viewport but without success. So, what to do?
Update 2020
Edited code and answer to reflect new naming convention in the grob.
those settings are probably somewhere in ?xyplot, but I find it's faster to read the internet,
theme.novpadding <-
list(layout.heights =
list(top.padding = 0,
main.key.padding = 0,
key.axis.padding = 0,
axis.xlab.padding = 0,
xlab.key.padding = 0,
key.sub.padding = 0,
bottom.padding = 0),
axis.line = list(col = 0),
clip =list(panel="off"),
layout.widths =
list(left.padding = 0,
key.ylab.padding = 0,
ylab.axis.padding = 0,
axis.key.padding = 0,
right.padding = 0))
sc3d <- cloud(veryLongName ~ x + y, data = mdat, groups = cluster,
par.settings = theme.novpadding )
scG <- ggplotGrob(sc)
sc3dG <- grobTree(gridExtra:::latticeGrob(sc3d),
rectGrob(gp=gpar(fill=NA,lwd=1.2)))
ids <- grep("axis-(l|b)-(1|2)|panel", scG$layout$name)
scG$grobs[ids[c(5, 2, 8)]] <- list(nullGrob(), sc3dG, nullGrob())
grid.newpage()
grid.draw(scG)
Related
I'm trying to use the rayshader package in R to produce an elevation plot with points on the surface (or floating just above) that represent where samples were taken. However, I can't seem to get the points to show up on the map, or when they do, they don't show up where I expect them.
Here's a toy example:
library(raster)
set.seed(1)
x <- raster(ncol=50, nrow=50, xmn=-1, xmx=1, ymn=-1, ymx=1)
res(x) <- .5
x[] <- rnorm(16, -5, 10)
fakepoints <- data.frame(x = c(0, -.5),
y = c(0, 0))
fakepoints$elev <- (raster::extract(x, fakepoints))
x_dat <- data.frame(rasterToPoints(x, spatial = T))
library(rayshader)
library(ggplot2)
e_mat = raster_to_matrix(x)
a <- ggplot()+
geom_tile(data =x_dat, aes(x =x, y = y, fill = layer ))+
scale_fill_gradientn(colors = rev(topo.colors(10)))
height <- plot_gg(a, multicore = TRUE, raytrace = TRUE, width = 7, height = 4,
scale = 300, windowsize = c(1400, 866), zoom = .5, theta = 30, max_error = 0.001,save_height_matrix = T)
render_points(extent = attr(x,"extent"),
size = 10,
color = "black",
heightmap = height,
altitude = fakepoints$elev+.1,
zscale = 1,
offset = 0,
lat = fakepoints$y, long = fakepoints$x,
clear_previous = T)
The points should show up at (0,0) and (-.5, 0), but I can't see to make them appear anywhere.
I am trying to write the base R code, using tidyverse style.
I know this question, it just did not work for me for some reasons.
> dput(my_df)
c(0.492476485097794, 0, -0.0571584138399486, -0.348306694268216,
0.510825623765991, -0.0512932943875506, -0.0540672212702757,
-0.325422400434628, 0.526093095896779, 0, -0.0465200156348928,
-0.336472236621213, 0.550046336919272, 0, -0.0800427076735366,
-0.287682072451781, 0.51082562376599, 0, -0.0689928714869512,
-0.287682072451781, 0.481838086892739, 0, -0.060624621816435,
-0.287682072451781, 0.432864082296279, 0, -0.0555698511548109,
-0.336472236621213, 0.470003629245736, 0.0246926125903714,
-0.075985906977922,
-0.305381649551182, 0.517943091534855, 0, -0.0434851119397388,
-0.31015492830384, 0.473784352085642, -0.0190481949706944,
-0.0392207131532814,
-0.2484613592985, 0.413975797776073, 0.0168071183163813, 0,
-0.22314355131421,
0.362905493689368, 0.0143887374520996, -0.0143887374520996,
-0.191055236762709,
0.375789339962048, -0.0121213605323448, -0.0500104205746613,
-0.152016207298626, 0.370018359112417, -0.0421114853501268,
-0.0666913744986723,
-0.175448677506193, 0.304660408986199, -0.010152371464018, 0,
-0.190518323998133, 0.359141036433926, -0.0996298409488412,
0.00947874395454378,
-0.186102279633861, 0.358945092473272, -0.0655972824858133,
-0.00851068966790863,
-0.218879152527752, 0.292987124681474, -0.091349778588228, 0.042559614418796,
-0.162518929497775, 0.234839591077401, -0.064021858764931,
0.0163938097756764,
-0.177455367142782, 0.270545790208794)
I did some work in base R, finding characteristic polynomial roots and drawing the circle.
But I really want to do it, using ggplot2, just do not know how.
My base R code is:
library(plotrix)
gdpDiff <- diff(my_df)
m1 = ar(gdpDiff, method = 'mle')
m1$order
m1$x.mean
m1$ar
p1 = c(1, -m1$ar)
r1 = polyroot(p1)
r1
r1Re <- Re(r1)
r1Im <- Im(r1)
Mod(r1)
plot(r1Re, r1Im, asp = 1, xlim = c(min(r1Re), max(r1Re)), ylim = c(min(r1Im), max(r1Im)))
draw.circle(0, 0, radius = 1)
abline(v = 0)
abline(h = 0)
My current result is (with 4 dots):
Any chance to do the same, using ggplot? I would greatly appreciate your help.
While this is not entirely with ggplot2, the package ggforce has a function (geom_circle) for making circles. You can use that. I have written a function to convert the real and imaginary parts into a tibble and you can then use it to plot further:
library(ggplot2)
library(ggforce)
library(plotrix)
poly_fun <- function(my_vector) {
gdpDiff <- diff(my_vector)
m1 <- ar(gdpDiff, method = 'mle')
p1 <- c(1, -m1$ar)
r1 <- polyroot(p1)
tibble(
real = Re(r1),
imaginary = Im(r1)
)
}
df <- poly_fun(my_df)
ggplot() +
geom_circle(data = tibble(x = 0, y = 0), aes(x0 = x, y0 = y, r = 1)) +
geom_point(data = df, aes(x = real, y = imaginary)) +
xlim(min(df$real), max(df$real)) +
ylim(min(df$imaginary), max(df$imaginary)) +
coord_fixed(ratio = 1) +
geom_hline(yintercept = 0) +
geom_vline(xintercept = 0)
I am trying to align three plots (with different scales on the y-axis) on the left y-axis. In other words, I would like the red axis to be aligned:
However, the y-axis of the first plot does not align with the y-axis of the bottom left plot.
Code
# Libraries
library(tidyverse)
library(cowplot)
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
combi_p2 <- plot_grid(p2, p2, nrow = 1)
plot_grid(p1, combi_p2, ncol = 1, axis = "l", align = "v")
Attempt to fix it
Using the information provided here, I rewrote the last part of the code:
require(grid) # for unit.pmax()
p1 <- ggplotGrob(p1) # convert to gtable
combi_p2 <- ggplotGrob(combi_p2) # convert to gtable
p1.widths <- p1$widths[1:3] # extract the first three widths,
# corresponding to left margin, y lab, and y axis
combi_p2.widths <- combi_p2$widths[1:3] # same for combi_p2 plot
max.widths <- unit.pmax(p1.widths, combi_p2.widths) # calculate maximum widths
p1$widths[1:3] <- max.widths # assign max. widths to p1 gtable
combi_p2$widths[1:3] <- max.widths # assign max widths to combi_p2 gtable
# plot_grid() can work directly with gtables, so this works
plot_grid(p1, combi_p2, labels = "AUTO", ncol = 1)
Sadly, I was not able to fix the alignment:
Question
How do I align the y-axis of the top plot with the left bottom plot using cowplot in R?
I think you can use ggplotGrob and put them together with gtable_rbind and gtable_cbind. Finally, you can draw the plot with grid.draw()
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
frame_g2 <- gtable_frame(g2 , debug = TRUE)
frame_combi <- gtable_frame(gtable_cbind(frame_g2,frame_g2),
width = unit(2, "null"),
height = unit(1, "null"))
frame_g1 <-
gtable_frame(
g1,
width = unit(1, "null"),
height = unit(1, "null"),
debug = TRUE
)
grid.newpage()
all_frames <- gtable_rbind(frame_g1, frame_combi)
grid.draw(all_frames)
And this is how the plot looks.
A cowplot solution by Claus O. Wilke is presented here.
It is based on the align_plot function, which first aligns the top plot with the left bottom plot along the y-axis. Then the aligned plots are passed to the plot_grid function.
# Libraries
library(tidyverse)
library(cowplot)
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
plots <- align_plots(p1, p2, align = 'v', axis = 'l')
bottom_row <- plot_grid(plots[[2]], p2, nrow = 1)
plot_grid(plots[[1]], bottom_row, ncol = 1)
I'm producing a whole pile of graphs of changing sizes. I want each graph to display a symbol (say, asterisk) at a specific point on the graph margin (top y-axis value), regardless of plot size. Right now I do it manually by defining x/y for each textGrob, but there has got to be a better way.
Plot size is determined by number of categories in the dataset (toy data below). Ideally, the output plots would have identical panel sizes (I'm assuming that can be controlled through defining margin sizes in inches and adding that value to the height parameter?). Widths don't usually change, but it would be nice to automate both x and y placements based on the defined device width (and plot margins).
Thanks so much!
library(ggplot2)
library(gridExtra)
set.seed(123)
df <- data.frame(x = rnorm(20, 0, 1), y = rnorm(20, 0, 1), category = rep(c("a", "b"), each = 10))
## plot 1
sub <- df[df$category == "a",]
height = 2*length(unique(sub$category))
p <- ggplot(sub) +
geom_point(aes(x = x, y = y)) +
facet_grid(category ~ .)
jpeg(filename = "fig1.jpg",
width = 6, height = height, units = "in", pointsize = 12, res = 900,
quality = 100)
g <- arrangeGrob(p, sub = textGrob("*", x = 0.07, y = 10.15, hjust = 0, vjust=0, #### puts the top discharge value; might need to be adjusted manually in following years
gp = gpar(fontsize = 15)))
grid.draw(g)
dev.off()
## plot 2
height = 2*length(unique(df$category))
p <- ggplot(df) +
geom_point(aes(x = x, y = y)) +
facet_grid(category ~ .)
jpeg(filename = "fig2.jpg",
width = 6, height = height, units = "in", pointsize = 12, res = 900,
quality = 100)
g <- arrangeGrob(p, sub = textGrob("*", x = 0.07, y = 23.1, hjust = 0, vjust=0, #### puts the top discharge value; might need to be adjusted manually in following years
gp = gpar(fontsize = 15)))
grid.draw(g)
dev.off()
Is there any chance to write text which is "wrapped" around the circle? I mean something like this:
Yes, and here is the code, free of charge :-) . I wrote this a while back but I don't think ever published it in any CRAN package.
# Plot symbols oriented to local slope.
# Interesting problem: if underlying plot has some arbitrary aspect ratio,
# retrieve by doing: Josh O'B via SO:
# myasp <- with(par(),(pin[2]/pin[1])/(diff(usr[3:4])/diff(usr[1:2])))
# so make that the default value of argument 'asp'
# Default is 'plotx' is vector of indices at which to
# plot symbols. If is_indices=FALSE, only then turn to splinefun to
# calculate y-values and slopes; and user beware.
#
# 6 Feb 2014: added default col arg so can stick in a color vector if desired
# TODO
#
slopetext<-function(x,y,plotx, mytext, is_indices=TRUE, asp=with(par(), (pin[1]/pin[2])*(diff(usr[3:4])/diff(usr[1:2]))),offsetit= 0, col='black', ...) {
if (length(x) != length(y)) stop('data length mismatch')
if (!is.numeric(c(x,y,plotx) ) ) stop('data not numeric')
if(is_indices) {
# plotting at existing points.
if(any(plotx<=1) | any(plotx>= length(x))) {
warning("can't plot endpoint; will remove")
plotx<-plotx[(plotx>1 & plotx<length(x))]
}
lows<-plotx-1
highs<-plotx+1
# then interpolate low[j],high[j] to get slope at x2[j]
slopes <- (y[highs]-y[lows])/(x[highs]-x[lows]) #local slopes
# sign(highlow) fix the rotation problem
angles <- 180/pi*atan(slopes/asp) + 180*(x[lows] > x[highs] )
intcpts <- y[highs]-slopes*x[highs]
ploty <- intcpts + x[plotx]*slopes
# change name, so to speak, to simplify common plotting code
plotx<-x[plotx]
}else{
#interpolating at plotx values
if (any(plotx<min(x)) | any(plotx>max(x)) ) {
warning("can't plot extrapolated point; will remove")
plotx<-plotx[(plotx>min(x) & plotx<max(x))]
}
spf<-splinefun(x,y)
ploty<-spf(plotx)
angles <- 180/pi * atan(spf(plotx,1)/asp) #getting first deriv, i.e. slope
} #end of else
xlen<-length(plotx) # better match y and mytext
# The trouble is: srt rotates about some non-centered value in the text cell
# Dunno what to do about that.
dely <- offsetit*cos(angles)
delx <- offsetit*sin(angles)
# srt must be scalar
mytext<-rep(mytext,length=xlen)
col <- rep(col,length=xlen)
for (j in 1:xlen) text(plotx[j], ploty[j], labels=mytext[j], srt= angles[j], adj=c(delx,dely),col=col[j], ...)
}
Edit: per David's excellent suggestion, a sample case:
x <- 1:100
y <- x/20 + sin(x/10)
plot(x,y,t='l')
slopetext(x=x,y=y,plotx=seq(10,70,by=10),mytext=letters[1:8])
The third argument in this example selects every tenth value of (x,y) for placement of the text.
I should warn that I haven't idiot-proofed the is_indices=FALSE case and the spline fit may in extreme cases place your text in funny ways.
plotrix::arctext
library(plotrix)
# set up a plot with a circle
plot(x = 0, y = 0, xlim = c(-2, 2), ylim = c(-2, 2))
draw.circle(x = 0, y = 0, radius = 1)
# add text
arctext(x = "wrap some text", center = c(0, 0), radius = 1.1, middle = pi/2)
arctext(x = "counterclockwise", center = c(0, 0), radius = 1.1, middle = 5*pi/4,
clockwise = FALSE, cex = 1.5)
arctext(x = "smaller & stretched", center = c(0, 0), radius = 1.1, middle = 2*pi ,
cex = 0.8, stretch = 1.2)
circlize
For greater opportunities of customization, check the circlize package (see the circlize book). By setting facing = "bending" in circos.text, the text wraps around a circle.
library(circlize)
# create some angles, labels and their corresponding factors
# which determine the sectors
deg <- seq(from = 0, to = 300, by = 60)
lab <- paste("some text", deg, "-", deg + 60)
factors <- factor(lab, levels = lab)
# initialize plot
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
# add text to each sector
lapply(factors, function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending")
})
circos.clear()
From circlize version 0.2.1, circos.text has two new options: bending.inside which is identical to original bending and bending.outside (see Figure 3.4 in the circlize book). Thus, it is easy to turn the text in the bottom half of the plot using bending.outside:
circos.par(gap.degree = 10)
circos.initialize(factors = factors, xlim = c(0, 1))
circos.trackPlotRegion(ylim = c(0, 1))
lapply(factors[1:3], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.outside")
})
lapply(factors[4:6], function(deg){
circos.updatePlotRegion(sector.index = deg, bg.col = "red")
circos.text(x = 0.5, y = 0.5, labels = as.character(deg), facing = "bending.inside")
})
circos.clear()
The figure in the question can now be recreated quite easily in ggplot using the geomtextpath package:
library(geomtextpath)
df <- data.frame(x = c(0, 5.5, 6, 5.2, 0, 0.5, 0) + 8 * rep(0:5, each = 7),
y = rep(c(0, 0, 1, 2, 2, 1, 0), 6) + 8,
id = rep(1:6, each = 7))
df2 <- data.frame(x = c(3, 11, 19, 27, 35, 43), y = 9, id = 1:6,
z = paste("text", 0:5 * 60))
ggplot(df, aes(x, y, group = id)) +
geom_polygon(fill = "red", color = "black") +
geom_hline(yintercept = 9, color = "red", alpha = 0.3, size = 7) +
geom_textpath(data = df2, aes(label = z), size = 7, upright = FALSE) +
ylim(c(0, 10)) +
xlim(c(0, 48)) +
coord_polar(theta = "x", direction = -1, start = -pi/4) +
theme_void()
Disclaimer: I'm co-author of said package.