簡答:似乎沒有一種優雅或簡單的方法來做到這一點,但這裏有一個解決方法。
我挖掘了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.text
的x
和y
座標,其中所述網格的單元正被用於將每個標籤位置
pushViewport(viewport(layout = grid.layout(
viewPortCount, viewPortCount,
widths = viewPortWidths, heights = viewPortHeights
)))
呼叫到vplayout
指定到視口,其將所述顯示區域分成網格相對定義。
我想這應該是推入'GGally',只需在'ggpairs'中添加額外的參數,默認值與當前版本保持100%的兼容性。 – mschilli 2015-07-14 11:50:42