【问题标题】:Manipulating axis titles in ggpairs (GGally)在 ggpairs (GGally) 中操作轴标题
【发布时间】:2015-04-10 05:50:25
【问题描述】:

我正在使用下面的代码来生成下面的图表。

# Setup
data(airquality)

# Device start
png(filename = "example.png", units = "cm", width = 20, height = 14, res = 300)

# Define chart
pairs.chrt <- ggpairs(airquality,
                      lower = list(continuous = "smooth"),
                      diag = list(continuous = "blank"),
                      upper = list(continuous = "blank")) +
  theme(legend.position = "none",
        panel.grid.major = element_blank(),
        axis.ticks = element_blank(),
        axis.title.x = element_text(angle = 180, vjust = 1, color = "black"),
        panel.border = element_rect(fill = NA))

# Device off and print
print(pairs.chrt)
dev.off()

我目前正在尝试修改轴标题的显示。特别是,我希望轴标题为:

  1. 放置在距离轴标签更远的地方
  2. 倾斜放置

例如,我想获得类似于下图所示的轴标题(我只对轴标签感兴趣,而不对图表的其余部分感兴趣): 取自:Geovisualist

我尝试调整我的语法,将axis.title.x 更改为不同的值,但它不会产生预期的结果。例如使用angle = 45 运行代码。

axis.title.x = element_text(angle = 45, vjust = 1, color = "black"),
            panel.border = element_rect(fill = NA))

返回相同的图表。例如,我可以通过更改 axis.text.x 来控制轴标签,但我找不到如何在此图中控制轴标题的答案。任何帮助将不胜感激。

【问题讨论】:

    标签: r scatter-plot ggally r-corrplot


    【解决方案1】:

    简短回答:似乎没有一种优雅或简单的方法可以做到这一点,但这里有一个解决方法。

    我深入研究了ggpairs 源代码(在 GGally package source available from CRAN 中)以查看变量标签的实际绘制方式。 ggpairs.R中的相关函数是print.ggpairs。事实证明,变量标签不是绘图矩阵每个单元格中 ggplot 对象的一部分——即它们不是轴标题,这就是为什么它们不受使用 theme(axis.title.x = element_text(angle = 45) 或类似的影响。

    相反,它们似乎是使用grid.text (在包'grid' 中)作为文本注释绘制的。 grid.text 接受参数包括x, y, hjust, vjust, rot(其中rot 是旋转角度),以及使用gpar(见?grid.text)的字体大小、字体系列等,但看起来目前没有将这些参数的不同值传递给print.ggpairs 的方法——它们被固定为默认值。

    您可以先将变量标签留空,然后使用修改print.ggpairs 代码的相关部分,然后通过自定义放置、旋转和样式添加它们来解决此问题。我想出了以下修改。 (顺便说一句,因为原来的GGally源代码是在GPL-3 license下发布的,所以这次修改。)

    customize.labels <- function(
      plotObj,
      varLabels = NULL, #vector of variable labels
      titleLabel = NULL, #string for title
      leftWidthProportion = 0.2, #if you changed these from default...
      bottomHeightProportion = 0.1, #when calling print(plotObj),...
      spacingProportion = 0.03, #then change them the same way here so labels will line up with plot matrix.
      left.opts = NULL, #see pattern in left.opts.default
      bottom.opts = NULL, #see pattern in bottom.opts.default
      title.opts = NULL) { #see pattern in title.opts.default
    
      require('grid')
    
      vplayout <- function(x, y) {
        viewport(layout.pos.row = x, layout.pos.col = y)
      }
    
      numCol <- length(plotObj$columns)
      if (is.null(varLabels)) {
        varLabels <- colnames(plotObj$data)
        #default to using the column names of the data
      } else if (length(varLabels) != numCol){
        stop('Length of varLabels must be equal to the number of columns')
      }
    
      #set defaults for left margin label style
      left.opts.default <- list(x=0,
                                y=0.5,
                                rot=90,
                                just=c('centre', 'centre'), #first gives horizontal justification, second gives vertical
                                gp=list(fontsize=get.gpar('fontsize')))
      #set defaults for bottom margin label style
      bottom.opts.default <- list(x=0,
                                  y=0.5,
                                  rot=0,
                                  just=c('centre', 'centre'),#first gives horizontal justification, second gives vertical
                                  gp=list(fontsize=get.gpar('fontsize')))
      #set defaults for title text style
      title.opts.default <- list(x = 0.5, 
                                 y = 1, 
                                 just = c(.5,1),
                                 gp=list(fontsize=15))
    
      #if opts not provided, go with defaults
      if (is.null(left.opts)) {
        left.opts <- left.opts.default
      } else{
        not.given <- names(left.opts.default)[!names(left.opts.default) %in% 
                                                names(left.opts)]
    if (length(not.given)>0){
      left.opts[not.given] <- left.opts.default[not.given]
    }
      }
    
    if (is.null(bottom.opts)) {
      bottom.opts <- bottom.opts.default
    } else{
      not.given <- names(bottom.opts.default)[!names(bottom.opts.default) %in%
                                                names(bottom.opts)]
    if (length(not.given)>0){
      bottom.opts[not.given] <- bottom.opts.default[not.given]
    }
    }
    
    if (is.null(title.opts)) {
      title.opts <- title.opts.default
    } else{
      not.given <- names(title.opts.default)[!names(title.opts.default) %in%
                                               names(title.opts)]
    if (length(not.given)>0){
      title.opts[not.given] <- title.opts.default[not.given]
    }
    }
    
      showLabels <- TRUE
      viewPortWidths <- c(leftWidthProportion, 
                          1, 
                          rep(c(spacingProportion,1), 
                              numCol - 1))
      viewPortHeights <- c(rep(c(1,
                                 spacingProportion), 
                               numCol - 1), 
                           1, 
                           bottomHeightProportion)
    
    viewPortCount <- length(viewPortWidths)
    
    if(!is.null(titleLabel)){
      pushViewport(viewport(height = unit(1,"npc") - unit(.4,"lines")))
      do.call('grid.text', c(title.opts[names(title.opts)!='gp'], 
                             list(label=titleLabel, 
                                  gp=do.call('gpar', 
                                          title.opts[['gp']]))))
      popViewport()
    }
    
      # viewport for Left Names
      pushViewport(viewport(width=unit(1, "npc") - unit(2,"lines"), 
                            height=unit(1, "npc") - unit(3, "lines")))
    
      ## new for axis spacingProportion
      pushViewport(viewport(layout = grid.layout(
        viewPortCount, viewPortCount,
        widths = viewPortWidths, heights = viewPortHeights
      )))
    
      # Left Side
      for(i in 1:numCol){
        do.call('grid.text', 
                c(left.opts[names(left.opts)!='gp'], 
                  list(label=varLabels[i], 
                       vp = vplayout(as.numeric(i) * 2 - 1 ,1),
                       gp=do.call('gpar', 
                               left.opts[['gp']]))))
      }
      popViewport()# layout
      popViewport()# spacing
    
      # viewport for Bottom Names
      pushViewport(viewport(width=unit(1, "npc") - unit(3,"lines"), 
                            height=unit(1, "npc") - unit(2, "lines")))
    
      ## new for axis spacing
      pushViewport(viewport(layout = grid.layout(
        viewPortCount, viewPortCount,
        widths = viewPortWidths, heights = viewPortHeights)))
    
      # Bottom Side
      for(i in 1:numCol){
        do.call('grid.text', 
                c(bottom.opts[names(bottom.opts)!='gp'], 
                  list(label=varLabels[i], 
                       vp = vplayout(2*numCol, 2*i),
                       gp=do.call('gpar', 
                               bottom.opts[['gp']]))))
      }
    
      popViewport() #layout
      popViewport() #spacing
    }
    

    下面是调用该函数的示例:

    require('data.table')
    require('GGally')
    require('grid')
    fake.data <- data.table(test.1=rnorm(50), #make some fake data for  demonstration
                            test.2=rnorm(50), 
                            test.3=rnorm(50),
                            test.4=rnorm(50))
    
    g <- ggpairs(data=fake.data, 
                 columnLabels=rep('', ncol(fake.data)))
    #Set columnLabels to a vector of blank column labels
    #so that original variable labels will be blank.
    print(g)
    
    
    customize.labels(plotObj=g,
                     titleLabel = 'Test plot', #string for title
                     left.opts = list(x=-0.5, #moves farther to the left, away from vertical axis
                                      y=0.5, #centered with respect to vertical axis
                                      just=c('center', 'center'),
                                      rot=90,
                                      gp=list(col='red',
                                              fontface='italic',
                                              fontsize=12)), 
                     bottom.opts = list(x=0.5,
                                        y=0,
                                        rot=45, #angle the text at 45 degrees
                                        just=c('center', 'top'),
                                        gp=list(col='red',
                                                fontface='bold',
                                                fontsize=10)), 
                     title.opts = list(gp=list(col='green',
                                               fontface='bold.italic'))
    )
    

    (这会产生一些非常难看的标签——仅用于演示目的!)

    我没有修改将标签放置在左侧和底部以外的位置 - 就像在您的 Geovisualist 示例中一样 - 但我认为您可以通过将“左侧”中的参数更改为 vplayout 来做到这一点和customize.labels 中的“底部”代码片段。 grid.text 中的xy 坐标是相对于视口定义的,视口将显示区域划分为网格

    pushViewport(viewport(layout = grid.layout(
            viewPortCount, viewPortCount,
            widths = viewPortWidths, heights = viewPortHeights
          )))
    

    vplayout 的调用指定了网格的哪个单元格用于定位每个标签。

    【讨论】:

    • 我认为这应该被推入GGally,只需将附加参数添加到ggpairs,默认值允许与当前版本100%兼容。
    【解决方案2】:

    警告:不是一个完整的答案,但可能会提出一种解决方法。您可以通过编辑grid 对象来完成此操作。

    # Plot in current window
    # use left to add space at y axis and bottom for below xaxis
    # see ?print.ggpairs
    print(pairs.chrt, left = 1, bottom = 1)
    
    # Get list of grobs in current window and extract the axis labels
    # note if you add a title this will add another text grob, 
    # so you will need to tweak this so not to extract it
    g <- grid.ls(print=FALSE)
    idx <- g$name[grep("text", g$name)]
    
    # Rotate yaxis labels
    # change the rot value to the angle you want
    for(i in idx[1:6]) {
            grid.edit(gPath(i), rot=0, hjust=0.25, gp = gpar(col="red"))
     }
    
    # Remove extra ones if you want
    n <- ncol(airquality)
    lapply(idx[c(1, 2*n)], grid.remove)
    

    【讨论】:

    • 正如我所说,这太棒了!我自己试过了,效果很好。只是一个小问题:我可以添加一个图例(因为我已经为我的情节着色)吗?我找到了一种方法,但它为每个情节绘制了一个图例。编辑:神经思维:stackoverflow.com/questions/22945702/… :)
    【解决方案3】:

    我的回答不会解决对角线标签问题,但会解决覆盖问题。

    我目前正在编写的报告中遇到了这个问题,其中轴标题总是在轴上方,尤其是在 ggpairs 中。我结合使用调整 out.height/out.width 和 fig.height/fig.width。单独的问题没有解决,但一起解决了。 fig.height/fig.width 将标签从轴上移开,但使它们太小而无法阅读,而 out.height/out.width 只是在问题不变的情况下使图变大。下面给了我显示的结果:

    out.height="400px", out.width="400px",fig.height=10,fig.width=10
    

    之前:有问题的情节

    之后:

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2015-05-06
      • 2015-08-31
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2014-05-05
      • 2013-12-03
      • 2015-07-08
      相关资源
      最近更新 更多