---
title: "Adding BioTooltipR to R Markdown reports"
output:
  rmarkdown::html_vignette:
    self_contained: true
vignette: >
  %\VignetteIndexEntry{Adding BioTooltipR to R Markdown reports}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

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

```{r setup}
library(BioTooltipR)
use_bio_tooltips(
  modules = c("gene", "chemical")
)
```

`BioTooltipR` adds small HTML spans to R Markdown output and lets the browser-side [`bio-tooltips`](https://github.com/mattjmeier/bio-tooltips) JavaScript library perform the lookup and rendering. `BioTooltipR` vendors the required browser assets, so rendered vignettes do not need to download JavaScript or CSS at build time.

## Inline prose

Genes can be included inline:

```{r inline-demo, results='asis'}
cat("The tumour suppressor ", gene_tt("TP53", species = "human"), " is central to DNA damage responses.", sep = "")
```

Chemicals can use stable identifiers:

```{r chemical-demo, results='asis'}
cat("A chemical example: ", chem_tt("aspirin", query = "2244", scope = "pubchem"), ".", sep = "")
```

## Tables

```{r table-demo, results='asis'}
top_genes <- data.frame(
  symbol = c("TP53", "BRCA1", "GADD45A"),
  log2FoldChange = c(2.1, -1.4, 1.2),
  padj = c(0.0004, 0.002, 0.01)
)

top_genes |>
  gene_column(symbol, species = "human") |>
  bt_kable(include_setup = FALSE)
```

The important detail is that HTML escaping must be disabled for the table cell containing tooltip spans. `bt_kable()` does this by default.

## Assets

`use_bio_tooltips()` uses vendored `bio-tooltips` 2.0.9, D3 7.9.0, and
Ideogram 1.53.0 browser assets by default, so building this vignette does not
download JavaScript or CSS files. D3 and Ideogram are included automatically
when the gene module is enabled because they render the gene model and
chromosome ideogram.
To use jsDelivr-hosted assets in a rendered report, opt in explicitly:

```{r cdn-demo, eval=FALSE}
use_bio_tooltips(cdn = TRUE, version = "2.0.9")
```

## Volcano plot

Interactive plotting libraries usually own their hover labels, so the most
reliable pattern is to let Plotly handle the plot hover event and update a real
HTML Bio Tooltip span next to the plot.

```{r volcano-demo, message=FALSE, warning=FALSE}
if (!requireNamespace("plotly", quietly = TRUE) ||
    !requireNamespace("htmlwidgets", quietly = TRUE)) {
  htmltools::tags$p(
    "Install the optional plotly and htmlwidgets packages to render this interactive example."
  )
} else {
set.seed(42)

volcano_genes <- c(
  "TP53", "BRCA1", "BRCA2", "EGFR", "MYC", "PTEN", "KRAS", "NRAS",
  "BRAF", "CDK1", "CCND1", "CDKN1A", "CDKN2A", "MDM2", "RB1", "ATM",
  "ATR", "CHEK1", "CHEK2", "GADD45A", "VEGFA", "HIF1A", "IL6", "TNF",
  "CXCL8", "STAT3", "JAK2", "AKT1", "MTOR", "PIK3CA", "FOXO3", "ESR1",
  "AR", "ERBB2", "MET", "ALK", "ROS1", "NTRK1", "RET", "APC",
  "CTNNB1", "SMAD4", "TGFB1", "MMP2", "MMP9", "COL1A1", "COL3A1",
  "FN1", "VIM", "CDH1", "EPCAM", "SOX2", "NANOG", "POU5F1", "MKI67",
  "AURKA", "TOP2A", "BCL2", "BAX"
)

set.seed(42)

n <- length(volcano_genes)

# Most genes are unchanged; a minority have a real effect.
is_de <- rbinom(n, size = 1, prob = 0.18)

true_lfc <- ifelse(
  is_de == 1,
  sample(c(-1, 1), n, replace = TRUE) *
    pmax(0.5, rnorm(n, mean = 1.25, sd = 0.45)),
  0
)

# Different genes have different measurement precision.
# This is important: it prevents significance from being a simple
# deterministic function of fold change.
se <- exp(rnorm(n, mean = log(0.38), sd = 0.35))

# Observed fold change.
log2FoldChange <- true_lfc + rnorm(n, mean = 0, sd = se)

volcano <- data.frame(
  symbol = volcano_genes,
  log2FoldChange = log2FoldChange,
  se = se
)

# Keep a few visually interesting, recognizable genes.
interesting <- data.frame(
  symbol = c(
    "MYC", "EGFR", "VEGFA", "IL6", "MMP9", "MKI67",
    "TP53", "BRCA1", "CDKN1A", "PTEN", "CDH1", "BAX"
  ),
  log2FoldChange = c(
     2.6,  1.9,  1.7,  2.2,  1.5,  2.9,
    -2.1, -1.8, -1.4, -1.7, -2.4, -1.3
  ),
  se = c(
    0.46, 0.45, 0.52, 0.48, 0.52, 0.50,
    0.46, 0.48, 0.46, 0.50, 0.45, 0.48
  )
)

idx <- match(interesting$symbol, volcano$symbol)

volcano$log2FoldChange[idx] <- interesting$log2FoldChange
volcano$se[idx] <- interesting$se

# Wald-like significance test.
volcano$statistic <- volcano$log2FoldChange / volcano$se
volcano$pvalue <- 2 * pnorm(-abs(volcano$statistic))
volcano$padj <- p.adjust(volcano$pvalue, method = "BH")

volcano$neg_log10_padj <- -log10(volcano$padj)
volcano$direction <- ifelse(
  volcano$padj < 0.05 & volcano$log2FoldChange >= 1,
  "Up-regulated",
  ifelse(
    volcano$padj < 0.05 & volcano$log2FoldChange <= -1,
    "Down-regulated",
    "Not significant"
  )
)
volcano$direction <- factor(
  volcano$direction,
  levels = c("Up-regulated", "Down-regulated", "Not significant")
)
volcano$label <- ifelse(volcano$symbol %in% interesting$symbol, volcano$symbol, "")

volcano_plot <- plotly::plot_ly(
  volcano,
  x = ~log2FoldChange,
  y = ~neg_log10_padj,
  key = ~symbol,
  type = "scatter",
  mode = "markers+text",
  text = ~label,
  textposition = "top center",
  color = ~direction,
  colors = c(
    "Up-regulated" = "#b91c1c",
    "Down-regulated" = "#2563eb",
    "Not significant" = "#7a7f87"
  ),
  marker = list(size = 9, opacity = 0.82, line = list(width = 0)),
  textfont = list(size = 10, color = "#24292f")
) |>
  plotly::layout(
    xaxis = list(title = "log2 fold change", zeroline = TRUE),
    yaxis = list(title = "-log10 adjusted p-value"),
    legend = list(orientation = "h", x = 0, y = 1.12),
    margin = list(t = 60),
    shapes = list(
      list(type = "line", x0 = -1, x1 = -1, y0 = 0, y1 = 4.6,
           line = list(color = "#b7bdc5", width = 1, dash = "dot")),
      list(type = "line", x0 = 1, x1 = 1, y0 = 0, y1 = 4.6,
           line = list(color = "#b7bdc5", width = 1, dash = "dot")),
      list(type = "line", x0 = -3.2, x1 = 3.2, y0 = -log10(0.05), y1 = -log10(0.05),
           line = list(color = "#b7bdc5", width = 1, dash = "dot"))
    )
  )

bt_plotly_gene_hover(volcano_plot, species = "human", include_setup = FALSE)
}
```

Plotly still owns the hover event, but its default hover card is suppressed.
`bt_plotly_gene_hover()` reads the gene symbol from Plotly's `key` field and
updates a tiny fixed-position Bio Tooltip span at the cursor.

## Experimental auto-linking

If prose is already rendered, `auto_gene_tooltips()` can wrap a supplied
vocabulary of gene symbols in a constrained selector. This should be used
carefully because some gene symbols are ordinary words.

The following sentence is ordinary Markdown rather than a collection of calls
to `gene_tt()`. Hover over a mouse gene symbol to see the auto-linking in
action.

::: {.auto-link-demo}
In mouse, Trp53 and Brca1 help maintain genome integrity, while Gadd45a is
involved in the response to DNA damage.
:::

```{r auto-demo}
auto_gene_tooltips(
  genes = c("Trp53", "Brca1", "Gadd45a"),
  species = "mouse",
  selector = ".auto-link-demo",
  include_setup = FALSE
)
```

Using a dedicated selector keeps the scan inside this example. The
mouse-specific vocabulary also avoids matching the human gene symbols used in
earlier sections of the vignette.
