I wrote a function that will plot a user-specified number of parallel coordinate subplots, all in one big plot with one column:
library(gridExtra)
library(GGally)
plotClusterPar = function(cNum){
plot_i = vector("list", length=cNum)
for (i in 1:cNum){
x = data.frame(a=runif(100,0,1),b=runif(100,0,1),c=runif(100,0,1),d=runif(100,0,1))
plot_i[[i]] = ggparcoord(x, columns=1:4, scale="globalminmax", alphaLines = 0.9)+ylab("Count")
}
p = do.call("grid.arrange", c(plot_i, ncol=1))
}
The user will call (to create 3 subplots):
plotClusterPar(3)
There are four things I am trying to do, and when I try them, I get errors, so I left it at its bare working syntax! Here is what I aim to do:
1) I desire to have one y-axis label "Count", rather than an individual one for each subplot.
2) I do not wish to have any x-axis label. As default (currently), there is the label "variable" indicated under each subplot. If extra space (in between subplots) is created after removing an x-axis label, then I would like to erase that newly-created horizontal space (in between subplots).
3) I hope to color all lines in each subplot the same color. For instance, the top subplot would have all red lines, the next subplot would have all blue lines, etc. I do not mind what the colors are!
4) I strive to have a color legend at the bottom of all the subplots. (Similar to the first answer here: Universal x axis label and legend at bottom using grid.arrange), but of course the number of colors is just equal to the number of subplots.
EDIT:
I have tried to change the color, using things like:
plot_i[[i]] = ggparcoord(x, columns=1:4, scale="globalminmax", alphaLines = 0.9, colour=i)+ylab("Count")
Or hardcoding, which would not even work, because I have a loop. But this still does not work:
plot_i[[i]] = ggparcoord(x, columns=1:4, scale="globalminmax", alphaLines = 0.9, colour="red")+ylab("Count")
I tried adding colour as a layer, but that does not work:
plot_i[[i]] = ggparcoord(x, columns=1:4, scale="globalminmax", alphaLines = 0.9)+ylab("Count")+colour("red")
I also tried to give a common plot title and y-axis:
plotClusterPar = function(cNum){
plot_i = vector("list", length=cNum)
for (i in 1:cNum){
x = data.frame(a=runif(100,0,1),b=runif(100,0,1),c=runif(100,0,1),d=runif(100,0,1))
plot_i[[i]] = ggparcoord(x, columns=1:4, scale="globalminmax", alphaLines = 0.9)
}
p = do.call("grid.arrange", c(plot_i, ncol=1, main = textGrob("Main Title", vjust = 1, gp = gpar(fontface = "bold", cex = 1.5)), left = textGrob("Global Y-axis Label", rot = 90, vjust = 1)))
}
But this led to an error:
Error in arrangeGrob(..., as.table = as.table, clip = clip, main = main, :
input must be grobs!
Related
I create many plots in R with data input from another script that are held in a separate variable each. I put the variables in a string and force a line break with \n. This works as intended, but the legend is not justified at all. xjust and yjust seem to not do anything. Also, when placing the legend e.g. in bottomright, it stretches beyond the margin of the plot. Any idea how I can properly place my legend justified at the corner of a plot?
Here a reproducible code snippet:
plot(c(0,3), c(0,3), type="n", xlab="x", ylab="y")
a <- 2.3456
b <- 3.4567
c <- 4.5678
d <- 5.6789
Corner_text <- function(text, location = "bottomright"){
legend(location, legend = text, bty = "o", pch = NA, cex = 0.5, xjust = 0)
}
Corner_text(sprintf("a = %3.2f m\n b = %3.2f N/m\UB2\n c = %3.2f deg\n d = %3.2f perc", a, b, c, d))
legend is usually used to explain what the points or lines (and the different colors) represent. Therefore, inside the legend box (bty) there is a space where the lines/points are supposed to be. This probably explains why you think your text is not left-justified (you also have a problem of space after your line-break (\n): if you put a space after a line-break, it will be your first character on the next line, hence the text does not appear justified).
In your example, you don't have lines or points to explain, hence, I would use text rather than legend.
To know where "bottomright" is on your axes, you can use the graphical parameters par("xaxp") and par("yaxp") (it gives you the values of first and last ticks and the number of ticks on your axis).
On the x-axis, from the last tick, you need to shift left to have space for the widest line.
In R code, it gives:
# your plot
plot(c(0,3), c(0,3), type="n", xlab="x", ylab="y")
# your string (without the extra spaces)
text_to_put <- sprintf("a = %3.2f m\nb = %3.2f N/m\UB2\nc = %3.2f deg\nd = %3.2f perc", a, b, c, d)
# the width of widest line
max_str <- max(strwidth(strsplit(text_to_put, "\n")[[1]]))
# put the text
text(x=par("xaxp")[2]-max_str, y=par("yaxp")[1], labels=text_to_put, adj=c(0, 0))
# if really you need the box (here par("usr") is used to know the extreme values on both axes)
x_offset <- par("xaxp")[1]-par("usr")[1]
y_offset <- par("yaxp")[1]-par("usr")[3]
segments(rep(par("xaxp")[2]-max_str-x_offset, 2), c(par("usr")[3], par("yaxp")[1]+strheight(text_to_put)+y_offset), c(par("xaxp")[2]-max_str-x_offset, par("usr")[2]), rep(par("yaxp")[1]+strheight(text_to_put)+y_offset, 2))
An example on how to do this using ggplot2, where legend creation is automatic when you map a variable in aes:
library(ggplot2)
units <- c('m', 'N/m\UB2', 'deg', 'perc')
p <- ggplot() + geom_hline(aes(yintercept = 1:4, color = letters[1:4])) + #simple example
scale_color_discrete(name = 'legend title',
breaks = letters[1:4],
labels = paste(letters[1:4], '=', c(a, b, c, d), units))
Or inside the plot:
p + theme(legend.position = c(1, 0), legend.justification = c(1, 0))
Or closer to your easthetic:
p + guides(col = guide_legend(keywidth = 0, override.aes = list(alpha = 0))) +
theme_bw() +
theme(legend.position = c(1, 0), legend.justification = c(1, 0),
legend.background = element_rect(colour = 'black'))
I use the following script to generate a legend in R. But the legend box is too small... how do I increase the box width?
legend("topleft", lty = 1, legend = c("Sub_metering_1","Sub_metering_2","Sub_metering_3"),col = c("black","red","blue"))
You are probably resizing your graph after you plot it and the legend. If that is the case, and you want to keep the box, one option would be to plot the graph, resize it, and then generate the legend. Perhaps a better option would be to size the window to the desired width to start with:
# on Windows, you can use the `windows` function. elsewhere, try quartz or X11
windows(height = 7, width = 3.5)
plot(hp ~ mpg, data = mtcars)
leg <- legend("topleft", lty = 1,
legend = c("Sub_metering_1","Sub_metering_2","Sub_metering_3"),
col = c("black","red","blue"),
#plot = FALSE,
#bty = "n")
)
You can also define exactly where you want the box to fall by providing a pair of x and y coordinates to the legend function. Those values would represent the upper left and bottom right corners of the box. The legend function will actually generate the coordinates for the upper-left hand corner of the box along with the width and height. By default it returns them invisibly, but you can assign them to an object, and If you use the plot = FALSE, option to legend you can capture those coordinates and modify them as you wish without actually plotting the legend.
windows(height = 7, width = 3.5)
plot(hp ~ mpg, data = mtcars)
legend(x = c(9.46, 31), y = c(346.32, 298),
legend = c("Sub_metering_1","Sub_metering_2","Sub_metering_3"),
col = c("black","red","blue"),
lty = 1)
The legend function will actually generate the coordinates for the upper-left hand corner of the box (that's where I got 9.46 and 346.62) along with the width and height of the box. By default it returns them invisibly, but you can assign them to an object, and if you use the plot = FALSE, option to legend you can capture those coordinates and modify them as you wish without actually plotting the legend.
plot(hp ~ mpg, data = mtcars)
leg <- legend("topleft", lty = 1,
legend = c("Sub_metering_1","Sub_metering_2","Sub_metering_3"),
col = c("black","red","blue"),
plot = FALSE)
# adjust as desired
leftx <- leg$rect$left
rightx <- (leg$rect$left + leg$rect$w) * 1.2
topy <- leg$rect$top
bottomy <- (leg$rect$top - leg$rect$h) * 1
# use the new coordinates to define custom
legend(x = c(leftx, rightx), y = c(topy, bottomy), lty = 1,
legend = c("Sub_metering_1","Sub_metering_2","Sub_metering_3"),
col = c("black","red","blue"))
Part of the legend width is determined by the longest width of the labels you use, which is calculated via strwidth. Below an easy example how to halve or double the size by using legend(..., text.width = ...).
plot(1)
text = c("Sub_metering_1","Sub_metering_2","Sub_metering_3")
legend("topleft"
,lty = 1
,legend = text
,col = c("black","red","blue")
)
strwidth(text)
# [1] 0.1734099 0.1734099 0.1734099
# half the length
legend("bottomleft"
,lty = 1
,legend = text
,text.width = strwidth(text)[1]/2
,col = c("black","red","blue")
)
# double the length
legend("center"
,lty = 1
,legend = text
,text.width = strwidth(text)[1]*2
,col = c("black","red","blue")
)
I'm using lsmip from lsmeans to plot my model,
library(lsmeans)
PhWs1 <- lsmip(GausNugget1, Photoperiod:Ws ~ Month,
ylab = "Observed log(number of leaves)", xlab = "Month",
main = "Interaction between Photoperiod and Water stress over the months (3 photoperiods)",
par.settings = list(fontsize = list(text = 15, points = 10)))
but I was not able to get a suggestion on the internet on how to handle the legend position, size, title, etc.
I used trellis.par.get() to see the parameters but I could not find the one related to my issue. As you can see from the graph, the legend should be "Photoperiod*Ws" but Ws is not visible.
I see two possibly complementing alternatives to approach this issue. The first would be to create a fully customized legend and pass it on to the key argument of xyplot (which lsmip is heavily based on). Here is an example taken from ?lsmip to clarify my point.
## default trellis point theme
trellis_points <- trellis.par.get("superpose.symbol")
## create customized key
key <- list(title = "Some legend title", # legend title
cex.title = 1.2,
x = .7, y = .9, # legend position
points = list(col = trellis_points$col[1:2], # points
pch = trellis_points$pch[1:2],
cex = 1.5),
text = list(c("A", "B"), cex = .9)) # text
## create results and extract lattice plot
d <- lsmip(warp.lm, wool ~ tension, plotit = FALSE,
main = "Some figure title", key = key)
p <- attr(d, "lattice")
p
As you can see, setting up a customized legend let's you modify all the different components of the legend - including labels, text and symbol sizes, legend spacing, etc. Have a deeper look at the key argument described in ?xyplot which describes the various modification options in detail.
Now, if you have a long legend title and you do not want to include the legend inside the plot area, you could also define separate viewports, thus allowing the legend to occupy more space at the right margin. Note the use of update to remove the initially created legend from p and the subsequent assembly of the single figure components using grid functionality.
## remove legend from figure
p <- update(p, legend = NULL)
## assemble figure incl. legend
library(grid)
png("plot.png", width = 14, height = 10, units = "cm", res = 300)
grid.newpage()
## add figure without legend
vp0 <- viewport(x = 0, y = 0, width = .75, height = 1,
just = c("left", "bottom"))
pushViewport(vp0)
print(p, newpage = FALSE)
## add legend
upViewport(0)
vp1 <- viewport(x = .7, y = 0, width = .3, height = 1,
just = c("left", "bottom"))
pushViewport(vp1)
draw.key(key, draw = TRUE)
dev.off()
I'm using the code below to generate the following chart.
# Setup
data(airquality)
# Device start
png(filename = "example.png", units = "cm", width = 20, height = 14, res = 300)
# Define chart
pairs.chrt <- ggpairs(airquality,
lower = list(continuous = "smooth"),
diag = list(continuous = "blank"),
upper = list(continuous = "blank")) +
theme(legend.position = "none",
panel.grid.major = element_blank(),
axis.ticks = element_blank(),
axis.title.x = element_text(angle = 180, vjust = 1, color = "black"),
panel.border = element_rect(fill = NA))
# Device off and print
print(pairs.chrt)
dev.off()
I'm currently trying to modify the display of the axis titles. In particular, I would like for the axis titles to be:
Placed at a further distance from axis labels
Placed at an angle
As an example, I would like to obtain axis titles similar to the ones pictured below (I'm interested in axis labels only, not in rest of the chart):
Taken from : Geovisualist
I' tried adjusting my syntax changing the axis.title.x to different values but it does not yield the desired results. For instance running the code with angle = 45.
axis.title.x = element_text(angle = 45, vjust = 1, color = "black"),
panel.border = element_rect(fill = NA))
returns the same chart. I was able to control the axis labels by changing the axis.text.x for instance but I can't find the answer how to control the axis titles in this plot. Any help will be much appreciated.
Short answer: There doesn't seem to be an elegant or easy way to do it, but here's a workaround.
I dug into the ggpairs source code (in the GGally package source available from CRAN) to see how the variable labels are actually drawn. The relevant function in ggpairs.R is print.ggpairs. It turns out the variable labels aren't part of the ggplot objects in each cell of the plot matrix -- i.e. they're not axis titles, which is why they aren't affected by using theme(axis.title.x = element_text(angle = 45) or similar.
Rather, they seem to be drawn as text annotations using grid.text (in package 'grid'). grid.text takes arguments including x, y, hjust, vjust, rot (where rot is angle of rotation), as well as font size, font family, etc. using gpar (see ?grid.text), but it looks like there is currently no way to pass in different values of those parameters to print.ggpairs -- they're fixed at default values.
You can work around it by leaving your variable labels blank to begin with, and then adding them on later with customized placement, rotation, and styling, using a modification of the relevant part of the print.ggpairs code. I came up with the following modification. (Incidentally, because the original GGally source code was released under a GPL-3 license, so is this modification.)
customize.labels <- function(
plotObj,
varLabels = NULL, #vector of variable labels
titleLabel = NULL, #string for title
leftWidthProportion = 0.2, #if you changed these from default...
bottomHeightProportion = 0.1, #when calling print(plotObj),...
spacingProportion = 0.03, #then change them the same way here so labels will line up with plot matrix.
left.opts = NULL, #see pattern in left.opts.default
bottom.opts = NULL, #see pattern in bottom.opts.default
title.opts = NULL) { #see pattern in title.opts.default
require('grid')
vplayout <- function(x, y) {
viewport(layout.pos.row = x, layout.pos.col = y)
}
numCol <- length(plotObj$columns)
if (is.null(varLabels)) {
varLabels <- colnames(plotObj$data)
#default to using the column names of the data
} else if (length(varLabels) != numCol){
stop('Length of varLabels must be equal to the number of columns')
}
#set defaults for left margin label style
left.opts.default <- list(x=0,
y=0.5,
rot=90,
just=c('centre', 'centre'), #first gives horizontal justification, second gives vertical
gp=list(fontsize=get.gpar('fontsize')))
#set defaults for bottom margin label style
bottom.opts.default <- list(x=0,
y=0.5,
rot=0,
just=c('centre', 'centre'),#first gives horizontal justification, second gives vertical
gp=list(fontsize=get.gpar('fontsize')))
#set defaults for title text style
title.opts.default <- list(x = 0.5,
y = 1,
just = c(.5,1),
gp=list(fontsize=15))
#if opts not provided, go with defaults
if (is.null(left.opts)) {
left.opts <- left.opts.default
} else{
not.given <- names(left.opts.default)[!names(left.opts.default) %in%
names(left.opts)]
if (length(not.given)>0){
left.opts[not.given] <- left.opts.default[not.given]
}
}
if (is.null(bottom.opts)) {
bottom.opts <- bottom.opts.default
} else{
not.given <- names(bottom.opts.default)[!names(bottom.opts.default) %in%
names(bottom.opts)]
if (length(not.given)>0){
bottom.opts[not.given] <- bottom.opts.default[not.given]
}
}
if (is.null(title.opts)) {
title.opts <- title.opts.default
} else{
not.given <- names(title.opts.default)[!names(title.opts.default) %in%
names(title.opts)]
if (length(not.given)>0){
title.opts[not.given] <- title.opts.default[not.given]
}
}
showLabels <- TRUE
viewPortWidths <- c(leftWidthProportion,
1,
rep(c(spacingProportion,1),
numCol - 1))
viewPortHeights <- c(rep(c(1,
spacingProportion),
numCol - 1),
1,
bottomHeightProportion)
viewPortCount <- length(viewPortWidths)
if(!is.null(titleLabel)){
pushViewport(viewport(height = unit(1,"npc") - unit(.4,"lines")))
do.call('grid.text', c(title.opts[names(title.opts)!='gp'],
list(label=titleLabel,
gp=do.call('gpar',
title.opts[['gp']]))))
popViewport()
}
# viewport for Left Names
pushViewport(viewport(width=unit(1, "npc") - unit(2,"lines"),
height=unit(1, "npc") - unit(3, "lines")))
## new for axis spacingProportion
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights
)))
# Left Side
for(i in 1:numCol){
do.call('grid.text',
c(left.opts[names(left.opts)!='gp'],
list(label=varLabels[i],
vp = vplayout(as.numeric(i) * 2 - 1 ,1),
gp=do.call('gpar',
left.opts[['gp']]))))
}
popViewport()# layout
popViewport()# spacing
# viewport for Bottom Names
pushViewport(viewport(width=unit(1, "npc") - unit(3,"lines"),
height=unit(1, "npc") - unit(2, "lines")))
## new for axis spacing
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights)))
# Bottom Side
for(i in 1:numCol){
do.call('grid.text',
c(bottom.opts[names(bottom.opts)!='gp'],
list(label=varLabels[i],
vp = vplayout(2*numCol, 2*i),
gp=do.call('gpar',
bottom.opts[['gp']]))))
}
popViewport() #layout
popViewport() #spacing
}
And here's an example of calling that function:
require('data.table')
require('GGally')
require('grid')
fake.data <- data.table(test.1=rnorm(50), #make some fake data for demonstration
test.2=rnorm(50),
test.3=rnorm(50),
test.4=rnorm(50))
g <- ggpairs(data=fake.data,
columnLabels=rep('', ncol(fake.data)))
#Set columnLabels to a vector of blank column labels
#so that original variable labels will be blank.
print(g)
customize.labels(plotObj=g,
titleLabel = 'Test plot', #string for title
left.opts = list(x=-0.5, #moves farther to the left, away from vertical axis
y=0.5, #centered with respect to vertical axis
just=c('center', 'center'),
rot=90,
gp=list(col='red',
fontface='italic',
fontsize=12)),
bottom.opts = list(x=0.5,
y=0,
rot=45, #angle the text at 45 degrees
just=c('center', 'top'),
gp=list(col='red',
fontface='bold',
fontsize=10)),
title.opts = list(gp=list(col='green',
fontface='bold.italic'))
)
(This makes some very ugly labels -- for the purposes of demonstration only!)
I didn't tinker with placing the labels somewhere other than the left and bottom -- as in your Geovisualist example -- but I think you'd do it by changing the arguments to vplayout in the "Left Side" and "Bottom Side" pieces of code in customize.labels. The x and y coordinates in grid.text are defined relative to a viewport, which divides the display area into a grid in
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights
)))
The call to vplayout specifies which cell of the grid is being used to position each label.
Caveat: not a complete answer but perhaps suggests a way to approach it. You can do this by editing the grid objects.
# Plot in current window
# use left to add space at y axis and bottom for below xaxis
# see ?print.ggpairs
print(pairs.chrt, left = 1, bottom = 1)
# Get list of grobs in current window and extract the axis labels
# note if you add a title this will add another text grob,
# so you will need to tweak this so not to extract it
g <- grid.ls(print=FALSE)
idx <- g$name[grep("text", g$name)]
# Rotate yaxis labels
# change the rot value to the angle you want
for(i in idx[1:6]) {
grid.edit(gPath(i), rot=0, hjust=0.25, gp = gpar(col="red"))
}
# Remove extra ones if you want
n <- ncol(airquality)
lapply(idx[c(1, 2*n)], grid.remove)
My answer won't fix the diagonal label issue but it will fix the overlay one.
I had this issue with the report I am currently writing, where the axis titles were always over the axes, especially in ggpairs. I used a combination of adjusting the out.height/out.width in conjunction with fig.height/fig.width. Separately the problem was not fixed, but together it was. fig.height/fig.width took the labels away from the axis but made them too small to read, and out.height/out.width just made the plot bigger with the problem unchanged. The below gave me the results shown:
out.height="400px", out.width="400px",fig.height=10,fig.width=10
before:plot with issues
after:
At first I thought this would be trivial, but I could not figure out how to combine rectangles with lines in the legend of a lattice plot. Consider the following example:
library(latticeExtra)
xyplot(rnorm(10) ~ 1:10,
key=list(rectangles=list(size=2, border=F),
text=list(c("Zero", "One", "Two"), col="black"),
col=c("black", "lightgrey", "darkgrey"), divide=1, columns=1,
x=0.01, y=0.95, corner=c(0,1) ),
panel=function(x,...){
panel.abline(v=3, lty="dashed")
panel.xblocks(x,x>5, col="lightgrey")
panel.xblocks(x,x>7, col="darkgrey")
panel.xyplot(x, ...) } )
Instead of 3 rectangles, I would like to have 2 rectangles filled with the appropriate colours, and one dashed line above or below these two rectangles. If I provide a lines argument, then both lines and rectangles will be drawn for all elements (i.e. there will be 2 rectangles and 2 lines simultaneously next to each other).
How can I set up the legend key so that I get this mix of "symbols"? That is, how can I get one dashed line and two rectangles with the appropriate text and colours?
Any help is greatly appreciated! My apologies if this is trival. Please help me see the obvious! :)
This is a rather late answer but it is something I still do. One approach is to use auto.key in the function and then modify the lattice object with update(obj, key = newKey). A more general approach, as suggested by #josh-obrien, is to use the grid functions that under lattice. However, this typically requires empirical tweaking of the coordinates as can be seen in the need to use 3 decimal places of precision to place the dashed lines.
# relative position may be sensitive to absolute sizes
library(latticeExtra)
dev.new(width = 5, height = 5)
set.seed(1234)
# same code as in question, re-written a little bit
# using "transparent" for the 1st of the three rectangles
# using a grid call in the panel function to place the dashed line
xyplot(rnorm(10) ~ 1:10,
key = list(rectangles = list(size = 2, border = FALSE,
col = c("transparent", "lightgrey", "darkgrey")),
text = list(c("Zero", "One", "Two"), col = "black"),
columns = 1, corner = c(0.01, 0.95)),
panel = function(x,...) {
panel.abline(v = 3, lty = "dashed")
panel.xblocks(x, x > 5, col = "lightgrey")
panel.xblocks(x, x > 7, col = "darkgrey")
panel.xyplot(x, ...)
grid::grid.lines(c(0.04, 0.07), c(0.935, 0.935),
gp = gpar(lty = "dashed", col = "black"))
}
)
[![plot with combined elements in legend][1]][1]
[1]: https://i.stack.imgur.com/K7AJN.png