使用grid和ggplot2使用R创建连接图 [英] using grid and ggplot2 to create join plots using R
本文介绍了使用grid和ggplot2使用R创建连接图的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我想知道我能做些什么来修复一块地块。这些图被排列成一个数组，以便一行中的所有图都具有相同的Y轴变量，并且一列中的所有图具有相同的X轴变量。
当在一个网格中连接在一起时，这会创建一个多槽。因为内部的变量和缩放比例相同，所以我禁用了除外部标签外的大多数标签。然而，由于外部图有标签和轴的值，所以它们的大小与其他图的大小不同。
我正在考虑再增加2列和行网格，变量名称和轴范围值...然后只绘制相应网格空间上的变量名称和另一个网格空间上的轴值，因此只绘制剩余空间中的点并获得相同的大小。 p>
编辑1：
感谢rcs将我指向 align.plot
编辑align.plot以接受空值（因为在轴上标题/文本不需要）
现在我更接近
$ b 示例代码：
b
pre $
grid_test < - function（）
{
dsmall < - diamonds [sample（nrow（diamonds），100）]]
＃----- / align函数-----
align.plots< ; - 函数（gl，...）{
＃从http://groups.google.com/group/ggplot2/browse_thread/thread/1b859d6b4b441c90获得
＃从http：// ggextra采用。 googlecode.com/svn/trunk/R/align.r
＃BUGBUG：当有标题时不水平对齐。
＃当标题出现时，似乎有一个间隔符。包括分隔符的
＃大小。不知道如何做到这一点呢。
$ b stats.row< - vector（list，gl $ nrow）
stats.col< - vector（list，gl $ ncol）
lstAll< - list（...）
dots< - lapply（lstAll，function（.g）ggplotGrob（.g [[1]]））
#ytitles < - lapply（dots，function（.g）editGrob（getGrob（.g，axis.title.y.text，grep = TRUE），vp = NULL））
#ylabels< - lapply点，函数（.g）editGrob（getGrob（.g，axis.text.y.text，grep = TRUE），vp = NULL））
#xtitles< - lapply（dots，function g）editGrob（getGrob（.g，axis.title.x.text，grep = TRUE），vp = NULL））
#xlabels< - lapply（dots，function（.g）editGrob（getGrob （.g，axis.text.x.text，grep = TRUE），vp = NULL））
plottitles< - lapply（dots，function（.g）editGrob（getGrob（.g） .title.text，grep = TRUE），vp = NULL））
xtitles< - lapply（dots，function（.g）if（！is.null（getGrob（.g， axis.title.x.text，grep = TRUE）））
editGrob（getGrob（.g，axis.title.x.text，grep = TRUE） ，vp = NULL）else ggplot2 :::。zeroGrob）
xlabels< - lapply（dots，function（.g）if（！is.null（getGrob（.g，axis.text （.g，axis.text.x.text，grep = TRUE），vp = NULL）else ggplot2 :::。zeroGrob）
ytitles< - lapply（dots，function（.g）if（！is.null（getGrob（.g，axis.title.y.text，grep = TRUE））
editGrob（getGrob（.g，axis.title.y.text，grep = TRUE），vp = NULL）else ggplot2 :::。zeroGrob）
ylabels< - lapply （点，函数（.g）if（！is.null（getGrob（.g，axis.text.y.text，grep = TRUE）））
editGrob（getGrob（.g，axis。 text.y.text，grep = TRUE），vp = NULL）else ggplot2 :::。zeroGrob）
legends< - lapply（dots，function（.g）if（！is。 null（.g $ children $ legends））
editGrob（.g $ children $ legends，vp = NULL）else ggplot2 :::。zeroGrob）
widths.left< - mapply （`+`，e1 = lapply（ytitles，grobWidth） ，
e2 = lapply（ylabels，grobWidth），SIMPLIFY = FALSE）
widths.right< - lapply（legends，grobWidth）
＃heights.top< - lapply（plottitles，grobHeight ）
heights.top< - lapply（plottitles，function（x）unit（0，cm））
heights.bottom< - mapply（`+`，e1 = lapply（xtitles， （b）（b）（b）（b）（b）（b）（b）（b）
$ b＃Left
valNew < - widths.left [[i]]
valOld < - stats.col [[min（lstCur [[3]]）]] $ widths .left.max
if（is.null（valOld））valOld < - unit（0，cm）
stats.col [[min（lstCur [[3]]）]] $ widths.left.max< - max（do.call（unit.c，list（valOld，valNew）））
＃Right
valNew < - widths.right [[i ]]
valOld < - stats.col [[max（lstCur [[3]]）]] $ widths.right.max
if（is.null（valOld））valOld < - unit（0，cm）
stats.col [[max（lstCur [[3]]）]] $ widths.right.max< - max（do.call（unit.c，list（valOld，valNew）））
＃Top
valNew < - heights.top [[i]]
valOld < ; - stats.row [[min（lstCur [[2]]）]] $ heights.top.max
if（is.null（valOld））valOld < - unit（0，cm）
stats.row [[min（lstCur [[2]]）]] $ heights.top.max< - max（do.call（unit.c，list（valOld，valNew）））
＃底部
valNew< - heights.bottom [[i]]
valOld< - stats.row [[max（lstCur [[2]]）]] $ heights.bottom如果（is.null（valOld））valOld < - unit（0，cm）
stats.row [[max（lstCur [[2]]）]] $ heights。 bottom.max< - max（do.call（unit.c，list（valOld，valNew）））
}
for（i in seq_along（dots））{
lstCur < - lstAll [[i]]
nWidthLeftMax< - stats.c ol [[min（lstCur [[3]]）]] $ widths.left.max
nWidthRightMax< - stats.col [[max（lstCur [[3]]）]] $ widths.right.max
nHeightTopMax< - stats.row [[min（lstCur [[2]]）]] $ heights.top.max
nHeightBottomMax< - stats.row [[max（lstCur [[2] ]）]] $ heights.bottom.max
pushViewport（viewport（layout.pos.row = lstCur [[2]]，
layout.pos.col = lstCur [[3]]，只是= c（left，top）））
pushViewport（viewport（
x = unit（0，npc）+ nWidthLeftMax - widths.left [[i]]，
y = unit（0，npc）+ nHeightBottomMax - heights.bottom [[i]]，
width = unit（1，npc） - nWidthLeftMax + widths.left [[i]] -
nWidthRightMax + widths.right [[i]]，
height = unit（1，npc） - nHeightBottomMax + heights.bottom [[i]] -
nHe ightTopMax + heights.top [[i]]，
just = c（left，bottom）））
grid.draw（dots [[i]]）
upViewport（ 2）
}
}
＃----- \\ \\对称函数-----
＃边缘余量
margin1 = 0.1
margin2 = -0.9
margin3 = 0.5
plot < - ggplot（data = dsmall）+ geom_point（mapping = aes（x = x，y = depth ，color = cut））+ opts（legend.position =none）
plot< - plot + opts（axis.text.x = theme_blank（），axis.ticks = theme_blank（），axis.title （单元（margin1，lines），单位（margin1，lines），单位（margin2，x）。 ），单位（margin3，lines）））
plot <-ggplot（data = dsmall）+ geom_point（mapping = aes（x = y，y = depth，color = cut ））+ opts（legend.position =none）
plot< - plot + opts（axis.text.x = theme_blank（），axis.ticks = theme_blank（），axis.title.x = theme_blank （），axis.text.y = （单元（margin1，lines），单位（margin1，lines）的单元格中，theme_blank（），axis.title.y = theme_blank（））
plot2 < - plot + opts（plot.margin = ）单位（margin2，lines），单位（margin2，lines）））
plot <-ggplot（data = dsmall）+ geom_point（mapping = aes（x = z， y = depth，color = cut））+ opts（legend.position =none）
plot < - plot + opts（axis.text.x = theme_blank（），axis.ticks = theme_blank（）， axis.title.x = theme_blank（），axis.text.y = theme_blank（），axis.title.y = theme_blank（））
plot3< - plot + opts（plot.margin = unit.c（单位（margin1，lines），单位（margin1，lines），单位（margin2，lines），单位（margin2，lines）））
plot < - ggplot （data = dsmall）+ geom_point（mapping = aes（x = x，y = price，color = cut））+ opts（legend.position =none）
plot < - plot + opts（axis。 text.x = theme_blank（），axis.ticks = theme_blank（），axis.title.x = theme_blank（））
plot4 < - plot + opts（plot.margin = unit.c（unit（margin1， 行），单位（margin1 ，线），单位（margin2，lines），单位（margin3，lines）））
plot < - ggplot（data = dsmall）+ geom_point（mapping = aes x = y，y = price，color = cut））+ opts（legend.position =none）
plot < - plot + opts（axis.text.x = theme_blank（），axis.ticks = theme_blank（），axis.title.x = theme_blank（），axis.text.y = theme_blank（），axis.title.y = theme_blank（））
plot5< - plot + opts（plot.margin = unit.c（单位（margin1，lines），单位（margin1，lines），单位（margin2，lines），单位（margin2，lines）））
图< -ggplot（data = dsmall）+ geom_point（mapping = aes（x = z，y = price，color = cut））+ opts（legend.position =none）
plot < - plot + opts（axis.text.x = theme_blank（），axis.ticks = theme_blank（），axis.title.x = theme_blank（），axis.text.y = theme_blank（），axis.title.y = theme_blank（））
plot6 < - plot + opts（plot.margin = unit.c（单位（margin1，lines），unit（margin1，lines），unit（margin2，lines），unit（margin2 ，lines）））
p lot <-ggplot（data = dsmall）+ geom_point（mapping = aes（x = x，y = carat，color = cut））+ opts（legend.position =none）
plot < - plot + plot.margin = unit.c（单位（margin1，lines），单位（margin1，lines），单位（margin3，lines），unit（margin3，lines）））
plot <-ggplot（data = dsmall）+ geom_point（mapping = aes（x = y，y = carat ，color = cut））+ opts（legend.position =none）
plot < - plot + opts（axis.ticks = theme_blank（），axis.text.y = theme_blank（），axis.title （单位（margin1，lines），单位（margin1，lines），单位（margin3，），单位为b。 （单位为线），单位（margin2，lines）））
plot <-ggplot（data = dsmall）+ geom_point（mapping = aes（x = z，y = carat，color = cut ））+ opts（legend.position =none）
plot< - plot + opts（axis.ticks = theme_blank（），axis.text.y = theme_blank（），axis.title.y = theme_blank （））
（单元（margin1，lines），单位（margin1，lines），单位（margin3，lines），单位（margin2，lines ）））
grid_layout< - grid.layout（nrow = 3，ncol = 3，widths = c（2,2,2），heights = c（2,2,2））
grid.newpage（）
pushViewport（viewport（layout = grid_layout））
align.plots（grid_layout，
list（plot1,1,1），
list（
list（plot3，1，3），
list（plot4,2,1），
list（plot5,2,2），
list列表（plot6,2,3），
list（plot7,3,1），
list（plot8,3,2），
list（plot9,3,3））
$ / code> original image：
目前的进度图像：
解决方案
以下是ggplot2的一个简单方法，并将其融合：
<$ p $ （diamond（钻石），100），]
熔化_diamonds< - 熔化（diamonds_sample，measure.vars = c（'x' ，'y'，'z'），
variable_name ='letter'）
＃重命名熔解结果以避免与下一个熔解混淆
＃（错误熔化意味着您不能重命名熔化期间的值）
名称（熔化的金刚石）[9]< - 'letter.value'
熔化的金刚石< - 熔化（熔化的金刚石，
measure.vars = c 'depth'，'price'，'carat'），variable_name ='variables'）
ggplot（melted_diamonds，aes（x = letter.value，y = value，color = cut））+
geom_point（）+ facet_grid（变量〜letter，scale ='free'）
结果：
你可以使用所有的ggplot2选项以获得标签出现在适当的地方，并删除图例。
注意：对于这样的情节，你想两两比较大量变量，查看 GGally包。这里有一些文档： http：// rgm2。 lab.nig.ac.jp/RGM2/func.php?rd_id=GGally:ggpairs 的。
I would like to know what can I do to fix a grid of plots. The plots are arranged in an array so that all the plots in a row have the same Y axis variable and all the plots in a column have the same X axis variable.
When joined together in a grid this creates a multiplot. I disable the labels on most of the plots excepting the outer ones, since the inner ones have the same variable and scale. However, since the outer plots have labels and axis values, they result in a different size from the other ones.
I was thinking of adding 2 more columns and rows to the grid, for the variable names and the axis range values... then plotting only the variable names on the corresponding grid space and the axis values on another grid space, therefore only plotting the points in the remaining space and getting equal sizes.
EDIT 1:
Thanks to rcs for pointing me toward align.plot
Edited align.plot to accept null values (for when having title/text in the axis isnt desired)
Now I'm closer to the goal but the first columun plots are still smaller width than the rest due to the labels.
example code:
grid_test <- function ()
{
dsmall <- diamonds[sample(nrow(diamonds), 100), ]
#-----/align function-----
align.plots <- function(gl, ...){
# Obtained from http://groups.google.com/group/ggplot2/browse_thread/thread/1b859d6b4b441c90
# Adopted from http://ggextra.googlecode.com/svn/trunk/R/align.r
# BUGBUG: Does not align horizontally when one has a title.
# There seems to be a spacer used when a title is present. Include the
# size of the spacer. Not sure how to do this yet.
stats.row <- vector( "list", gl$nrow )
stats.col <- vector( "list", gl$ncol )
lstAll <- list(...)
dots <- lapply(lstAll, function(.g) ggplotGrob(.g[[1]]))
#ytitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL))
#ylabels <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL))
#xtitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL))
#xlabels <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL))
plottitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"plot.title.text",grep=TRUE), vp=NULL))
xtitles <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.title.x.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob)
xlabels <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.text.x.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob)
ytitles <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.title.y.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob)
ylabels <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.text.y.text",grep=TRUE)))
editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob)
legends <- lapply(dots, function(.g) if(!is.null(.g$children$legends))
editGrob(.g$children$legends, vp=NULL) else ggplot2:::.zeroGrob)
widths.left <- mapply(`+`, e1=lapply(ytitles, grobWidth),
e2= lapply(ylabels, grobWidth), SIMPLIFY=FALSE)
widths.right <- lapply(legends, grobWidth)
# heights.top <- lapply(plottitles, grobHeight)
heights.top <- lapply( plottitles, function(x) unit(0,"cm") )
heights.bottom <- mapply(`+`, e1=lapply(xtitles, grobHeight), e2= lapply(xlabels, grobHeight), SIMPLIFY=FALSE)
for ( i in seq_along( lstAll ) ) {
lstCur <- lstAll[[i]]
# Left
valNew <- widths.left[[ i ]]
valOld <- stats.col[[ min(lstCur[[3]]) ]]$widths.left.max
if ( is.null( valOld ) ) valOld <- unit( 0, "cm" )
stats.col[[ min(lstCur[[3]]) ]]$widths.left.max <- max( do.call( unit.c, list(valOld, valNew) ) )
# Right
valNew <- widths.right[[ i ]]
valOld <- stats.col[[ max(lstCur[[3]]) ]]$widths.right.max
if ( is.null( valOld ) ) valOld <- unit( 0, "cm" )
stats.col[[ max(lstCur[[3]]) ]]$widths.right.max <- max( do.call( unit.c, list(valOld, valNew) ) )
# Top
valNew <- heights.top[[ i ]]
valOld <- stats.row[[ min(lstCur[[2]]) ]]$heights.top.max
if ( is.null( valOld ) ) valOld <- unit( 0, "cm" )
stats.row[[ min(lstCur[[2]]) ]]$heights.top.max <- max( do.call( unit.c, list(valOld, valNew) ) )
# Bottom
valNew <- heights.bottom[[ i ]]
valOld <- stats.row[[ max(lstCur[[2]]) ]]$heights.bottom.max
if ( is.null( valOld ) ) valOld <- unit( 0, "cm" )
stats.row[[ max(lstCur[[2]]) ]]$heights.bottom.max <- max( do.call( unit.c, list(valOld, valNew) ) )
}
for(i in seq_along(dots)){
lstCur <- lstAll[[i]]
nWidthLeftMax <- stats.col[[ min( lstCur[[ 3 ]] ) ]]$widths.left.max
nWidthRightMax <- stats.col[[ max( lstCur[[ 3 ]] ) ]]$widths.right.max
nHeightTopMax <- stats.row[[ min( lstCur[[ 2 ]] ) ]]$heights.top.max
nHeightBottomMax <- stats.row[[ max( lstCur[[ 2 ]] ) ]]$heights.bottom.max
pushViewport( viewport( layout.pos.row=lstCur[[2]],
layout.pos.col=lstCur[[3]], just=c("left","top") ) )
pushViewport(viewport(
x=unit(0, "npc") + nWidthLeftMax - widths.left[[i]],
y=unit(0, "npc") + nHeightBottomMax - heights.bottom[[i]],
width=unit(1, "npc") - nWidthLeftMax + widths.left[[i]] -
nWidthRightMax + widths.right[[i]],
height=unit(1, "npc") - nHeightBottomMax + heights.bottom[[i]] -
nHeightTopMax + heights.top[[i]],
just=c("left","bottom")))
grid.draw(dots[[i]])
upViewport(2)
}
}
#-----\align function-----
# edge margins
margin1 = 0.1
margin2 = -0.9
margin3 = 0.5
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = depth, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank())
plot1 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin3,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = depth, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank())
plot2 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = depth, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank())
plot3 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = price, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank())
plot4 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin3,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = price, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank())
plot5 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = price, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank())
plot6 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = carat, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.ticks = theme_blank())
plot7 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin3,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = carat, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.ticks = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank())
plot8 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin2,"lines")))
plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = carat, colour = cut)) + opts(legend.position="none")
plot <- plot + opts(axis.ticks = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank())
plot9 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin2,"lines")))
grid_layout <- grid.layout( nrow=3, ncol=3, widths=c(2,2,2), heights=c(2,2,2) )
grid.newpage()
pushViewport( viewport( layout=grid_layout ) )
align.plots( grid_layout,
list( plot1, 1, 1 ),
list( plot2, 1, 2 ),
list( plot3, 1, 3 ),
list( plot4, 2, 1 ),
list( plot5, 2, 2 ),
list( plot6, 2, 3 ),
list( plot7, 3, 1 ),
list( plot8, 3, 2 ),
list( plot9, 3, 3 ) )
}
original image:
current progress image:
解决方案
Here's a simple way with ggplot2 and melt:
diamonds_sample <- diamonds[sample(nrow(diamonds), 100), ]
melted_diamonds <- melt(diamonds_sample, measure.vars=c('x','y','z'),
variable_name='letter')
# rename the melt results to avoid confusion with next melt
# (bug in melt means you can't rename the value during melt)
names(melted_diamonds)[9] <- 'letter.value'
melted_diamonds <- melt(melted_diamonds,
measure.vars=c('depth', 'price', 'carat'), variable_name='variables')
ggplot(melted_diamonds, aes(x=letter.value, y=value, colour=cut)) +
geom_point() + facet_grid(variables~letter, scale='free')
Result:
You can screw around with all of the ggplot2 options to get the tabs to appear in the appropriate places, and remove the legend.
Note: for plots like this, where you want to compare lots of variables pairwise, check out the GGally package. There are some docs here: http://rgm2.lab.nig.ac.jp/RGM2/func.php?rd_id=GGally:ggpairs.
这篇关于使用grid和ggplot2使用R创建连接图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
