2015-02-10 58 views
14

我使用下面的代碼生成以下圖表。在ggpairs(GGally)中操作軸標題

# 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() 

ggpairs - First Example

我目前正在試圖修改軸標題的顯示。具體地講,我想對於軸標題爲:

  1. 在從軸線更遠的距離放置的標註
  2. 斜着

作爲一個例子,我想獲得軸冠軍類似下圖的那些(我感興趣的軸標籤而已,沒有在圖表的其餘部分):Geovisualist

0: Example Label Placement 來自

我'試着調整我的語法將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來控制軸標籤,但我無法找到答案如何控制此圖中的軸標題。任何幫助都感激不盡。

回答

13

簡答:似乎沒有一種優雅或簡單的方法來做到這一點,但這裏有一個解決方法。

我挖掘了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')) 
) 

(這使得一些非常醜陋標籤 - 僅用於演示!)

我並沒有將標籤放在除左側和底部以外的地方 - 正如在您的地理視覺主義示例中 - 但我認爲您可以通過將參數更改爲「左側」中的vplayout來實現,和customize.labels中的「底部」代碼段。在grid.textxy座標,其中所述網格的單元正被用於將每個標籤位置

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

呼叫到vplayout指定到視口,其將所述顯示區域分成網格相對定義。

+0

我想這應該是推入'GGally',只需在'ggpairs'中添加額外的參數,默認值與當前版本保持100%的兼容性。 – mschilli 2015-07-14 11:50:42

12

警告:不是一個完整的答案,但也許建議一種方法來處理它。您可以通過編輯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) 

enter image description here

+1

正如我所說,這太棒了!我自己嘗試過,效果很好。只是一個小問題:我可以添加一個傳說(因爲我已經對我的情節着色)嗎?我找到了一種方式,但它爲每一個情節繪製了一個傳說。編輯:nervermind:http://stackoverflow.com/questions/22945702/how-to-add-an-external-legend-to-ggpairs :) – 2016-04-20 13:14:37

1

我的回答不會解決對角線標籤問題,但它會解決覆蓋之一。

我有這個問題,我正在撰寫的報告中,軸標題總是在軸上,特別是在ggpairs中。我結合使用了調整out.height/out.width和fig.height/fig.width。另外,問題不是固定的,而是一起的。 figure.height/fig.width將標籤從軸上移開,但使它們太小而無法讀取,並且出。高度/寬度僅僅使問題變得更大而問題沒有改變。以下給我顯示的結果:

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

前:有問題

後劇情: