如何在散点图矩阵中留下具有非显着值的空白单元格?

How can I leave blank cell with non-significant value in the scatter plot matrix?

我有以下剧情

并且我正在尝试将此图制作成这样(手动编辑),其中非重要单元格为空白

我正在使用这些 r 代码;

leg <- grab_legend(ggplot(data=data1, aes(x=NA, y=NA, colour=Si)) +
                     geom_line(size=2) + 
                     theme(legend.direction="horizontal",
                           #change legend title font size
                           legend.title = element_text(size=18), 
                           #change legend text font size
                           legend.text = element_text(size=14),
                           #change legend key size
                           legend.key.size = unit(1, 'cm')))

my_fn <- function(data1, mapping, method="p", use="pairwise", ...){
  
  # grab data
  x <- eval_data_col(data1, mapping$x)
  y <- eval_data_col(data1, mapping$y)
  
  # calculate correlation
  corr <- cor(x, y, method=method, use=use)
  
  # calculate colour based on correlation value
  # Here I have set a correlation of minus one to blue, 
  # zero to white, and one to red 
  # Change this to suit: possibly extend to add as an argument of `my_fn`
  colFn <- colorRampPalette(c("blue", "white", "red"), interpolate ='spline')
  fill <- colFn(100)[findInterval(corr, seq(-1, 1, length=100))]
  
  ggally_cor(data=data1, size=5, mapping=mapping, ...) + 
    theme_void() +
    theme(panel.background=element_rect(fill=fill))
}

ggpairs(
  data1, columns=3:7, legend=leg,
  upper = list(continuous=my_fn),
  ) +
  theme(legend.position='top')+
  theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.4, size=12),
        axis.text.y=element_text(size=12),
        strip.text = element_text(size = 14))

数据linkhttps://docs.google.com/spreadsheets/d/1q2iJ1RsRDfZQiT0UskB8PhFDU-_qTDMh2DYv9paE3bM/edit?usp=sharing

我的问题是,

如何绘制那些留空且具有非显着值的单元格?谢谢

感谢 Barret Schloerke (https://github.com/schloerke),通过在 function(...) 中添加 return 调用,我能够找到上述问题的答案。

my_fn <- function(.....) {
.....
  if (abs(corr) < threshold) {
    return(ggally_blank())
  }
.....
}

define function(...) 调用就是这样;

my_fn <- function(data1, mapping, threshold=0.34, method="p", use="pairwise", ...){
    
    # grab data
    x <- eval_data_col(data1, mapping$x)
    y <- eval_data_col(data1, mapping$y)
    
    # calculate correlation
    corr <- cor(x, y, method=method, use=use)
    
    # calculate colour based on correlation value
    # Here I have set a correlation of minus one to blue, 
    # zero to white, and one to red 
    # Change this to suit: possibly extend to add as an argument of `my_fn`
    colFn <- colorRampPalette(c("blue", "white", "red"), interpolate ='spline')
    fill <- colFn(100)[findInterval(corr, seq(-1, 1, length=100))]
    
    if (abs(corr) < threshold) {
      return(ggally_blank())
    }
    
    ggally_cor(data=data1, digits=2, size=5, mapping=mapping, ...) + 
      theme_void() +
      theme(panel.background=element_rect(fill=fill))
  }

  
  ggpairs(
    data1, columns=3:7, 
    upper = list(continuous=my_fn), ) +
    theme(legend.position='top')+
    theme(axis.text.x=element_text(angle=90, hjust=1, vjust=0.4, size=12),
          axis.text.y=element_text(size=12),
          strip.text = element_text(size = 14))  

希望对大家有所帮助