How to create lower density plot using your own density function in GGally

Question

With the following code:

library(GGally)
library(tidyverse)
library(viridis)


dat <- iris %>% select(-Species)

my_fn <- function(data, mapping, ...){
      # Using default ggplot density function

      p <- ggplot(data = data, mapping = mapping) + 
        stat_density2d(aes(fill=..density..), geom="tile", contour = FALSE) +
        scale_fill_gradientn(colours=viridis::viridis(100, option="viridis"))
      p
}


ggpairs(dat, lower=list(continuous=my_fn)) +
  theme_void()

I can create this plot:

My question is how can I change the GGally lower density plot with the following scheme:

library(MASS)
# Get density of points in 2 dimensions.
# @param x A numeric vector.
# @param y A numeric vector.
# @param n Create a square n by n grid to compute density.
# @return The density within each square.
get_density <- function(x, y, n = 100) {
  dens <- MASS::kde2d(x = x, y = y, n = n)
  ix <- findInterval(x, dens$x)
  iy <- findInterval(y, dens$y)
  ii <- cbind(ix, iy)
  return(dens$z[ii])
}



# Data wrangling method2 --------------------------------------------------
theme_set(theme_bw(base_size = 16))
tbl <- as.tibble(iris) %>% 
        select(-Species)


# tbl
dens_wrapper <- function (tbl=NULL, var1=NULL, var2=NULL) {
  tbl_pair <- tbl %>%
                select_(var1, var2)
  x <- tbl_pair %>% pull(var1)
  y <- tbl_pair %>% pull(var2)
  tbl_pair$density <- get_density(x,y)
  tbl_pair
}

feature1 = "Sepal.Length"
feature2 = "Petal.Length"
tbl_pair1 <- dens_wrapper(tbl=tbl, var1=feature1, var2=feature2) 
ggplot(tbl_pair1) +
  geom_point(aes_string(feature1, feature2, color = 'density')) +
  scale_color_viridis()

Which produce this:

Answer 1

Using a similar idea as from Change colors in ggpairs now that params is deprecated , you can just add the calculations in to your own defined function.

my_fn <- function(data, mapping, N=100, ...){

      get_density <- function(x, y, n ) {
                  dens <- MASS::kde2d(x = x, y = y, n = n)
                  ix <- findInterval(x, dens$x)
                  iy <- findInterval(y, dens$y)
                  ii <- cbind(ix, iy)
                  return(dens$z[ii])
                }

      X <- eval_data_col(data, mapping$x)
      Y <- eval_data_col(data, mapping$y)

      data$density <- get_density(x=X, y=Y, n=N)

      p <- ggplot(data, mapping) +
               geom_point(aes(colour=density), ...) +
               scale_color_viridis()      
      p
}

 ggpairs(dat, lower=list(continuous=my_fn)) +
 theme_bw()

Produces: