Thao tác tiêu đề trục trong ggpairs (GGally)

Question

Tôi đang sử dụng mã bên dưới để tạo biểu đồ sau.

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

tôi đang cố gắng để thay đổi việc hiển thị các tiêu đề trục. Đặc biệt, tôi muốn cho các chức danh trục là:

1. Được đặt ở một khoảng cách xa trục nhãn
2. Được đặt ở một góc

Như một ví dụ, tôi muốn để có được trục tiêu đề tương tự như những hình dưới đây (tôi quan tâm đến nhãn trục duy nhất, không phải trong phần còn lại của bảng xếp hạng): Trích từ: Geovisualist

Tôi đã thử điều chỉnh cú pháp của mình thay đổi axis.title.x thành các giá trị khác nhau nhưng không mang lại kết quả mong muốn. Ví dụ: chạy mã với angle = 45.

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

trả về cùng một biểu đồ. Tôi đã có thể kiểm soát các nhãn trục bằng cách thay đổi axis.text.x ví dụ nhưng tôi không thể tìm thấy câu trả lời làm thế nào để kiểm soát các tiêu đề trục trong cốt truyện này. Bất kỳ trợ giúp sẽ được nhiều đánh giá cao.

Answer 1

Câu trả lời ngắn gọn: Có vẻ như đây không phải là cách thanh lịch hoặc dễ dàng để thực hiện, nhưng đây là giải pháp thay thế.

Tôi đào vào mã nguồn ggpairs (trong GGally package source available from CRAN) để xem cách các nhãn biến thực sự được vẽ. Hàm có liên quan trong ggpairs.R là print.ggpairs. Hóa ra các nhãn biến không phải là một phần của đối tượng ggplot trong mỗi ô của ma trận lô - nghĩa là chúng không phải là tiêu đề trục, đó là lý do tại sao chúng không bị ảnh hưởng khi sử dụng theme(axis.title.x = element_text(angle = 45) hoặc tương tự.

Thay vào đó, chúng dường như được rút ra dưới dạng chú thích văn bản sử dụng grid.text (trong gói 'grid'). grid.text lấy đối số bao gồm x, y, hjust, vjust, rot (trong đó rot là góc quay), cũng như kích thước phông chữ, họ phông chữ, v.v. sử dụng gpar (xem ?grid.text), nhưng có vẻ như không có cách nào để chuyển các giá trị khác nhau của các tham số đó print.ggpairs - chúng được cố định ở các giá trị mặc định.

Bạn có thể làm việc xung quanh nó bằng cách để trống các nhãn biến để bắt đầu và sau đó thêm chúng vào vị trí tùy chỉnh, xoay và tạo kiểu bằng cách sửa đổi phần có liên quan của mã print.ggpairs. Tôi đã đưa ra các sửa đổi sau đây. (Ngẫu nhiên, vì mã GGally nguồn gốc đã được phát hành dưới một GPL-3 license, như vậy là sửa đổi này.)

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 
} 

Và đây là một ví dụ về gọi hàm:

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

(Điều này làm cho một số rất xấu xí nhãn - chỉ nhằm mục đích trình diễn!)

Tôi không lo lắng khi đặt nhãn ở đâu đó khác với bên trái và dưới - như trong ví dụ Geovisualist - nhưng tôi nghĩ bạn sẽ làm điều đó bằng cách thay đổi đối số thành vplayout ở "Bên trái" và các đoạn mã "Dưới cùng" trong customize.labels. Các x và y tọa độ trong grid.text được định nghĩa liên quan đến một khung nhìn, mà chia vùng hiển thị thành một mạng lưới trong

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

các cuộc gọi đến vplayout quy định cụ thể mà tế bào của lưới điện đang được sử dụng để định vị mỗi nhãn.

Answer 2

Lưu ý: không phải là câu trả lời hoàn chỉnh nhưng có lẽ gợi ý cách tiếp cận nó. Bạn có thể làm điều này bằng cách chỉnh sửa các đối tượng 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

câu trả lời của tôi sẽ không giải quyết được vấn đề nhãn chéo nhưng nó sẽ sửa chữa lớp phủ một.

Tôi đã gặp vấn đề này với báo cáo tôi hiện đang viết, trong đó tiêu đề trục luôn nằm trên trục, đặc biệt là trong ggpairs. Tôi đã sử dụng kết hợp điều chỉnh out.height/out.width kết hợp với fig.height/fig.width. Riêng vấn đề không cố định, nhưng cùng với nhau. fig.height/fig.width lấy các nhãn ra khỏi trục nhưng làm cho chúng quá nhỏ để đọc, và out.height/out.width chỉ làm cho cốt truyện lớn hơn với vấn đề không thay đổi. Dưới đây đã cho tôi kết quả hiển thị:

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

trước: cốt truyện với các vấn đề

sau: