Lattice: Multiple Plots in One Window

Stack Multiple Lattice Plots

I know this is not a minimum answer, but this is as close to the answer as I can get. I had to separate the data for each male into 3 dataframes to pull this one off. I put this together using answers to this question, answers from other questions, manuals, and my own exploration. I took out the code for axis labels, font, and font size to reduce the code somewhat. I hope this turns out to be useful for someone out there.

library(ggplot2)
library(gtable)
library(grid)
library(gridExtra) 

##Create Plot1 for Male 331
q1<-ggplot(m331,aes(Count,Urban))+geom_line(linetype="dashed",size=1)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.x = element_blank())+theme(axis.title.y = element_blank())+scale_x_continuous(breaks = round(seq(min(m331$Count), max(m331$Count), by = 2),1))+scale_y_continuous(breaks = round(seq(min(m331$Urban), max(m331$Urban), by = 5),0))+theme(plot.margin=unit(c(1,1,0,1), "cm"))
    q2<-ggplot(m331,aes(Count,LowFreq))+geom_line(linetype="solid",size=1)+theme_bw()%+replace%theme(panel.background = element_rect(fill = NA))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.x = element_blank())+scale_y_continuous(breaks = round(seq(min(3400), max(3700), by = 50),0))+theme(plot.margin=unit(c(1,1,0,1), "cm"))
    h1<-ggplot_gtable(ggplot_build(q1))
    h2<-ggplot_gtable(ggplot_build(q2))
    qq<-c(subset(h1$layout,name=="panel",se=t:r))
    h<-gtable_add_grob(h1,h2$grobs[[which(h2$layout$name=="panel")]],qq$t,qq$l,qq$b,qq$l)

    ia <- which(h2$layout$name == "axis-l")
    ga <- h2$grobs[[ia]]
    ax <- ga$children[[2]]
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15,"cm")
    h <- gtable_add_cols(h, h2$widths[h2$layout[ia, ]$l], length(h$widths) - 1)
    h <- gtable_add_grob(h, ax, qq$t, length(h$widths) - 1, qq$b)

    grid.draw(h)


    ##Create Plot2 for Male 126
    p1<-ggplot(m126,aes(Count,Urban))+geom_line(linetype="dashed",size=1)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.x = element_blank())+scale_x_continuous(breaks = round(seq(min(m126$Count), max(m126$Count), by = 2),1))+scale_y_continuous(breaks = round(seq(min(m126$Urban), max(m126$Urban), by = 5),0))+theme(plot.margin=unit(c(0,1,0,1), "cm"))
    p2<-ggplot(m126,aes(Count,LowFreq))+geom_line(linetype="solid",size=1)+theme_bw()%+replace%theme(panel.background = element_rect(fill = NA))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+ theme(axis.title.x = element_blank())+scale_y_continuous(breaks = round(seq(min(3000), max(4200), by = 400),0))+theme(plot.margin=unit(c(0,1,0,1), "cm"))
    g1<-ggplot_gtable(ggplot_build(p1))
    g2<-ggplot_gtable(ggplot_build(p2))
    pp<-c(subset(g1$layout,name=="panel",se=t:r))
    g<-gtable_add_grob(g1,g2$grobs[[which(g2$layout$name=="panel")]],pp$t,pp$l,pp$b,pp$l)

    ia <- which(g2$layout$name == "axis-l")
    ga <- g2$grobs[[ia]]
    ax <- ga$children[[2]]
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15,"cm")
    g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
    g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
    g <- gtable_add_grob(g, g2$grob[[7]], pp$t, length(g$widths), pp$b)

    grid.draw(g)


    ##Create Plot3 for Male 548
    r1<-ggplot(m548,aes(Count,Urban))+geom_line(linetype="dashed",size=1)+theme_bw()+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.y = element_blank())+scale_x_continuous(breaks = round(seq(min(m548$Count), max(m548$Count), by = 2),1))+scale_y_continuous(breaks = round(seq(min(m548$Urban), max(m548$Urban), by = 5),0))+theme(plot.margin=unit(c(0,1,1,1), "cm"))
    r2<-ggplot(m548,aes(Count,LowFreq))+geom_line(linetype="solid",size=1)+theme_bw()%+replace%theme(panel.background = element_rect(fill = NA))+theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+theme(axis.title.y = element_blank())+scale_y_continuous(breaks = round(seq(min(2700), max(3000), by = 100),0))+theme(plot.margin=unit(c(0,1,1,1), "cm"))
    i1<-ggplot_gtable(ggplot_build(r1))
    i2<-ggplot_gtable(ggplot_build(r2))
    rr<-c(subset(i1$layout,name=="panel",se=t:r))
    i<-gtable_add_grob(i1,i2$grobs[[which(i2$layout$name=="panel")]],rr$t,rr$l,rr$b,rr$l)

    ia <- which(i2$layout$name == "axis-l")
    ga <- i2$grobs[[ia]]
    ax <- ga$children[[2]]
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15,"cm")
    i <- gtable_add_cols(i, i2$widths[i2$layout[ia, ]$l], length(i$widths) - 1)
    i <- gtable_add_grob(i, ax, rr$t, length(i$widths) - 1, rr$b)

    grid.draw(i)


    ##Combine Graphs
    grid.arrange(h, g, i, nrow=3)

Multiple lattice plots with gridExtra

I guess it's got something to do with the plot.trellis method not finding the global theme settings when it's wrapped in gridExtra::drawDetails.lattice. I don't understand these lattice options, but as far as I recall you can specify them explicitly at the plot level too,

pl = list(Plot1, Plot2, Plot3, Plot4)
# do.call(grid.arrange, c(pl, nrow=1))
do.call(grid.arrange, c(lapply(pl, update, par.settings=newSet), list(nrow=1)))

Generate multiple lattice plots on a grid using lapply in R

If you really don't want to use the built-in facetting or viewport options of lattice, you can replicate the behavior of par(mfrow) with the following,

require(lattice)

response <- c("cyl","disp","hp","drat")

# save all plots in a list
pl <- lapply(response, function(variable) {
  xyplot(mtcars$mpg ~ mtcars[variable])
})

library(gridExtra)
# arrange them in a 2x2 grid
do.call(grid.arrange, c(pl, nrow=2))

R: Four Lattice barcharts side-by-side in 2x2 Window?

I would do this by reshaping your data

First sort out the class of the variables and add grouping variables

# convert type and add gender label
# I would have a look at why your numerics have been stored as factors
data.female[] <- lapply(data.female, function(x) as.numeric(as.character(x)))
data.female$gender <- "female"
data.female$ID <- rownames(data.female)

data.male[] <- lapply(data.male, function(x) as.numeric(as.character(x)))
data.male$gender <- "male"
data.male$ID <- rownames(data.male)

bind the two data frames together

dat <- rbind(data.female[names(data.male)], data.male)

Arrange data for plotting

library(reshape2)
datm <- melt(dat)

Plot

# Lattice
library(lattice)
barchart(variable ~ value|ID, groups=gender, data=datm,
                               auto.key=list(space='right'))

# ggplot2
ggplot(datm, aes(variable, value, fill=gender)) + 
  geom_bar(stat="identity", position = position_dodge()) +
  facet_grid(ID ~ .)

Autosaving multiple pages of lattice plots

If you're looking to plot a subset of Subjects on each page, then you have to subset your data for each iteration and then plot.

To get 4 Subjects on each page, you can use the following index builder as a basis for subsetting:

(i - 1) * 4 + 1:4

The trick with the Theoph dataset is that the subject "numbers" are actually ordered factors. So you have to convert the above to a factor, or, as a shortcut, to a character vector.

for(i in 1:3){
    ## Changed mypath to make it reproducible
    mypath <- file.path(tempdir(), paste("myplot_", names[i], ".pdf", sep = ""))
    pdf(file=mypath)

    mytitle = paste("Theoph Plots", names[i])

    myIndex <- as.character((i - 1) * 4 + 1:4) # index builder from above

    print(xyplot(conc ~ Time | Subject, 
        data = Theoph[Theoph$Subject %in% myIndex, ],
        type = "l", layout = c(2, 2), main = mytitle))
    dev.off()
}

The order of the subjects is a bit screwy, since that variable is an ordered factor, as mentioned. To keep the ordering, you could subset on the levels of that factor:

myIndex <- levels(Theoph$Subject)[(i - 1) * 4 + 1:4]

The best way to build your index will depend on your actual data.

Create multiple lattice plots from a data table using lapply

This is in the R-FAQ. Need a print statement around grid graphics (lattice or ggplot) when used inside a function, and the for loop is a function:

# Needed
require(data.table)  # before defining the object.

pdf()  # pdf is a multipage device.
for (i in 3:5) {
  # generate a list of mean value by season for the species in column number i
  temp <- v2[, lapply(.SD, mean), by=c("Season", "Location"), .SDcols=i]
  # Each group in a separate mini plot
  print( xyplot(temp[[3]]~temp[[1]] | temp[[2]], main = colnames(temp)[3]) )
}
dev.off()  # Failing to properly close a file graphics device is common error.

---

Related Topics