Following this example, I would like to add a title to the plot. I use the package neuralnet in R and when the neural network is trained, I want to display in a plot.
library(neuralnet)
data(infert, package="datasets")
net.infert <- neuralnet(case~parity+induced+spontaneous, infert,
err.fct="ce", linear.output=FALSE, likelihood=TRUE)
plot(net.infert, rep="best")
In order to include a title I used the arguments main and title with no result.
plot(net.infert, rep="best", title = "Incisors")
plot(net.infert, rep="best", main= "Incisors")
Any idea?
Looking at its plot.nn method, this neuralnet plot is underpinned by the grid package. You could use grid::grid.text to place an annotation to serve as a title, kinda like this:
plot(net.infert, rep="best")
grid::grid.text("My title", x=0.15, y=0.95,
gp=gpar(fontsize=20, col = "darkred"), check=TRUE)
extending #xilliam 's solution to position the title above the plot panel:
library(grid)
library(gridExtra)
plot(net.infert, rep="best")
## grab the current output:
plot_panel <- grid.grab(wrap = TRUE)
## create a title grob:
plot_title <- textGrob("A title, a kingdom for a title!",
x = .5, y = .1, ## between 0 and 1, from bottom left
gp = gpar(lineheight = 2, ## see ?gpar
fontsize = 18, col = 'red',
adj = c(1, 0)
)
)
##stack title and main panel, and plot:
grid.arrange(
grobs = list(plot_title,
plot_panel),
heights = unit(c(.15, .85), units = "npc"), ## between 0 and 1
width = unit(1, "npc")
)
Related
I am trying to arrange two ggplot2 plots side by side, i.e., in a two-column
layout using the package gridExtra. I am interested in ensuring that both
plots have equal plotting area (i.e., the gray plot panel is the same for both
plots) regardless of the height of the x-axis labels. As you can see in the
example below, when longer x-axis labels are used, gridExtra::grid.arrange()
seems to compensate this by adjusting the plotting area (i.e., the grayed out
part of the plot).
# Dummy data.
data <- data.frame(x = 1:10, y = rnorm(10))
# Dummy labels.
x_labels_short <- 1:10
x_labels_long <- 100001:100010
# Common settings for both `ggplot2` plots.
layers <- list(
labs(
x = "Plot title"
),
theme(
axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1
)
)
)
# `ggplot2 plot (a).
plot_a <- ggplot(data, aes(x, y)) +
scale_x_continuous(breaks = 1:10, labels = x_labels_short) +
layers
# `ggplo2` plot (b).
plot_b <- ggplot(data, aes(x, y)) +
scale_x_continuous(breaks = 1:10, labels = x_labels_long) +
layers
# Showing the plots side by side.
gridExtra::grid.arrange(
plot_a,
plot_b,
ncol = 2
)
Output:
What I want is for both plots to (1) have equal plotting area and (b) the x-axis
title of plot_a to be aligned with that of plot_b (i.e., the x-axis title of
plot_a to be offset based on the length of of the x-axis labels of plot_b).
If this is not clear, this is what I want to achieve would look like with base
R.
# Wrapper for convenience.
plot_gen <- function(data, labels) {
plot(
NULL,
xlim = c(1, 10),
ylim = c(min(data$y), max(data$y)),
xlab = "",
ylab = "y",
xaxt = "n"
)
axis(
side = 1,
at = 1:10,
labels = labels,
las = 2
)
title(
xlab = "Plot title",
line = 4.5
)
}
# Get `par`.
old_par = par(no.readonly = TRUE)
# Set the two-column layout.
layout(matrix(1:2, ncol = 2))
# Adjust margins.
par(mar = old_par$mar + c(1.5, 0, 0, 0))
# Plot base plot one.
plot_gen(data, x_labels_short)
# Plot base plot two.
plot_gen(data, x_labels_long)
# Restore `par`.
par(old_par)
# Restore layout.
layout(1:1)
Output:
Quick mention. I found a similar question on SO (i.e.,
How to specify the size of a graph in ggplot2 independent of axis labels), however I fail to see how the
answers address the problem. Also, the plots I am trying to arrange are based
on different data and I don't think I can use a facet_wrap approach.
One suggestion: the patchwork package.
library(patchwork)
plot_a + plot_b
It also works for more complex layouts, e.g.:
(plot_a | plot_b) / plot_a
is there an comfortable way to set the legend/key label inside the rectanlge in latice plots: (although overplot/overlayer lines, points, rectangles in keys would be nice)
library(lattice)
barchart(yield ~ variety | site, data = barley,
groups = year, layout = c(1,6), stack = TRUE,
auto.key = list(space = "right"),
ylab = "Barley Yield (bushels/acre)",
scales = list(x = list(rot = 45)))
Well, there's no really automatic way, but it can be done. Here are a couple of options I came up with. Both construct a legend 'grob' and pass it in via the barchart()'s legend= argument. The first solution uses the nifty gtable package to construct a table grob. The second is a bit more programmatic, and uses grid's own frameGrob() and packGrob() functions to construct a similar legend.
Option 1: Construct legend using gtable()
library(lattice)
library(grid)
library(gtable)
## Extract group labels and their colors for use in gtable
ll <- levels(barley[["year"]])
cc <- trellis.par.get("superpose.polygon")[["col"]][seq_along(ll)]
## Prepare a grob for passing in to legend.
## Set up a two cell gtable , and 'paint' then annotate both cells
## (Note: this could be further "vectorized", as, e.g., at
## http://stackoverflow.com/a/18033613/980833)
gt <- gtable(widths = unit(1.5,"cm"), heights = unit(rep(.7,2), "cm"))
gt <- gtable_add_grob(gt, rectGrob(gp=gpar(fill=cc[1])), 1, 1, name=1)
gt <- gtable_add_grob(gt, textGrob(ll[1]), 1, 1, name=2)
gt <- gtable_add_grob(gt, rectGrob(gp=gpar(fill=cc[2])), 2, 1, name=1)
gt <- gtable_add_grob(gt, textGrob(ll[2]), 2, 1, name=2)
## Plot barchart with legend
barchart(yield ~ variety | site, data = barley,
groups = year, layout = c(1,6), stack = TRUE,
legend = list(right=list(fun=gt)),
ylab = "Barley Yield (bushels/acre)",
scales = list(x = list(rot = 45)))
Option 2: Construct legend by packing a frameGrob()
library(lattice)
library(grid)
## A function for making grobs with text on a colored background
labeledRect <- function(text, color) {
rg <- rectGrob(gp=gpar(fill=color))
tg <- textGrob(text)
gTree(children=gList(rg, tg), cl="boxedTextGrob")
}
## A function for constructing a legend consisting of several
## labeled rectangles
legendGrob <- function(labels, colors) {
gf <- frameGrob()
border <- unit(c(0,0.5,0,0.5), "cm")
for (i in seq_along(labels)) {
gf <- packGrob(gf, labeledRect(labels[i], colors[i]),
width = 1.1*stringWidth(labels[i]),
height = 1.5*stringHeight(labels[i]),
col = 1, row = i, border = border)
}
gf
}
## Use legendGrob() to prepare the legend
ll <- levels(barley[["year"]])
cc <- trellis.par.get("superpose.polygon")[["col"]][seq_along(ll)]
gf <- legendGrob(labels=ll, colors=cc)
## Put it all together
barchart(yield ~ variety | site, data = barley,
groups = year, layout = c(1,6), stack = TRUE,
legend = list(right=list(fun=gf)),
ylab = "Barley Yield (bushels/acre)",
scales = list(x = list(rot = 45)))
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 am producing four plots using xyplot (lattice) and further combine them with grid.arrange (gridExtra).
I would like to obtain a graph with a common global legend. The closest that I have reached is the following. They have to be in a matrix layout, otherwise an option would be to put them in a column and include only a legend for the top or bottom one.
# Load packages
require(lattice)
require(gridExtra)
# Generate some values
x1<-rnorm(100,10,4)
x2<-rnorm(100,10,4)
x3<-rnorm(100,10,4)
x4<-rnorm(100,10,4)
y<-rnorm(100,10,1)
cond<-rbinom(100,1,0.5)
groups<-sample(c(0:10),100,replace=TRUE)
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups)
# ploting function
plott<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups))),
key = list(space="top",
text = list(as.character(levels(as.factor(groups)))),
points = TRUE, lines = TRUE, columns = 3,
pch = 1:length(levels(as.factor(groups))),
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
cex=1))
}
plot1<-plott(x=x1)
plot2<-plott(x=x2)
plot3<-plott(x=x3)
plot4<-plott(x=x4)
grid.arrange(plot1,plot2,plot2,plot4,ncol=2)
In a similar post, I have seen that it can be performed with the use of ggplot2 e.g. here and here but is there a way to include a global common legend using gridExtra and a lattice based plot e.g. xyplot?
Thank you.
One possible solution is to use ggplot, hinted here.
my.cols <- 1:3
my.grid.layout <- rbind(c(1,2),
c(3,3))
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)
}
legend.plot <- ggplot(iris, aes(x=Petal.Length, y=Sepal.Width,colour=Species)) +
geom_line(size=1) + # legend should show lines, not points or rects ...
theme(legend.position="right", legend.background = element_rect(colour = "black"),
legend.key = element_rect(fill = "white")) + # position, box and background colour of legend
scale_color_manual(values=my.cols, name = "Categories") + # manually insert colours as used in corresponding xyplot
guides(colour = guide_legend(reverse=T)) # inverts order of colours in legend
mylegend <- g_legend(legend.plot)
plot1 <- xyplot(Sepal.Width ~ Petal.Length, groups = Species, data = iris, type = 'l',
par.settings = simpleTheme(col=my.cols))
plot2 <- xyplot(Sepal.Length ~ Petal.Length, groups = Species, data = iris, type = 'l',
par.settings = simpleTheme(col=my.cols))
grid.arrange(plot1,plot2,mylegend,layout_matrix=my.grid.layout,
top=textGrob(gp=gpar(col='black',fontsize=20),"Some useless example"))
I managed to produce something more close to what I first imagined. For that I am including an extra graphical element and I am using the layout_matrix option in grid.arrange to minimize its effect. That way I am keeping the legend and almost exclude the plot.
# Load packages
require(lattice)
require(gridExtra)
# Generate some values
x1<-rnorm(100,10,4)
x2<-rnorm(100,10,4)
x3<-rnorm(100,10,4)
x4<-rnorm(100,10,4)
y<-rnorm(100,10,1)
cond<-rbinom(100,1,0.5)
groups<-sample(c(0:10),100,replace=TRUE)
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups)
# ploting function
plottNolegend<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups)))
)
}
plott<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups))),
key = list(space="top",
text = list(as.character(levels(as.factor(groups)))),
points = TRUE, lines = TRUE, columns = 3,
pch = 1:length(levels(as.factor(groups))),
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
cex=1))
}
plot1<-plottNolegend(x=x1)
plot2<-plottNolegend(x=x2)
plot3<-plottNolegend(x=x3)
plot4<-plottNolegend(x=x4)
legend<-plott(x=x4)
lay <- rbind(c(1,2),
c(1,2),
c(3,4),
c(3,4),
c(5,5))
grid.arrange(plot1,plot2,plot2,plot4,legend, layout_matrix = lay)
Updated: The answer was much simpler than I expected. Thank you all for your help.
# Load packages
require(lattice)
require(gridExtra)
require(grid)
# Generate some values
x1<-rnorm(100,10,4)
x2<-rnorm(100,10,4)
x3<-rnorm(100,10,4)
x4<-rnorm(100,10,4)
y<-rnorm(100,10,1)
cond<-rbinom(100,1,0.5)
groups<-sample(c(0:10),100,replace=TRUE)
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups)
# ploting function
plott<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups))),
key = NULL)
}
plot1<-plott(x=x1)
plot2<-plott(x=x2)
plot3<-plott(x=x3)
plot4<-plott(x=x4)
grid.arrange(plot1,plot2,plot2,plot4,ncol=2)
KeyA<-list(space="top",
text = list(as.character(levels(as.factor(groups)))),
points = TRUE, lines = TRUE, columns = 11,
pch = 1:length(levels(as.factor(groups))),
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
cex=1)
draw.key(KeyA, draw = TRUE, vp =
viewport(.50, .99))
I think the better solution is to use c.trellis from latticeExtra:
library(latticeExtra)
c(plot1, plot2, plot3, plot4)
I have recently started using the grid.table function from the gridExtra package to turn tabular data into png image files for use on the web. I've been delighted with it so far as it produces very good-looking output by default, sort of like a ggplot2 for tables. Like the person who asked this question I would love to see the ability to specify the justification for individual columns but that would be icing on what is an already more-ish cake.
My question is whether it is possible to add text around a grid.table so that I can give plotted tables a title and a footnote. It seems to me this should be feasible, but I don't know enough about grid graphics to be able to work out how to add grobs to the table grob. For example, this code:
require(gridExtra)
mydf <- data.frame(Item = c('Item 1','Item 2','Item 3'),
Value = c(10,15,20), check.names = FALSE)
grid.table(mydf,
gpar.coretext=gpar(fontsize = 16),
gpar.coltext = gpar(fontsize = 16),
gpar.rowtext = gpar(fontsize = 16),
gpar.corefill = gpar(fill = "blue", alpha = 0.5, col = NA),
h.even.alpha = 0.5,
equal.width = FALSE,
show.rownames = FALSE,
show.vlines = TRUE,
padding.h = unit(15, "mm"),
padding.v = unit(8, "mm")
)
generates this plot:
when I would really like to be able to do something like the following in code rather than by editing the image with another application:
To place text close to the table you'll want to evaluate the table size first,
library(gridExtra)
d <- head(iris)
table <- tableGrob(d)
grid.newpage()
h <- grobHeight(table)
w <- grobWidth(table)
title <- textGrob("Title", y=unit(0.5,"npc") + 0.5*h,
vjust=0, gp=gpar(fontsize=20))
footnote <- textGrob("footnote",
x=unit(0.5,"npc") - 0.5*w,
y=unit(0.5,"npc") - 0.5*h,
vjust=1, hjust=0,gp=gpar( fontface="italic"))
gt <- gTree(children=gList(table, title, footnote))
grid.draw(gt)
Edit (17/07/2015) With gridExtra >=2.0.0, this approach is no longer suitable. tableGrob now returns a gtable, which can be more easily customised.
library(gridExtra)
d <- head(iris)
table <- tableGrob(d)
library(grid)
library(gtable)
title <- textGrob("Title",gp=gpar(fontsize=50))
footnote <- textGrob("footnote", x=0, hjust=0,
gp=gpar( fontface="italic"))
padding <- unit(0.5,"line")
table <- gtable_add_rows(table,
heights = grobHeight(title) + padding,
pos = 0)
table <- gtable_add_rows(table,
heights = grobHeight(footnote)+ padding)
table <- gtable_add_grob(table, list(title, footnote),
t=c(1, nrow(table)), l=c(1,2),
r=ncol(table))
grid.newpage()
grid.draw(table)
If you want just the title (no footnote), here is a simplified version of #baptiste's example:
title <- textGrob("Title", gp = gpar(fontsize = 50))
padding <- unit(0.5,"line")
table <- gtable_add_rows(
table, heights = grobHeight(title) + padding, pos = 0
)
table <- gtable_add_grob(
table, list(title),
t = 1, l = 1, r = ncol(table)
)
grid.newpage()
grid.draw(table)