问题
First I thought I need to it manually in powerpoint, then I thought may be try with R, if there is a solution. Here is my example data:
set.seed(123)
myd<- expand.grid('cat' = LETTERS[1:5], 'cond'= c(F,T), 'phase' = c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase"))
myd$value <- floor((rnorm(nrow(myd)))*100)
myd$value[myd$value < 0] <- 0
require(ggplot2)
ggplot() +
geom_bar(data=myd, aes(y = value, x = phase, fill = cat), stat="identity",position='dodge') +
theme_bw()
Here is what output should look like:
The jpeg image can be randomly generated (to demo examples) or example figures at the links:
Interphase prophase , metaphase, anaphase , telophase
Edit:
Suggestion @bapste
回答1:
Using grid package, and playing with viewports, you can have this
## transform the jpeg to raster grobs
library(jpeg)
names.axis <- c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase")
images <- lapply(names.axis,function(x){
img <- readJPEG(paste('lily_',x,'.jpg',sep=''), native=TRUE)
img <- rasterGrob(img, interpolate=TRUE)
img
} )
## main viewports, I divide the scene in 10 rows ans 5 columns(5 pictures)
pushViewport(plotViewport(margins = c(1,1,1,1),
layout=grid.layout(nrow=10, ncol=5),xscale =c(1,5)))
## I put in the 1:7 rows the plot without axis
## I define my nested viewport then I plot it as a grob.
pushViewport(plotViewport(layout.pos.col=1:5, layout.pos.row=1:7,
margins = c(1,1,1,1)))
pp <- ggplot() +
geom_bar(data=myd, aes(y = value, x = phase, fill = cat),
stat="identity",position='dodge') +
theme_bw()+theme(legend.position="none", axis.title.y=element_blank(),
axis.title.x=element_blank(),axis.text.x=element_blank())
gg <- ggplotGrob(pp)
grid.draw(gg)
upViewport()
## I draw my pictures in between rows 8/9 ( visual choice)
## I define a nested Viewport for each picture than I draw it.
sapply(1:5,function(x){
pushViewport(viewport(layout.pos.col=x, layout.pos.row=8:9,just=c('top')))
pushViewport(plotViewport(margins = c(5.2,3,4,3)))
grid.draw(images[[x]])
upViewport(2)
## I do same thing for text
pushViewport(viewport(layout.pos.col=x, layout.pos.row=10,just=c('top')))
pushViewport(plotViewport(margins = c(1,3,1,1)))
grid.text(names.axis[x],gp = gpar(cex=1.5))
upViewport(2)
})
pushViewport(plotViewport(layout.pos.col=1:5, layout.pos.row=1:9,
margins = c(1,1,1,1)))
grid.rect(gp=gpar(fill=NA))
upViewport(2)
回答2:
You can create a custom element function for axis.text.x, but it's quite fiddly and convoluted. Similar requests have been made in the past, it would be nice to have a clean solution for this and other custom changes (strip labels, axes, etc.) Feature request, anyone?
library(jpeg)
img <- lapply(list.files(pattern="jpg"), readJPEG )
names(img) <- c("Anaphase", "Interphase", "Metaphase", "Prophase", "Telophase")
require(ggplot2)
require(grid)
# user-level interface to the element grob
my_axis = function(img) {
structure(
list(img=img),
class = c("element_custom","element_blank", "element") # inheritance test workaround
)
}
# returns a gTree with two children: the text label, and a rasterGrob below
element_grob.element_custom <- function(element, x,...) {
stopifnot(length(x) == length(element$img))
tag <- names(element$img)
# add vertical padding to leave space
g1 <- textGrob(paste0(tag, "\n\n\n\n\n"), x=x,vjust=0.6)
g2 <- mapply(rasterGrob, x=x, image = element$img[tag],
MoreArgs = list(vjust=0.7,interpolate=FALSE,
height=unit(5,"lines")),
SIMPLIFY = FALSE)
gTree(children=do.call(gList,c(g2,list(g1))), cl = "custom_axis")
}
# gTrees don't know their size and ggplot would squash it, so give it room
grobHeight.custom_axis = heightDetails.custom_axis = function(x, ...)
unit(6, "lines")
ggplot(myd) +
geom_bar(aes(y = value, x = phase, fill = cat), stat="identity", position='dodge') +
theme_bw() +
theme(axis.text.x = my_axis(img),
axis.title.x = element_blank())
ggsave("test.png",p,width=10,height=8)
回答3:
Generating such a figure has become relatively straightforward with functions available in the cowplot package, specifically the axis_canvas() and insert_xaxis_grob() functions. (Disclaimer: I'm the package author.)
require(cowplot)
# create the data
set.seed(123)
myd <- expand.grid('cat' = LETTERS[1:5], 'cond'= c(F,T), 'phase' = c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase"))
myd$value <- floor((rnorm(nrow(myd)))*100)
myd$value[myd$value < 0] <- 0
# make the barplot
pbar <- ggplot(myd) +
geom_bar(aes(y = value, x = phase, fill = cat), stat="identity", position='dodge') +
scale_y_continuous(limits = c(0, 224), expand = c(0, 0)) +
theme_minimal(14) +
theme(axis.ticks.length = unit(0, "in"))
# make the image strip
pimage <- axis_canvas(pbar, axis = 'x') +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_interphase.jpg", x = 0.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_prophase.jpg", x = 1.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_metaphase2.jpg", x = 2.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_anaphase2.jpg", x = 3.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_telophase.jpg", x = 4.5, scale = 0.9)
# insert the image strip into the bar plot and draw
ggdraw(insert_xaxis_grob(pbar, pimage, position = "bottom"))
I'm reading the images straight from the web here, but the draw_image() function will also work with local files.
In theory, it should be possible to draw the image strip using geom_image() from the ggimage package, but I couldn't get it to work without having distorted images, so I resorted to five draw_image() calls.
回答4:
Edit: This is a cumbersome approach that can easily break. Please consider this solution instead.
Here's a solution using the cowplot package. It's not necessarily better, because it requires some fiddling with coordinates to get things lined up correctly, but it's an alternative and it may be more flexible in some ways.
# create data
set.seed(123)
myd<- expand.grid('cat' = LETTERS[1:5], 'cond'= c(F,T), 'phase' = c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase"))
myd$value <- floor((rnorm(nrow(myd)))*100)
myd$value[myd$value < 0] <- 0
# load images
library(jpeg)
img <- lapply(list.files(pattern="jpg"), readJPEG )
names(img) <- c("Anaphase", "Interphase", "Metaphase", "Prophase", "Telophase")
# solution via cowplot, define a function that draws a strip of images
require(cowplot)
add_image_strip <- function(plot, image_list, xmin = 0, xmax = 1, y = 0, height = 1)
{
xstep = (xmax-xmin)/length(image_list)
for (img in image_list)
{
g <- grid::rasterGrob(img, interpolate=TRUE)
plot <- plot + annotation_custom(g, xmin, xmax = xmin + xstep, ymin = y, ymax = y + height)
xmin <- xmin + xstep
}
plot
}
# make the bar plot, with extra spacing at the bottom
plot.myd <- ggplot(myd) +
geom_bar(aes(y = value, x = phase, fill = cat), stat="identity", position='dodge') +
theme( axis.title.x = element_blank(),
plot.margin = unit(c(1, 1, 4.5, 0.5), "lines")
)
# place bar plot and image strip onto blanc canvas
# requires some fiddling with numbers, specific choice depends
# on `width` and `height` choices in ggsave
plot <- ggdraw(plot.myd)
plot <- add_image_strip(plot, image_list=img, xmin = .105, xmax = 0.875, y=.04, height = .18)
ggsave("test.png", plot, width=8, height=4)
来源：https://stackoverflow.com/questions/14070953/photo-alignment-with-graph-in-r