Manipolare i titoli degli assi in ggpairs (GGally)

Question

Sto usando il codice qui sotto per generare il seguente grafico.

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

Attualmente sto cercando di modificare la visualizzazione delle titoli degli assi. In particolare, desidero per i titoli dell'asse da:

1. posizionato ad una distanza maggiore dall'asse etichette
2. angolato

Come esempio, vorrei avere asse titoli simili a quelli nella foto qui sotto (mi interessa solo le etichette degli assi, non nel resto della classifica): Tratto da: Geovisualist

Ho provato a modificare la mia sintassi modificando lo axis.title.x con valori diversi ma non ha prodotto i risultati desiderati. Ad esempio, eseguendo il codice con angle = 45.

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

restituisce lo stesso grafico. Sono stato in grado di controllare le etichette degli assi cambiando il axis.text.x per esempio ma non riesco a trovare la risposta su come controllare i titoli degli assi in questo grafico. Qualsiasi aiuto sarà molto apprezzato.

Answer 1

Risposta breve: Non sembra essere un modo elegante o semplice per farlo, ma ecco una soluzione.

Ho inserito il codice sorgente ggpairs (nello GGally package source available from CRAN) per vedere come vengono effettivamente disegnate le etichette delle variabili. La funzione rilevante in ggpairs.R è print.ggpairs. Si scopre che le etichette delle variabili non fanno parte degli oggetti ggplot in ogni cella della matrice di stampa, ovvero non sono titoli di assi, motivo per cui non sono interessati dall'uso di theme(axis.title.x = element_text(angle = 45) o simili.

Piuttosto, sembrano disegnati come annotazioni di testo utilizzando grid.text (nel pacchetto 'grid'). grid.text accetta argomenti che includono x, y, hjust, vjust, rot (dove rot è l'angolo di rotazione), nonché la dimensione del carattere, la famiglia di caratteri, ecc. Usando gpar (vedere ?grid.text), ma sembra che al momento non sia possibile passare in diversi valori di tali parametri print.ggpairs - sono corretti con valori predefiniti.

È possibile aggirare il problema lasciando le etichette variabili vuote per iniziare e aggiungendole successivamente con posizionamento, rotazione e styling personalizzati, utilizzando una modifica della parte pertinente del codice print.ggpairs. Ho trovato la seguente modifica. (Per inciso, perché il codice GGally fonte originale è stato rilasciato sotto una GPL-3 license, così è questa modifica.)

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 
} 

Ed ecco un esempio di chiamare quella funzione:

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')) 
) 

(Questo rende alcuni molto brutto etichette - solo a scopo dimostrativo!)

Non ho provato a posizionare le etichette da qualche parte oltre a sinistra e in basso, come nell'esempio Geovisualista, ma penso che lo fareste cambiando gli argomenti in vplayout nel "Lato sinistro" e pezzi di codice "Lato inferiore" in customize.labels. I x e y coordinate in grid.text sono definite rispetto ad una finestra, che divide l'area di visualizzazione in una griglia in

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

la chiamata a vplayout specifica quale cella della griglia viene utilizzato per posizionare ciascuna etichetta.

Answer 2

Avvertenza: non è una risposta completa ma suggerisce forse un modo per accedervi. È possibile farlo modificando gli oggetti 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) 

Answer 3

La mia risposta non risolverà il problema dell'etichetta diagonale ma sarà risolvere la sovrapposizione uno.

Ho avuto questo problema con il rapporto che sto scrivendo attualmente, in cui i titoli degli assi erano sempre oltre gli assi, specialmente in ggpairs. Ho usato una combinazione di regolazione di out.height/out.width in combinazione con fig.height/fig.width. Separatamente il problema non è stato risolto, ma insieme lo è stato. fig.height/fig.width ha tolto le etichette dall'asse ma le ha rese troppo piccole per essere lette, e out.height/out.width ha reso la trama più grande con il problema invariato. Il sotto mi ha dato i risultati mostrati:

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

prima: trama con problemi

dopo: