Interactive correlation plot

Basic plot function

The plot function in basic R can be used to plot correlation in a data frame (e.g. the dataset longley). However this method is not suitable to view a table with lots of columns.

plot(longley)

corrplot package

corrplot package can be used to draw a static correlation figure for a data frame. However, the scatter plots are not plotted for each pair of variables and it is hard to understand the real correlation.

cor(longley) %>% 
  corrplot()

Interactive figure using ggiraph

ggiraph package can convert a ggplot into interactive figure. A ggplot2 figure is created for the correlation. It is possible to show the scatter plot when click on the correlation map.

# Calculate the correlation and obtain the lower triangle
pd <- cor(longley)
pd[upper.tri(pd)] <- NA
pd <- reshape2::melt(pd, na.rm = TRUE)

colors = c("blue", "white", "red")

# Create ggplot2
p1 <- ggplot(pd) +
  geom_tile(aes(Var1, Var2, fill = value), color = "gray")  +
  scale_fill_gradient2(low = colors[1], high = colors[3],
                       mid = colors[2], midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Corr") +
  geom_text(mapping = aes(x = Var1, y = Var2, label = round(value, 1)), size = 2) +
  ggplot2::coord_fixed() +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   vjust = 1, size = 8, hjust = 1),
        axis.text.y = element_text(size = 8),
        legend.position = 'bottom') +
  guides(fill = FALSE) +
#  guides(fill = guide_colorbar(title = NULL, barwidth = unit(0.6, "npc"))) +
  xlab("") + ylab("") 
p1

In the next step, the interactive figure is created through adding new columns data_id and tooltip.

pd2 <- pd %>% 
  mutate(data_id = paste0(Var1, '-', Var2),
         tooltip = paste0(Var1, '-', Var2, ': ', round(value, 2)))
p2 <- ggplot(pd2) +
  geom_tile_interactive(aes(Var1, Var2, fill = value,
                            tooltip = tooltip
                            ), color = "gray")  +
  scale_fill_gradient2(low = colors[1], high = colors[3],
                       mid = colors[2], midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Corr") +
  geom_text(mapping = aes(x = Var1, y = Var2, label = round(value, 1)), size = 2) +
  ggplot2::coord_fixed() +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   vjust = 1, size = 8, hjust = 1),
        axis.text.y = element_text(size = 8),
        legend.position = 'bottom') +
  guides(fill = FALSE) +
#  guides(fill = guide_colorbar(title = NULL, barwidth = unit(0.6, "npc"))) +
  xlab("") + ylab("")
girafe(ggobj = p2)

The onclick event can be added for each grid to show the scatter plot through calling the js script. A js function create_fig is defined to use d3.js to draw a scatter plot.

knitr::raw_html('
<script type="text/javascript">
  
var create_fig = function(valuex, valuey, xlabel, ylabel) {
  var margin = {top: 10, right: 30, bottom: 50, left: 70},
  width = 460 - margin.left - margin.right,
  height = 400 - margin.top - margin.bottom;
  
  // Remove old plot
  var svg1 = d3.select("#comparison-plot");
  svg1.selectAll("*").remove();
  // append the svg object to the body of the page
  
  var svg = d3.select("#comparison-plot")
    .append("svg")
      .attr("width", width + margin.left + margin.right)
      .attr("height", height + margin.top + margin.bottom)
    .append("g")
      .attr("transform",
            "translate(" + margin.left + "," + margin.top + ")");

  // Add X axis
  var x = d3.scaleLinear()
    .domain([Math.min(...valuex), Math.max(...valuex)])
    .range([ 0, width ]);
  svg.append("g")
    .attr("transform", "translate(0," + height + ")")
    .call(d3.axisBottom(x));
  svg.append("text")
    .attr("class", "x label")
    .attr("text-anchor", "end")
    .attr("x", margin.left + width / 2)
    .attr("y", margin.top + height + 30)
    .text(xlabel);
  // Add Y axis
  var y = d3.scaleLinear()
    .domain([Math.min(...valuey), Math.max(...valuey)])
    .range([ height, 0]);
  svg.append("text")
    .attr("class", "y label")
    .attr("text-anchor", "end")
    .attr("y", -50)
    .attr("x", -(height / 2) + margin.top)
    .attr("transform", "rotate(-90)")
    .text(ylabel);
  svg.append("g")
    .call(d3.axisLeft(y));
  // Create data item
  var data = valuex.map((item, i) => ({x:item, y:valuey[i]}))
  // Add dots
  svg.append("g")
    .selectAll("dot")
    .data(data)
    .enter()
    .append("circle")
      .attr("cx", function (d) { return x(d.x); } )
      .attr("cy", function (d) { return y(d.y); } )
      .attr("r", 4)
      .style("fill", "#69b3a2")

  }
</script>
')

The js is created to response the onclick event.

# Generate js to create_fig
generate_js <- function(df) {

  x <- longley[[df$Var1]]
  y <- longley[[df$Var2]]
  df$onclick <- paste0("create_fig(", 
         jsonlite::toJSON(x), ", ",
         jsonlite::toJSON(y), ", ",
         '"', df$Var1, '", ',
         '"', df$Var2, '"',
         ")")
  df
}
# Create a new data frame
pd3 <- pd2 %>% 
  group_by(Var1, Var2) %>% 
  do(generate_js(.))

p3 <- ggplot(pd3) +
  geom_tile_interactive(aes(Var1, Var2, fill = value,
                            tooltip = tooltip,
                            data_id = data_id,
                            onclick = onclick
                            ), color = "gray")  +
  scale_fill_gradient2(low = colors[1], high = colors[3],
                       mid = colors[2], midpoint = 0, limit = c(-1, 1), space = "Lab",
                       name = "Corr") +
  geom_text(mapping = aes(x = Var1, y = Var2, label = round(value, 1)), size = 2) +
  ggplot2::coord_fixed() +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   vjust = 1, size = 8, hjust = 1),
        axis.text.y = element_text(size = 8),
        legend.position = 'bottom') +
  guides(fill = FALSE) +
#  guides(fill = guide_colorbar(title = NULL, barwidth = unit(0.6, "npc"))) +
  xlab("") + ylab("")
girafe(ggobj = p3)

A new div element is added at the bottom of interactive figure to show the scatter plot.

knitr::raw_html('<div id="comparison-plot"></div>')