Manipulowanie tytułami osi w ggpairs (GGally)

Krótka odpowiedź: nie wydaje się, aby był to elegancki lub łatwy sposób, ale oto obejście.

Pogrzebałem w kodzie źródłowym ggpairs (w źródle ggally package source dostępnym w CRAN), aby zobaczyć, jak rzeczywiście rysowane są etykiety zmiennych. Istotną funkcją w ggpairs.R jest print.ggpairs. Okazuje się, że etykiety zmiennych nie są częścią obiektów ggplot w każdej komórce macierzy wykresu - tzn. nie są tytułami osi, dlatego nie ma na nie wpływu użycie theme(axis.title.x = element_text(angle = 45) lub podobne.

Są raczej rysowane jako adnotacje tekstowe za pomocą grid.text (w pakiecie 'grid'). grid.text pobiera argumenty, w tym x, y, hjust, vjust, rot (gdzie rot jest kątem obrotu), a także rozmiar czcionki, rodzinę czcionek itp. używając gpar (zobacz ?grid.text), ale wygląda na to, że obecnie nie ma możliwości przeniesienia różnych wartości tych parametrów do print.ggpairs -- są one ustawione na wartości domyślne.

Możesz obejść to, pozostawiając etykiety zmiennych puste na początku, a następnie dodając je na później z dostosowanym rozmieszczeniem, rotacją i stylizacją, z wykorzystaniem modyfikacji odpowiedniej części kodu print.ggpairs. Wymyśliłem następującą modyfikację. (Nawiasem mówiąc, ponieważ oryginalny GGally kod źródłowy został wydany na licencji GPL-3, tak samo jest z tą modyfikacją.)

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
}

A oto przykład wywołania tej funkcji:

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

(to sprawia, że niektóre bardzo brzydkie etykiety - tylko w celu demonstracji!)

Nie majstrowałem z umieszczeniem etykiety gdzieś indziej niż lewa i dolna -- jak w Twoim geowizualistycznym przykładzie -- ale myślę, że zrobiłbyś to zmieniając argumenty na vplayout w" lewa strona "i" dolna strona " części kodu w customize.labels. Współrzędne x i y w grid.text są zdefiniowane względem widoku, który dzieli obszar wyświetlania na siatkę w

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

Wywołanie vplayout określa, która komórka siatki jest używana do pozycjonowania każdej etykiety.