---
title: "Recreating the scIB figures"
vignette: >
  %\VignetteIndexEntry{Recreating the scIB figures}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
bibliography: ../inst/REFERENCES.bib
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
```

## Introduction

The [single-cell integration benchmarking (scIB)][scib-website] project was an effort to evaluate and compare the performance of methods for integrating single-cell RNA and ATAC sequencing datasets [@scib_Luecken2021].
Many of the results were displayed using custom scripts to create visualisations similar to those produced by `funkyheatmap`.

In this vignette we will show how these figures can be reproduced using `funkyheatmap`.

```{r libraries}
library(funkyheatmap)
library(dplyr)
library(tibble)
```

## Summary figure

The first figure we will recreate is the summary figure showing the performance of all methods on RNA data. Here is the original for reference:

![scIB RNA summary figure](https://github.com/theislab/scib-reproducibility/blob/main/data/img/best-RNA.png?raw=true){width=100%}

### Data

The steps for summarising the raw metric scores are quite complex so we have included a pre-processed summary table as part of `funkyheatmap` which is produced from the files available in the [scIB reproducibility repository][scib-reproducibility].

```{r summary-data}
data("scib_summary")
glimpse(scib_summary)
```

This data frame contains several columns: details of the method version and output, an average rank used to order the table, overall scores and ranks for the performance on each dataset, usability scores and ranks (for the package and paper), and scalability scores and ranks (for both time and memory).
All of these will go into the summary table.

The dataset requires some preparation for the `funky_heatmap()` function. We will create an `id` column using the row numbers (the data is already sorted by performance ranking). We also create label columns for each of the scores showing the top 3 performers and relabel some of the columns. Finally, we subset to a the set of columns we want to plot.

```{r summary-prep}
# A small helper function for creating rank labels for each column.
# It takes a scores, ranks them and returns a character vector with labels for
# the top 3 scores. Any additional arguments are passed to the `rank()`
# function.
label_top_3 <- function(scores, ...) {
  ranks <- rank(scores, ...)
  ifelse(ranks <= 3, as.character(ranks), "")
}

scib_summary_plot <- scib_summary |>
  # Create an ID column showing the final rank
  mutate(id = as.character(seq_len(nrow(scib_summary)))) |>
  # Set the labels for the scaling and features columns
  mutate(
    scaling = factor(
      scaling,
      levels = c("Unscaled", "Scaled"),
      labels = c("-", "+")
    ),
    features = factor(
      features,
      levels = c("Full", "HVG"),
      labels = c("FULL", "HVG")
    )
  ) |>
  # Create a column with paths to output images
  mutate(
    output_img = case_match(
      output,
      "Features" ~ "images/matrix.png",
      "Embedding" ~ "images/embedding.png",
      "Graph" ~ "images/graph.png"
    )
  ) |>
  # Create rank labels
  mutate(
    label_pancreas = label_top_3(rank_pancreas),
    label_lung_atlas = label_top_3(rank_lung_atlas),
    label_immune_cell_hum = label_top_3(rank_immune_cell_hum),
    label_immune_cell_hum_mou = label_top_3(rank_immune_cell_hum_mou),
    label_mouse_brain = label_top_3(rank_mouse_brain),
    label_simulations_1_1 = label_top_3(rank_simulations_1_1),
    label_simulations_2 = label_top_3(rank_simulations_2),
    package_label = label_top_3(package_rank, ties.method = "min"),
    paper_label = label_top_3(paper_rank, ties.method = "min"),
    time_label = label_top_3(time_rank, ties.method = "min"),
    memory_label = label_top_3(memory_rank, ties.method = "min")
  ) |>
  # scale rank columns between [0, 1] because `scale_column` is set to FALSE.
  mutate_at(
    c("rank_pancreas", "rank_lung_atlas", "rank_immune_cell_hum", "rank_immune_cell_hum_mou", "rank_mouse_brain", "rank_simulations_1_1", "rank_simulations_2", "package_rank", "paper_rank", "time_rank", "memory_rank"),
    function(x) {
      scale_minmax(-x)
    }
  ) |>
  as.data.frame()

glimpse(scib_summary_plot)
```

### Column information

The first step in plotting the figure is to create a data frame describing how we want to plot the columns.

```{r summary-cols}
column_info <- tribble( # tribble_start
  ~id, ~id_color, ~name, ~geom, ~group, ~options,
  "id", NA, "Rank", "text", "Method", list(hjust = 0),
  "method", NA, "Method", "text", "Method", list(hjust = 0, width = 5),
  "output_img", NA, "Output", "image", "Method", list(),
  "features", "features", "Features", "text", "Method", list(palette = "features", width = 2),
  "scaling", NA, "Scaling", "text", "Method", list(fontface = "bold"),
  "overall_pancreas", "rank_pancreas", "Pancreas", "bar", "RNA", list(palette = "blues", width = 1.5, draw_outline = FALSE),
  "label_pancreas", NA, NA, "text", "RNA", list(hjust = .1, overlay = TRUE),
  "overall_lung_atlas", "rank_lung_atlas", "Lung", "bar", "RNA", list(palette = "blues", width = 1.5, draw_outline = FALSE),
  "label_lung_atlas", NA, NA, "text", "RNA", list(hjust = .1, overlay = TRUE),
  "overall_immune_cell_hum", "rank_immune_cell_hum", "Immune (human)", "bar", "RNA", list(palette = "blues", width = 1.5, draw_outline = FALSE),
  "label_immune_cell_hum", NA, NA, "text", "RNA", list(hjust = .1, overlay = TRUE),
  "overall_immune_cell_hum_mou", "rank_immune_cell_hum_mou", "Immune (human/mouse)", "bar", "RNA", list(palette = "blues", width = 1.5, draw_outline = FALSE),
  "label_immune_cell_hum_mou", NA, NA, "text", "RNA", list(hjust = .1, overlay = TRUE),
  "overall_mouse_brain", "rank_mouse_brain", "Mouse brain", "bar", "RNA", list(palette = "blues", width = 1.5, draw_outline = FALSE),
  "label_mouse_brain", NA, NA, "text", "RNA", list(hjust = .1, overlay = TRUE),
  "overall_simulations_1_1", "rank_simulations_1_1", "Sim 1", "bar", "Simulations", list(palette = "greens", width = 1.5, draw_outline = FALSE),
  "label_simulations_1_1", NA, NA, "text", "Simulations", list(hjust = .1, overlay = TRUE),
  "overall_simulations_2", "rank_simulations_2", "Sim 2", "bar", "Simulations", list(palette = "greens", width = 1.5, draw_outline = FALSE),
  "label_simulations_2", NA, NA, "text", "Simulations", list(hjust = .1, overlay = TRUE),
  "package_score", "package_rank", "Package", "bar", "Usability", list(palette = "oranges", width = 1.5, draw_outline = FALSE),
  "package_label", NA, NA, "text", "Usability", list(hjust = .1, overlay = TRUE),
  "paper_score", "paper_rank", "Paper", "bar", "Usability", list(palette = "oranges", width = 1.5, draw_outline = FALSE),
  "paper_label", NA, NA, "text", "Usability", list(hjust = .1, overlay = TRUE),
  "time_score", "time_rank", "Time", "bar", "Scalability", list(palette = "greys", width = 1.5, draw_outline = FALSE),
  "time_label", NA, NA, "text", "Scalability", list(hjust = .1, overlay = TRUE),
  "memory_score", "memory_rank", "Memory", "bar", "Scalability", list(palette = "greys", width = 1.5, draw_outline = FALSE),
  "memory_label", NA, NA, "text", "Scalability", list(hjust = .1, overlay = TRUE)
) # tribble_end

column_info
```

As shown in the other vignettes this table includes the type of geom for each each column and how they are grouped as well as some configuration options for how they are displayed. Note that we overlay the labels for each score over the corresponding bars.

We also describe the various column groups.

```{r summary-col-groups}
column_groups <- tribble(
  ~group, ~palette, ~level1,
  "Method", "black", "Method",
  "RNA", "blues", "RNA",
  "Simulations", "greens", "Simulations",
  "Usability", "oranges", "Usability",
  "Scalability", "greys", "Scalability",
)

column_groups
```

There isn't much customisation here, we are mostly just defining the labels for each group.

### Row information

We aren't applying any grouping to the rows so the row information is very basic.

```{r summary-rows}
row_info <- data.frame(id = scib_summary_plot$id, group = NA_character_)

row_info
```

### Palettes

The palettes are mostly the default palettes, with the addition of the features, oranges and black palettes.

```{r summary-palettes}
palettes <- list(
  features = c(FULL = "#4c4c4c", HVG = "#006300"),
  blues = "Blues",
  greens = "Greens",
  oranges = rev(RColorBrewer::brewer.pal(9, "Oranges")),
  greys = "Greys",
  black = c("black", "black")
)
```

### Legends

```{r legends}
legends <- list(
  list(
    title = "Scaling",
    geom = "text",
    values = c("Scaled", "Unscaled"),
    labels = c("+", "-"),
    label_width = .5
  ),
  list(
    title = "RNA rank",
    palette = "blues",
    geom = "rect",
    labels = c("20", " ", "10", " ", "1"),
    size = c(1, 1, 1, 1, 1)
  ),
  list(
    title = "Simulations rank",
    palette = "greens",
    geom = "rect",
    labels = c("20", " ", "10", " ", "1"),
    size = c(1, 1, 1, 1, 1)
  ),
  list(
    title = "Usability rank",
    palette = "oranges",
    geom = "rect",
    labels = c("20", " ", "10", " ", "1"),
    size = c(1, 1, 1, 1, 1)
  ),
  list(
    title = "Scalability rank",
    palette = "greys",
    geom = "rect",
    labels = c("20", " ", "10", " ", "1"),
    size = c(1, 1, 1, 1, 1)
  )
)
```

### Figure

Now that we have defined everything we can make the summary figure.

```{r summary-figure, fig.width=8, fig.height=8}
funky_heatmap(
  data = scib_summary_plot,
  column_info = column_info,
  column_groups = column_groups,
  row_info = row_info,
  palettes = palettes,
  legends = legends,
  position_args = position_arguments(
    col_annot_offset = 4
  ),
  scale_column = FALSE
)
```

This isn't exactly like the original figure but it is fairly close. Most of the differences are cosmetic such as alignment of labels and the lack of fancy headings. If you compare closely to the original figure you may also notice some changes in the method ranking compared to the original figure due to small difference in the pre-processing of the raw data.

## References

[scib-website]: https://theislab.github.io/scib-reproducibility/
[scib-reproducibility]: https://github.com/theislab/scib-reproducibility