xyplot bottom axis when last row has fewer panels than columns - r

Consider a lattice xyplot that has relation='fixed', alternating=FALSE, and as.table=TRUE.
If the last row of panels is incomplete (i.e. there are fewer panels than columns of the layout), the x-axis is not plotted. For example, panel 4 in the plot below does not have x-axis ticks/labels.
library(lattice)
d <- data.frame(x=runif(100), y=runif(100), grp=gl(5, 20))
xyplot(y~x|grp, d, as.table=TRUE, scales=list(alternating=FALSE, tck=c(1, 0)))
How can I add that axis?
Ideally I want axes only at bottom and left sides, and the incomplete row of panels at bottom (unlike when using as.table=FALSE, which plots the incomplete row at the top). For the example above, I'd like the axis plotted on the bottom border of panel 4, rather than in line with the x-axis of panel 5.
I know that this is easily solved with, e.g., a base graphics approach. I'm specifically interested in a lattice solution.

I am not a lattice expert, but I believe this might work. The idea was originally posted here. First I will regenerate the example:
library(lattice)
set.seed(1)
d <- data.frame(x=runif(100), y=runif(100), grp=gl(5, 20))
Next, lets define a function that will control the panel settings:
trellis.par.set(clip = list(panel = "off"))
myPan <- function(...){
panel.xyplot(...)
if(panel.number() == 4) {
at = seq(0,1,by = 0.2)
panel.axis("bottom", at = at, outside = T,
labels = T, half = F)
}
if(panel.number() == 5) {
at = seq(0,1,by = 0.2)
panel.axis("bottom",at = at, outside = T,
labels = T, half = F)
}
}
Now to the plot:
xyplot(y~x|grp, d, as.table=TRUE,
scales = list(
x = list(draw = F, relation="same"),
y = list(tck=c(1,0), alternating=F)),
layout = c(2,3),
panel = myPan)
As can be seen, in the xyplot command we asked not to draw the x axis (draw = F) but later panel calls myPan function. There we specifically demand to draw x-axis for panels 4 and 5.
output
Hope it can give you some direction for improvements.

Here's another approach based on code provided in a (now deleted) answer by #user20650. It uses grid directly, focussing on panels of the active trellis plot that are missing axes (or at least assumed to be missing axes), and adding them. We also assume that the x-scale is fixed.
The function (which also exists as a gist here):
add_axes <- function() {
library(grid)
library(lattice)
l <- trellis.currentLayout()
pan <- which(l[nrow(l), ]==0)
if(length(pan) > 0) {
g <- grid.ls(print=FALSE)
# use an existing panel as a template for ticks
ticks <- grid.get(g$name[grep("ticks.bottom.panel", g$name)][[1]])
# use an existing panel as a template for labels
labels <- grid.get(g$name[grep("ticklabels.bottom.panel", g$name)][[1]])
ax <- grobTree(ticks, labels)
invisible(sapply(pan, function(x) {
trellis.focus("panel", x, nrow(l)-1, clip.off=TRUE)
grid.draw(ax)
trellis.unfocus()
}))
}
}
An example:
library(lattice)
d <- data.frame(x=runif(100), y=runif(100), grp=gl(5, 20))
xyplot(y~x|grp, d, as.table=TRUE, scales=list(tck=c(1,0), alternating=FALSE),
layout=c(4, 2), xlim=c(-0.1, 1.1))
add_axes()

Related

How do I add multiple subplots into a multirow figure in R?

i need to overlay multiple subplots onto a single plot which is already contained inside a multirow figure (see image)
the reason why i need subplots instead of screen layout is because the figure will be possibly multicolumn, also (a 5 by 3 plot, in total)
there are packages which assist in doing subplots, but they break when you use multirow figures, and sequential subplots, except the first one, are rendered next to the overall figure border, not relative to the current row/column plot borders
i understand large packages such as ggplot2 allow this relatively easily, but base R plots are highly preferable
UPD:
the minimum reproducible example depicting the problem is here:
require(Hmisc)
COL.1 <- c('red','orange','yellow'); COL.2 <- c('blue','green','turquoise')
SUBPLOT.FUN <- function(COL) {plot(rnorm(100), type='l', col=COL)}
PLOT.FUN <- function(i) {
plot(rnorm(100),ylim=c(-1,1))
subplot(SUBPLOT.FUN(COL.1[i]), 100,1, vadj=1,hadj=1,pars=list(mfg=c(1,i)))
subplot(SUBPLOT.FUN(COL.2[i]), 100,-1,vadj=0,hadj=1,pars=list(mfg=c(1,i)))
}
plot.new(); par(mfrow=c(1,3))
for (i in 1:3) {
PLOT.FUN(i)
}
which looks like that:
while what is required is shown on the first image (meaning, EACH of the three plots must contain 3 subplots in their respective locations (along the right border, arranged vertically))
N.B. either the figure is multirow or multicolumn (as depicted) does not matter
Something like this? Inspired in this R-bloggers post.
# reproducible test data
set.seed(2022)
x <- rnorm(1000)
y <- rbinom(1000, 1, 0.5)
z <- rbinom(1000, 4, 0.5)
# save default values and prepare
# to create custom plot areas
old_par <- par(fig = c(0,1,0,1))
# set x axis limits based on data
h <- hist(x, plot = FALSE)
xlim <- c(h$breaks[1] - 0.5, h$breaks[length(h$breaks)] + 2)
hist(x, xlim = xlim)
# x = c(0.6, 1) right part of plot
# y = c(0.5, 1) top part of plot
par(fig = c(0.6, 1, 0.5, 1), new = TRUE)
boxplot(x ~ y)
# x = c(0.6, 1) right part of plot
# y = c(0.1, 0.6) bottom part of plot
par(fig = c(0.6, 1, 0.1, 0.6), new = TRUE)
boxplot(x ~ z)
# put default values back
par(old_par)
Created on 2022-08-18 by the reprex package (v2.0.1)

Is it possible to draw the axis line first, before the data?

This is a follow up to my previous question where I was looking for a solution to get the axis drawn first, then the data. The answer works for that specific question and example, but it opened a more general question how to change the plotting order of the underlying grobs. First the axis, then the data.
Very much in the way that the panel grid grob can be drawn on top or not.
Panel grid and axis grobs are apparently generated differently - axes more as guide objects rather than "simple" grobs. (Axes are drawn with ggplot2:::draw_axis(), whereas the panel grid is built as part of the ggplot2:::Layout object).
I guess this is why axes are drawn on top, and I wondered if the drawing order can be changed.
# An example to play with
library(ggplot2)
df <- data.frame(var = "", val = 0)
ggplot(df) +
geom_point(aes(val, var), color = "red", size = 10) +
scale_x_continuous(
expand = c(0, 0),
limits = c(0,1)
) +
coord_cartesian(clip = "off") +
theme_classic()
A ggplot can be represented by its gtable. The position of the grobs are given by the layout element, and "the z-column is used to define the drawing order of the grobs".
The z value for the panel, which contains the points grob, can then be increased so that it is drawn last.
So if p is your plot then
g <- ggplotGrob(p) ;
g$layout[g$layout$name == "panel", "z"] <- max(g$layout$z) + 1L
grid::grid.draw(g)
However, as noted in the comment this changes how the axis look, which perhaps, is due to the panel being drawn over some of the axis.
But in new exciting news from dww
if we add theme(panel.background = element_rect(fill = NA)) to the plot, the axes are no longer partially obscured. This both proves that this is the cause of the thinner axis lines, and also provides a reasonable workaround, provided you don't need a colored panel background.
Since you are looking for a more "on the draw level" solution, then the place to start is to ask "how is the ggplot drawn in the first place?". The answer can be found in the print method for ggplot objects:
ggplot2:::print.ggplot
#> function (x, newpage = is.null(vp), vp = NULL, ...)
#> {
#> set_last_plot(x)
#> if (newpage)
#> grid.newpage()
#> grDevices::recordGraphics(requireNamespace("ggplot2",
#> quietly = TRUE), list(), getNamespace("ggplot2"))
#> data <- ggplot_build(x)
#> gtable <- ggplot_gtable(data)
#> if (is.null(vp)) {
#> grid.draw(gtable)
#> }
#> else {
#> if (is.character(vp))
#> seekViewport(vp)
#> else pushViewport(vp)
#> grid.draw(gtable)
#> upViewport()
#> }
#> invisible(x)
#> }
where you can see that a ggplot is actually drawn by calling ggplot_build on the ggplot object, then ggplot_gtable on the output of ggplot_build.
The difficulty is that the panel, with its background, gridlines and data is created as a distinct grob tree. This is then nested as a single entity inside the final grob table produced by ggplot_build. The axis lines are drawn "on top" of that panel. If you draw these lines first, part of their thickness will be over-drawn with the panel. As mentioned in user20650's answer, this is not a problem if you don't need your plot to have a background color.
To my knowledge, there is no native way to include the axis lines as part of the panel unless you add them yourself as grobs.
The following little suite of functions allows you to take a plot object, remove the axis lines from it and add axis lines into the panel:
get_axis_grobs <- function(p_table)
{
axes <- grep("axis", p_table$layout$name)
axes[sapply(p_table$grobs[axes], function(x) class(x)[1] == "absoluteGrob")]
}
remove_lines_from_axis <- function(axis_grob)
{
axis_grob$children[[grep("polyline", names(axis_grob$children))]] <- zeroGrob()
axis_grob
}
remove_all_axis_lines <- function(p_table)
{
axes <- get_axis_grobs(p_table)
for(i in axes) p_table$grobs[[i]] <- remove_lines_from_axis(p_table$grobs[[i]])
p_table
}
get_panel_grob <- function(p_table)
{
p_table$grobs[[grep("panel", p_table$layout$name)]]
}
add_axis_lines_to_panel <- function(panel)
{
old_order <- panel$childrenOrder
panel <- grid::addGrob(panel, grid::linesGrob(x = unit(c(0, 0), "npc")))
panel <- grid::addGrob(panel, grid::linesGrob(y = unit(c(0, 0), "npc")))
panel$childrenOrder <- c(old_order[1],
setdiff(panel$childrenOrder, old_order),
old_order[2:length(old_order)])
panel
}
These can all be co-ordinated into a single function now to make the whole process much easier:
underplot_axes <- function(p)
{
p_built <- ggplot_build(p)
p_table <- ggplot_gtable(p_built)
p_table <- remove_all_axis_lines(p_table)
p_table$grobs[[grep("panel", p_table$layout$name)]] <-
add_axis_lines_to_panel(get_panel_grob(p_table))
grid::grid.newpage()
grid::grid.draw(p_table)
invisible(p_table)
}
And now you can just call underplot_axes on a ggplot object. I have modified your example a little to create a gray background panel, so that we can see more clearly what's going on:
library(ggplot2)
df <- data.frame(var = "", val = 0)
p <- ggplot(df) +
geom_point(aes(val, var), color = "red", size = 10) +
scale_x_continuous(
expand = c(0, 0),
limits = c(0,1)
) +
coord_cartesian(clip = "off") +
theme_classic() +
theme(panel.background = element_rect(fill = "gray90"))
p
underplot_axes(p)
Created on 2021-05-07 by the reprex package (v0.3.0)
Now, you may consider this "creating fake axes", but I would consider it more as "moving" the axis lines from one place in the grob tree to another. It's a shame that the option doesn't seem to be built into ggplot, but I can also see that it would take a pretty major overhaul of how a ggplot is constructed to allow that option.
Here's a hack that doesn't require going "under the hood", but rather uses patchwork to add another layer on top that is just the geom layer.
a <- [your plot above]
library(patchwork)
a + inset_element(a + them_void(), left = 0, bottom = 0, right = 1, top = 1)

How to add text to a specific/fixed location in rasterVis levelplot

In fact, this question is consist of two questions targeting the same behaviour.
How can I add text (varies by each panel) to a fixed location in
panel area? I'm aware of panel.text and latticeExtra::layer
solution but it adds text using plotting area coordinates. For
instance, I want to add text to bottom-right corner of each panel
even if their scales are different.
How to add text out of levelplot panel area(s)? Method explained
here requires that levelplot has a plot_01.legend.top.vp area
to add text which I don't have and the trellis object was plotted
before. Besides, I want to add text to left of ylab shown in the
figure below. I used ylab here to state the meaning of rows but I
need a second ylab that represents y-axis values. I found another
question for this problem but It does not work.
The plot above is created by raster::stack object and a rasterVis::levelplot method. I consent to a dirty solution even if I prefer an elegant one. Also despite the question above, I'm open to other approaches that use levelplot.
A very similar issue is currently being discussed on R-sig-Geo, just have a look at the solution I provided there. Here is the corresponding sample code which lets you add custom text annotations inside or outside the panel regions of a trellis graph using trellis.focus(..., clip.off = TRUE) from lattice.
library(rasterVis)
library(grid)
## sample data
f <- system.file("external/test.grd", package="raster")
r <- raster(f)
s <- stack(r, r+500, r-500, r+200)
p <- levelplot(s, layout = c(2, 2), names.att = rep("", 4),
scales = list(y = list(rot = 90)))
## labels
cls <- c("col1", "col2")
rws <- c("row1", "row2")
png("~/rasterVis.png", width = 14, height = 16, units = "cm", res = 300L)
grid.newpage()
print(p, newpage = FALSE)
## loop over panels to be labelled (ie 1:3)
panels = trellis.currentLayout()
for (i in 1:3) {
# focus on current panel of interest and disable clipping
ids <- which(panels == i, arr.ind = TRUE)
trellis.focus("panel", ids[2], ids[1], clip.off = TRUE)
# add labels
if (i %in% c(1, 3)) {
if (i == 1) {
grid.text(cls[1], x = .5, y = 1.1) # add 'col1'
grid.text(rws[1], x = -.35, y = .5, rot = 90) # add 'row1'
} else {
grid.text(rws[2], x = -.35, y = .5, rot = 90) # add 'row2'
}
} else {
grid.text(cls[2], x = .5, y = 1.1) # add 'col2'
}
trellis.unfocus()
}
dev.off()
You may find some further information here:
https://stat.ethz.ch/pipermail/r-help/2005-June/072745.html
http://r.789695.n4.nabble.com/How-to-put-text-outside-an-xyplot-td975850.html

incorporate standalone legend in ggpairs (take 2)

tl;dr can't get a standalone legend (describing common colours across the whole plot) in ggpairs to my satisfaction.
Sorry for length.
I'm trying to draw a (lower-triangular) pairs plot using GGally::ggpairs (an extension package for drawing various kinds of plot matrices with ggplot2). This is essentially the same question as How to add an external legend to ggpairs()? , but I'm not satisfied with the answer to that question aesthetically, so I'm posting this as an extension (if suggested/recommended by commenters, I will delete this question and offer a bounty on that question instead). In particular, I would like the legend to appear outside the sub-plot frame, either putting it within one virtual subplot but allowing additional width to hold it, or (ideally) putting it in a separate (empty) subplot. As I show below, both of my partial solutions have problems.
Fake data:
set.seed(101)
dd <- data.frame(x=rnorm(100),
y=rnorm(100),
z=rnorm(100),
f=sample(c("a","b"),size=100,replace=TRUE))
library(GGally)
Base plot function:
ggfun <- function(...) {
ggpairs(dd,mapping = ggplot2::aes(color = f),
columns=1:3,
lower=list(continuous="points"),
diag=list(continuous="blankDiag"),
upper=list(continuous="blank"),
...)
}
Function to trim top/right column:
trim_gg <- function(gg) {
n <- gg$nrow
gg$nrow <- gg$ncol <- n-1
v <- 1:n^2
gg$plots <- gg$plots[v>n & v%%n!=0]
gg$xAxisLabels <- gg$xAxisLabels[-n]
gg$yAxisLabels <- gg$yAxisLabels[-1]
return(gg)
}
gg0 <- trim_gg(ggfun(legends=TRUE))
Get rid of legends in left column (as in the linked question above):
library(ggplot2) ## for theme()
for (i in 1:2) {
inner <- getPlot(gg0,i,1)
inner <- inner + theme(legend.position="none")
gg0 <- putPlot(gg0,inner,i,1)
}
inner <- getPlot(gg0,2,2)
inner <- inner + theme(legend.position="right")
gg0 <- putPlot(gg0,inner,2,2)
Problems:
the blank panel behind the legend is actually masking some points; I don't know why it's not outside the panel as usual, I assume that's something that ggpairs is doing
if it were outside the panel (on top or to the right), I would want to make sure to leave some extra space so the panels themselves were all the same size. However, ggmatrix/ggpairs looks very inflexible about this.
The only alternative I've been able to try to far is following ggplot separate legend and plot by extracting the legend and using gridExtra::grid.arrange():
g_legend <- function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
library(gridExtra)
grid.arrange(getPlot(gg0,1,1),
g_legend(getPlot(gg0,2,2)),
getPlot(gg0,2,1),
getPlot(gg0,2,2)+theme(legend.position="none"),
nrow=2)
Problems:
the axes and labels suppressed by ggpairs are back ...
I also considered creating a panel with a special plot that contained only the legend (i.e. trying to use theme(SOMETHING=element.blank) to suppress the plot itself, but couldn't figure out how to do it.
As a last resort, I could trim the axes where appropriate myself, but this is practically reinventing what ggpairs is doing in the first place ...
With some slight modification to solution 1: First, draw the matrix of plots without their legends (but still with the colour mapping). Second, use your trim_gg function to remove the diagonal spaces. Third, for the plot in the top left position, draw its legend but position it into the empty space to the right.
data(state)
dd <- data.frame(state.x77,
State = state.name,
Abbrev = state.abb,
Region = state.region,
Division = state.division)
columns <- c(3, 5, 6, 7)
colour <- "Region"
library(GGally)
library(ggplot2) ## for theme()
# Base plot
ggfun <- function(data = NULL, columns = NULL, colour = NULL, legends = FALSE) {
ggpairs(data,
columns = columns,
mapping = ggplot2::aes_string(colour = colour),
lower = list(continuous = "points"),
diag = list(continuous = "blankDiag"),
upper = list(continuous = "blank"),
legends = legends)
}
# Remove the diagonal elements
trim_gg <- function(gg) {
n <- gg$nrow
gg$nrow <- gg$ncol <- n-1
v <- 1:n^2
gg$plots <- gg$plots[v > n & v%%n != 0]
gg$xAxisLabels <- gg$xAxisLabels[-n]
gg$yAxisLabels <- gg$yAxisLabels[-1]
return(gg)
}
# Get the plot
gg0 <- trim_gg(ggfun(dd, columns, colour))
# For plot in position (1,1), draw its legend in the empty panels to the right
inner <- getPlot(gg0, 1, 1)
inner <- inner +
theme(legend.position = c(1.01, 0.5),
legend.direction = "horizontal",
legend.justification = "left") +
guides(colour = guide_legend(title.position = "top"))
gg0 <- putPlot(gg0, inner, 1, 1)
gg0

scatter plot specifying color and labelling axis in r

I have following data and plot:
pos <- rep(1:2000, 20)
xv =c(rep(1:20, each = 2000))
# colrs <- unique(xv)
colrs <- xv # edits
yv =rnorm(2000*20, 0.5, 0.1)
xv = lapply(unique(xv), function(x) pos[xv==x])
to.add = cumsum(sapply(xv, max) + 1000)
bp <- c(xv[[1]], unlist(lapply(2:length(xv), function(x) xv[[x]] + to.add[x-1])))
plot (bp,yv, pch = "*", col = colrs)
I have few issues in this plot I could not figure out.
(1) I want to use different color for different group or two different color for different groups (i.e xv), but when I tried color function in terms to be beautiful mixture. Although I need to highlight some points (for example bp 4000 to 4500 for example with blue color)
(2) Instead of bp positions I want to put a tick mark and label with the group.
Thank you, appreciate your help.
Edits: with help of the following answer (with slight different approach in case I have unbalanced number in each group will work) I could get the similar plot. But still question remaining regarding colors is what if I want to use two alternate colors in alternate group ?
You can solve your colour issue by repeating the colour index however many times each group has a point plotted, like so:
plot (bp,yv, pch = "*", col = rep(colrs,each=2000))
The default colour palette (see ?palette or palette() ) will wrap around itself and you might want to specify your own to get 20 distinct colours.
To relabel the x axis, try plotting without the axis and then specifying the points and labels manually.
plot (bp,yv, pch = "*", col = rep(colrs,each=2000),xaxt="n")
axis(1,at=seq(1000,58000,3000),labels=1:20)
If you are trying to squeeze a lot of labels in there, you might have to shrink the text (cex.axis)or spin the labels 90 degrees (las=2).
plot (bp,yv, pch = "*", col = rep(colrs,each=2000),xaxt="n")
axis(1,at=seq(1000,58000,3000),labels=1:20,cex.axis=0.7,las=2)
Result:
One way is you could use a nested ifelse.
I'm still learning R, but one way it could be done would look something like:
plot(whatev$x, whatev$y, col=ifelse(xv<2000,red,ifelse(2000<xv & xv<4000,yellow,blue)))
You could nest as many of these as you want to have specificity on the colors and the intervals. The ifelse command is of form ifelse(TEST, True, False).
A simpler way would be to use the unique groups in xv to assign rainbow colors.
colrs=rainbow(length(unique(xv))) #Or colrs=rainbow(length(xv)) if xv is unique.
plot(whatev$x, whatev$y, col=colrs)
I hope I got all that right. I'm still learning R myself.
I'm going to go out on a limb and guess that your real data are something like 2000 values of things from 20 different groups. For instance, heights of 2000 plants of 20 different species. In such a case, you might want to look at the dotplot() function (or as illustrated below, dotplot.table()) in the lattice package.
Generate matrix of hypothetical values:
set.seed(1)
myY <- sapply( seq_len(20), function(x) rnorm(2000, x^(1/3)))
Transpose matrix to get groups as rows
myY <- t(myY)
Provide names of groups to matrix:
dimnames(myY)[[1]]<-paste("group", seq_len(nrow(myY)))
Load lattice package
library(lattice)
Generate dotplot
dotplot(myY, horizontal = FALSE, panel = function(x, y, horizontal, ...) {
panel.dotplot(x = x, y = y, horizontal = horizontal, jitter.x = TRUE,
col = seq_len(20)[x], pch = "*", cex = 1.5)
}, scales = list(x = list(rot = 90))
)
Which looks like (with unfortunate y-axis labeling):
Seeing that #JohnCLK is requesting a way of colouring by values on the x axis, I tried these demos in ggplot2-- each uses a dummy variable that is coded based on values or ranges to be highlighted in the other variables.
So, first set up the data, as in the question:
pos <- rep(1:2000, 20)
xv <- c(rep(1:20, each = 2000))
yv <- (2000*20, 0.5, 0.1)
xv <- lapply(unique(xv), function(x) pos[xv==x])
to.add <- cumsum(sapply(xv, max) + 1000)
bp <- c(xv[[1]], unlist(lapply(2:length(xv), function(x) xv[[x]] + to.add[x-1])))
Then load ggplot2, prepare a couple of utility functions, and set the default theme:
library("ggplot2")
make.png <- function(p, fName) {
png(fName, width=640, height=480, units="px")
print(p)
dev.off()
}
make.plot <- function(df) {
p <- ggplot(df,
aes(x = bp,
y = yv,
colour = highlight))
p <- p + geom_point()
p <- p + opts(legend.position = "none")
return(p)
}
theme_set( theme_bw() )
Draw a plot which highlights values in a defined range on the vertical axis:
# highlight a horizontal band
df <- data.frame(cbind(bp, yv))
df$highlight <- 0
df$highlight[ df$yv >= 0.4 & df$yv < 0.45 ] <- 1
p <- make.plot(df)
print(p)
make.png(p, "demo_horizontal.png")
Next draw a plot which highlights values in a defined range on the x axis, a vertical band:
# highlight a vertical band
df$highlight <- 0
df$highlight[ df$bp >= 38000 & df$bp < 42000 ] <- 1
p <- make.plot(df)
print(p)
make.png(p, "demo_vertical.png")
And finally draw a plot which highlights alternating vertical bands, by x value:
# highlight alternating bands
library("gtools")
alt.band.width <- 2000
df$highlight <- as.integer(df$bp / alt.band.width)
df$highlight <- ifelse(odd(df$highlight), 1, 0)
p <- make.plot(df)
print(p)
make.png(p, "demo_alternating.png")
Hope this helps; it was good practice anyway.

Resources