When using latticeExtra:::c.trellis to combine plots, the right-side tick marks and text/numeric labels go missing, and I'd like to bring them back:
library(latticeExtra)
set.seed(1)
foo <- data.frame(x = 1:100,
y = 1:100 + rnorm(100))
foo$resid <- with(foo, x-y)
## Plot 1 -----
(p1 <- xyplot(y~x, foo))
## Plot 2 -----
(p2 <-
xyplot(resid~x, foo,
scales = list(rot = 0, tck = c(1,1), alternating = 3),
between = list(y = 1), ylab.right = "ylab.right",
# par.settings = list(axis.components =
# list(right = list(pad1 = 2, pad2 = 2)))
# Note: this padding attempt does not restore the missing ticks,
# pad arguments get ignored when using c.trellis below
))
# tick marks appear on all four sides (as desired)
## Combine -----
(p12 <- latticeExtra:::c.trellis(p2, p1,layout = c(1,2)))
# right tick marks are missing
Is there a way to restore the right-side ticks and/or labels manually, say, by modifying the combined trellis object?
From the help file ?c.trellis:
Description
Combine the panels of multiple trellis objects into one.
and later,
Note that combining panels from different types of plots does not really fit the trellis model. Some features of the plot may not work as expected. In particular, some work may be needed to show or hide scales on selected panels. An example is given below.
It looks to me that you really aren't trying to combine panels into one object. You even use between to put some separation. Rather, you are trying to combine two plots.
You can use print,
print(p1,split=c(1,1,1,2),more=TRUE)
print(p2,split=c(1,2,1,2),more=FALSE)
See ?print.trellis.
Related
I am using the cutpointr package to generate cut off for a continuous variable. I work as prescribed but the plot objects generated are complex and a result of large gtable data. I want to format or edit the legend in the plot but I have failed totally with ggplot2
This is the code with cutpointr used to generate the cut off:
opt_cut_b_cycle.type<- cutpointr(hcgdf_v2, beta.hcg, livebirth.factor, cycle.type,
method = maximize_boot_metric,
metric = youden, boot_runs = 1000,
boot_stratify = TRUE,
na.rm = TRUE) %>% add_metric(list(ppv, npv, odds_ratio, risk_ratio, p_chisquared))
The plot object is obtained by running 'plot' function
plot(opt_cut_b_cycle.type)
This is the plot generated
.
I want to edit the legend title from subgroup to Oocyte source
I want to change the labels EDET to Donor, IVFET to Autologous
I tried working treating the plot object as a ggplot2 plot and running code such as, where p is the said plot object.
p + scale_fill_discrete(name = "Oocyte source", labels = c("Donor", "Autologous"))
Unfortunately, the console returns 'NULL'
This is an example data set:
hcgdf_v2 <-tibble(id = 1:10, beta.hcg = seq(from = 5, to = 1500, length.out = 10),
livebirth.factor = c("yes", "no", "yes", "no", "no", "yes", "yes", "no", "no", "yes"),
cycle.type = c("edet","ivfet","edet", "edet", "edet", "edet", "ivfet", "ivfet", "ivfet","edet"))
When I attempted to use your code, it didn't work. However, based on the current type of graph and graph options you've called, this should work.
The legend title
I suggest you run this line and ensure it returns Subgroup before using it to change anything.
# assign the plot to an object
plt <- plot(opt_cut_b_cycle.type)
# printing this should return "Subgroup" - current legend title
plt$grobs[[2]]$grobs[[1]]$grobs[[2]][[4]][[1]][[6]][[1]][[1]]
# change the legend title
plt$grobs[[2]]$grobs[[1]]$grobs[[2]][[4]][[1]][[6]][[1]][[1]] <- "Oocyte"
Legend entries
The easiest method to change the legend entries is probably to rename the factors in your data. Alternatively, you can change these labels the same way you changed the legend title.
Note that the colors will swap between the two options when you change the factor levels. (That's because it is alphabetized.)
#### Option 1 - - Recommended method
# change the legend entries-- factor levels
# in your image, you have "EDET", but your data has "edet"
# make sure this has the capitalization used in your data
hcgdf_v2$cycle2 <- ifelse(hcgdf_v2$cycletype == "edet", "Donor", "Autologous")
# now rerun plot with alternate subgroup
opt_cut_b_cycle.type<- cutpointr(hcgdf_v2, beta.hcg, livebirth.factor, cycle2,
method = maximize_boot_metric,
metric = youden, boot_runs = 1000,
boot_stratify = TRUE,
na.rm = TRUE) %>%
add_metric(list(ppv, npv, odds_ratio, risk_ratio, p_chisquared))
#### Option 2 - - Not recommended due to legend spacing
# alternative to rename legend entry labels
# this should return "EDET"
plt$grobs[[2]]$grobs[[1]]$grobs[[7]][[4]][[1]][[6]][[1]][[1]]
# this should return "IVFET"
plt$grobs[[2]]$grobs[[1]]$grobs[[8]][[4]][[1]][[6]][[1]][[1]]
plt$grobs[[2]]$grobs[[1]]$grobs[[7]][[4]][[1]][[6]][[1]][[1]] <- "Donor"
plt$grobs[[2]]$grobs[[1]]$grobs[[8]][[4]][[1]][[6]][[1]][[1]] <- "Autologous"
To see your modified plot, use plot.
plot(plt)
When I ran it this code, changing the legend title causes some odd behavior where the plot background isn't entirely white, if that happens in your plot do the following.
This requires the library gridExtra.
# clear the plot
plot.new()
# recreate the grid
plt2 <- grid.arrange(plt$grobs[[1]]$grobs[[1]], # 2 small graphs top left
plt$grobs[[1]]$grobs[[2]], # ROC curve graph (top right)
plt$grobs[[1]]$grobs[[3]], # distro of optimal cut
plt$grobs[[1]]$grobs[[4]], nrow = 2) # out-of-bag estimates
plot.new()
# graphs and legend set to 4:1 ratio of space graphs to legend
grid.arrange(plt2, plt$grobs[[2]], ncol = 2, widths = c(4, 1))
```
I am trying to create hexbins where the x-axis is a date using the hexbin function in the hexbin package in R. When I feed in my data, it seems to convert the dates into a numeric, which gets displayed on the x-axis. I want it force the x-axis to be a date.
#Create Hex Bins
hbin <- hexbin(xData$Date, xData$YAxis, xbins = 80)
#Plot using rBokeh
figure() %>%
ly_hexbin(hbin)
This gives me:
Here's a brute force approach using the underlying grid plotting package. The axes are ugly; maybe someone with better grid skills than I could pretty them up.
# make some data
x = seq.Date(as.Date("2015-01-01"),as.Date("2015-12-31"),by='days')
y = sample(x)
# make the plot and capture the plot
p <- plot(hexbin(x,y),yaxt='n',xaxt='n')
# calculate the ticks
x_ticks_date <-
x_ticks <- axTicks(1, log = FALSE, usr = as.numeric(range(x)),
axp=c(as.numeric(range(x)) ,5))
class(x_ticks_date) <- 'Date'
y_ticks_date <-
y_ticks <- axTicks(1, log = FALSE, usr = as.numeric(range(y)),
axp=c(as.numeric(range(y)) ,5))
class(y_ticks_date) <- 'Date'
# push the ticks to the view port.
pushViewport(p$plot.vp#hexVp.off)
grid.xaxis(at=x_ticks, label = format(y_ticks_date))
grid.yaxis(at=y_ticks, label = format(y_ticks_date))
I would like to save multiple plots (with ggplot2) to a list during a large for-loop. And then subsequently display the images in a grid (with grid.arrange)
I have tried two solutions to this:
1 storing it in a list, like so:
pltlist[["qplot"]] <- qplot
however for some reason this does save the plot correctly.
So I resorted to a second strategy which is recordPlot()
This was able to save the plot correctly, but unable to
use it in a grid.
Reproducable Example:
require(ggplot2);require(grid);require(gridExtra)
df <- data.frame(x = rnorm(100),y = rnorm(100))
histoplot <- ggplot(df, aes(x=x)) + geom_histogram(aes(y=..density..),binwidth=.1,colour="black", fill="white")
qplot <- qplot(sample = df$y, stat="qq")
pltlist <- list()
pltlist[["qplot"]] <- qplot
pltlist[["histoplot"]] <- histoplot
grid.arrange(pltlist[["qplot"]],pltlist[["histoplot"]], ncol=2)
above code works but produces the wrong graph
in my actual code
Then I tried recordPlot()
print(histoplot)
c1 <- recordPlot()
print(qplot)
c2 <- recordPlot()
I am able to display all the plots individually
but grid.arrange produces an error:
grid.arrange(replayPlot(c1),replayPlot(c2), ncol=2) # = Error
Error in gList(list(wrapvp = list(x = 0.5, y = 0.5, width = 1, height = 1, :
only 'grobs' allowed in "gList"
In this thread Saving grid.arrange() plot to file
They dicuss a solution which utilizes arrangeGrob() instead
arrangeGrob(c1, c1, ncol=2) # Error
Error in vapply(x$grobs, as.character, character(1)) :
values must be length 1,
but FUN(X[[1]]) result is length 3
I am forced to use the recordPlot() instead of saving to a list since this does not produce the same graph when saved as when it is plotted immediately, which I unfortunately cannot replicate, sorry.
In my actual code I am doing a large for-loop, looping through several variables, making a correlation with each and making scatterplots, where I name the scatterplots dependent on their significans level. I then want to re-display the plots that were significant in a grid, in a dynamic knitr report.
I am aware that I could just re-plot the plots that were significant after the for-loop instead of saving them, (I can't save as png while doing knitr either). However I would like to find a way to dynammically save the plots as R-objects and then replot them in a grid afterwards.
Thanks for Reading
"R version 3.2.1"
Windows 7 64bit - RStudio - Version 0.99.652
attached base packages:
[1] grid grDevices datasets utils graphics stats methods base
other attached packages:
[1] gridExtra_2.0.0 ggplot2_1.0.1
I can think of two solutions.
1. If your goal is to just save the list of plots as R objects, I recommend:
saveRDS(object = pltlist, file = "file_path")
This way when you wish to reload in these graphs, you can just use readRDS(). You can then put them in cowplot or gridarrange. This command works for all lists and R Objects.
One caveat to this approach is if settings/labeling for ggplot2 is dependent upon things in the environment (not the data, but stuff like settings for point size, shape, or coloring) instead of the ggplot2 function used to make the graph), your graphs won't work until you restore your dependencies. One reason to save some dependencies is to modularize your scripts to make the graphs.
Another caveat is performance: From my experience, I found it is actually faster to read in the data and remake individual graphs than load in an RDS file of all the graphs when you have a large number of graphs (100+ graphs).
2. If your goal is to save an 'image' or 'picture' of each graph (single and/or multiplot as .png, .jpeg, etc.), and later adjust things in a grid manually outside of R such as powerpoint or photoshop, I recommend:
filenames <- c("Filename_1", "Filename_2") #actual file names you want...
lapply(seq_along(pltlist), function(i) {
ggsave(filename = filenames[i], plot = pltlist[[i]], ...) #use your settings here
})
Settings I like for single plots:
lapply(seq_along(pltlist), function(i) ggsave(
plot = pltlist[[i]],
filename = paste0("plot_", i, "_", ".tiff"), #you can even paste in pltlist[[i]]$labels$title
device = "tiff", width=180, height=180, units="mm", dpi=300, compression = "lzw", #compression for tiff
path = paste0("../Blabla") #must be an existing directory.
))
You may want to do the manual approach if you're really OCD about the grid arrangement and you don't have too many of them to make for publications. Otherwise, when you do grid.arrange you'll want to do all the specifications there (adjusting font, increasing axis label size, custom colors, etc.), then adjust the width and height accordingly.
Reviving this post to add multiplot here, as it fits exactly.
require(ggplot2)
mydd <- setNames( data.frame( matrix( rep(c("x","y","z"), each=10) ),
c(rnorm(10), rnorm(10), rnorm(10)) ), c("points", "data") )
# points data
# 1 x 0.733013658
# 2 x 0.218838717
# 3 x -0.008303382
# 4 x 2.225820069
# ...
p1 <- ggplot( mydd[mydd$point == "x",] ) + geom_line( aes( 1:10, data, col=points ) )
p2 <- ggplot( mydd[mydd$point == "y",] ) + geom_line( aes( 1:10, data, col=points ) )
p3 <- ggplot( mydd[mydd$point == "z",] ) + geom_line( aes( 1:10, data, col=points ) )
multiplot(p1,p2,p3, cols=1)
multiplot:
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
library(grid)
# Make a list from the ... arguments and plotlist
plots <- c(list(...), plotlist)
numPlots = length(plots)
# If layout is NULL, then use 'cols' to determine layout
if (is.null(layout)) {
# Make the panel
# ncol: Number of columns of plots
# nrow: Number of rows needed, calculated from # of cols
layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
ncol = cols, nrow = ceiling(numPlots/cols))
}
if (numPlots==1) {
print(plots[[1]])
} else {
# Set up the page
grid.newpage()
pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
# Make each plot, in the correct location
for (i in 1:numPlots) {
# Get the i,j matrix positions of the regions that contain this subplot
matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
layout.pos.col = matchidx$col))
}
}
}
Result:
I am trying to plot a Rgraphviz object with two edge labels. Unfortunately the labels fall outside the plot. Here is my example:
require('Rgraphviz')
set.seed(123)
g1 <- randomGraph(letters[1:10], 1:4, 0.4)
eAttrs <- list()
eAttrs$label <- c("a~g" = "I have a very long label 1", "a~i" = "and a long label 2")
plot(g1, edgeAttrs = eAttrs)
Here is my plot:
I tried several things with no success:
1.
Set a larger bounding box
z <- agopen(g1, "foo")
z#boundBox#upRight#x <- z#boundBox#upRight#x + 300
z#boundBox#upRight#y <- z#boundBox#upRight#y + 300
plot(z, edgeAttrs = eAttrs)
2.
Decrease the label fontsize (not really what I want in my application, anyways)
eAttrs$labelfontsize=c("a~g"="3")
plot(g1, edgeAttrs = eAttrs)
3.
Change par attributes:
par(oma=c(10,10,10,10))
plot(g1, edgeAttrs = eAttrs)
4.
Change node, edge and general attributes from ?Rgraphviz::GraphvizAttributes
attrs <- list(graph=list(size=c(1, 1)))
attrs$edge$fontsize<-8
plot(g1, edgeAttrs = eAttrs, attrs=attrs)
None of my attempts seem to work. Does anyone have an idea?
The problem
Calling plot() on a graph object dispatches an S4 method (shown by getMethod("plot", "graph")), which in turn calls the function shown by typing getMethod("plot", "Ragraph"). That function contains the following rather unfortunate lines which, regardless of any related parameter settings you've made, will override them to reset the left and right margins to 0. Frustrating!
oldpars <- par(mai = c(sheight, 0, mheight, 0))
on.exit(par(oldpars), add = TRUE)
A workaround
One workaround is to construct a three panel layout in which the left and right panels are just there to provide a bit of buffering space. Turn off clipping, plot your graph object in the middle panel, and it then seems to work:
layout(matrix(1:3, nrow=1), widths=c(1,5,1))
par(xpd=NA) ## turn off all clipping
plot.new() ## blank plot in Panel 1
plot(g1, edgeAttrs = eAttrs) ## graph in Panel 2
plot.new() ## blank plot in Panel 3
I found another solution: In my original question I changed the size of the bounding box in a laid out graph I got with agopen. Plotting the laid out graph showed no edge labels at all. I found that it is possible to pass the edge attributes from the graph object to agopen and then change the bounding box:
require('Rgraphviz')
set.seed(123)
g1 <- randomGraph(letters[1:10], 1:4, 0.4)
eAttrs <- list()
eAttrs$label <- c("a~g" = "I have a very long label 1", "a~i" = "and a long label 2")
z <- agopen(g1, "foo", edgeAttr=eAttrs)
z#boundBox#botLeft#x <- z#boundBox#botLeft#x - 400 ##left
z#boundBox#upRight#x <- z#boundBox#upRight#x + 200 ##right
plot(z)
The plot:
I have a multiple variable time series were some of the variables have rather large ranges. I wish to make a single-page plot with multiple stacked plots of each variable were some of the variables have a log10 y-axis scaling. I am relatively new to lattice and have not been able to figure out how to effectively mix the log10 scaling with non-transformed axes and get a publication quality plot. If print.trellis is used the plots are not aligned and the padding needs some work, if c.trellis is used the layout is good, but only the y-scaling from only one plot is used. Any suggestions for an efficient solution, where I can replicate the output of c.trellis using the different y-scaling for each (original) object?
Example below:
require(lattice)
require(latticeExtra)
# make data.frame
d.date <- as.POSIXct(c("2009-12-15", "2010-01-15", "2010-02-15", "2010-03-15", "2010-04-15"))
CO2dat <- c(100,200,1000,9000,2000)
pHdat <- c(10,9,7,6,7)
tmp <- data.frame(date=d.date ,CO2dat=CO2dat ,pHdat=pHdat)
# make plots
plot1 <- xyplot(pHdat ~ date, data=tmp
, ylim=c(5,11)
, ylab="pHdat"
, xlab="Date"
, origin = 0, border = 0
, scales=list(y=list(alternating=1))
, panel = function(...){
panel.xyarea(...)
panel.xyplot(...)
}
)
# make plot with log y scale
plot2 <- xyplot(CO2dat ~ date, data=tmp
, ylim=c(10,10^4)
, ylab="CO2dat"
, xlab="Date"
, origin = 0, border = 0
, scales=list(y=list(alternating=1,log=10))
, yscale.components = yscale.components.log10ticks
, panel = function(...){
panel.xyarea(...)
panel.xyplot(...)
# plot CO2air uatm
panel.abline(h=log10(390),col="blue",type="l",...)
}
)
# plot individual figures using split
print(plot2, split=c(1,1,1,2), more=TRUE)
print(plot1, split=c(1,2,1,2), more=F)
# combine plots (more convenient)
comb <- c(plot1, plot2, x.same=F, y.same=F, layout = c(1, 2))
# plot combined figure
update(comb, ylab = c("pHdat","log10 CO2dat"))
Using #joran's idea, I can get the axes to be closer but not exact; also, reducing padding gets them closer together but changes the aspect ratio. In the picture below I've reduced the padding perhaps by too much to show the not exactness; if this close were desired, you'd clearly want to remove the x-axis labels on the top as well.
I looked into the code that sets up the layout and the margin on the left side is calculated from the width of the labels, so #joran's idea is probably the only thing that will work based on the printing using split, unless one were to rewrite the plot.trellis command. Perhaps the c method could work but I haven't found a way yet to set the scale components separately depending on the panel. That does seem more promising though.
mtheme <- standard.theme("pdf")
mtheme$layout.heights$bottom.padding <- -10
plot1b <- update(plot1, scales=list(y=list(alternating=1, at=5:10, labels=paste(" ",c(5:10)))))
plot2b <- update(plot2, par.settings=mtheme)
pdf(file="temp.pdf")
print(plot2b, split=c(1,1,1,2), more=TRUE)
print(plot1b, split=c(1,2,1,2), more=F)