Using thhe {ggiraph} package to customize tooltips to explain modeling results!
Published
July 20, 2025
Introduction
For work, I often explain scientific modeling results to collaborators by leveraging interactive tooltips from the {ggiraph} package. One thing I haven’t done yet is incorporate an actual table in a tooltip. Especially if showing an odds ratio derived from a 2x2 table, showing the actual observed counts can be extremely helpful for explaining whether the result is scientifically meaningful!
Data
As in my last post, I will be using pediatric drug safety data (adverse drug events or ADEs). Specially, odds ratios on observed drug safety signal between drugs, adverse events, and classes of each. These enrichments are within each child development stage in which the counts were observed.
data |> dplyr::relocate(a,b,c,d,nichd,odds_ratio, atc_concept_name, meddra_concept_name) |>head() |> DT::datatable()
Goal
The ultimate goal of this post is to create an interactive volcano plot of odds ratio vs. -log10(p-value) with a tooltip showing a 2x2 table of the observed counts. To get there, I need to:
Create a (vectorized) function to create a 2x2 table
Write code to create a tooltip showing the 2x2 table with the odds ratio and -log10(p-value)
Create a function that outputs the interactive volcano plot of odds ratio vs. -log10(p-value) with a tooltip showing a 2x2 table of the observed counts. I may also color points by the development stage category of enrichment i.e. if the enrichment was between a. certain class of drugs and a certai class of adverse events.
A (vectorized) function to create a 2x2 table
This function was created with help from claude.ai
Code
#' Create a 2x2 contingency table with odds calculation (vectorized for mutate)#' #' @param a numeric vector - top-left cell values#' @param b numeric vector - top-right cell values #' @param c numeric vector - bottom-left cell values#' @param d numeric vector - bottom-right cell values#' @param row_names character vector of length 2 - row header names (default: c("Row 1", "Row 2"))#' @param col_names character vector of length 2 - column header names (default: c("Col 1", "Col 2"))#' @param table_title character - title for the table (default: "2x2 Contingency Table with Odds")#' #' @return gt table object with vectorized input data and calculated odds#' #' @examples#' df = data.frame(#' study = c("Study 1", "Study 2", "Study 3"),#' a = c(10, 8, 12),#' b = c(20, 12, 18),#' c = c(5, 6, 4),#' d = c(15, 10, 16)#' )#' #' df |> #' dplyr::mutate(#' odds_table = purrr::pmap(#' list(a,b,c,d),function(a,b,c,d){#' create_odds_table(#' a,b,c,d,#' row_names = c("Exposed", "Not Exposed"),#' col_names = c("Case", "Control"))#' }#' )#' )create_odds_table <-function(a, b, c, d, row_names =c("Row 1", "Row 2"),col_names =c("Col 1", "Col 2"),table_title ="2x2 Contingency Table with Odds") {stopifnot(length(a)==length(b) &length(b)==length(c) &length(c)==length(d) &length(d)==1)# Calculate odds for all values odds <- (a * d) / (b * c) odds_rounded <-as.character(round(odds, 2))# Create a single table with all the vectorized data table_data <-data.frame(Variable =c(row_names[1], row_names[2], "Odds Ratio"),Col1 =c(a, c, paste0("(", a, " × ", d, ") / (", b, " × ", c, ")")),Col2 =c(b, d, odds_rounded),stringsAsFactors =FALSE )# Set column namesnames(table_data)[2:3] <- col_names# Create gt table gt_table <- table_data |> gt::gt() |> gt::tab_header(title = table_title) |> gt::tab_style(style = gt::cell_text(weight ="bold"),locations = gt::cells_column_labels() ) |> gt::tab_style(style = gt::cell_text(weight ="bold"),locations = gt::cells_body(columns =1) ) |> gt::cols_align(align ="center",columns =2:3 )# Add styling for odds ratio rows gt_table <- gt_table |> gt::tab_style(style =list( gt::cell_fill(color ="lightgray"), gt::cell_text(weight ="bold") ),locations = gt::cells_body(rows =3) ) |> gt::tab_footnote(footnote =paste0("Odds Ratio = ", odds_rounded, " (calculated as (a×d)/(b×c))"),locations = gt::cells_body(columns =2, rows =3) )return(gt_table)}
Very cool. I need to ensure the raw html is added to the tooltip column rowwise because gt::as_raw_html doesn’t take a list as created in the dplyr operations.
A function for an interactive volcano plot with a 2x2 table in the tooltip
This function will output an interactive volcano plot with the 2x2 table in the tooltip. I’ll also include the drug and adverse event (class) from the enrichment with the pvalue. Addingthe. tooltip is slow since it needs to be added rowwise - so for this post I’ll just sample n rows. I’ll add some nice CSS too.
Code
generate_ivolcanoplot <-function(n =50){ p <- data |> dplyr::slice_sample(n = n) |> dplyr::rowwise() |> dplyr::mutate(odds_table = purrr::pmap(list(a,b,c,d),function(a,b,c,d){create_odds_table( a,b,c,d,row_names =c("Significant ADE Reports", "Non-Significant Reports"),col_names =c("ADE", "Not ADE"),table_title = stringr::str_glue(" {ifelse(atc_concept_name=='','',paste0(atc_concept_name,' and '))} {meddra_concept_name} in {nichd} " ) ) }),tooltip = stringr::str_glue(" {gt::as_raw_html(odds_table)} ") ) |> dplyr::ungroup() |>ggplot(aes(odds_ratio,-log10(pvalue),fill = nichd, tooltip = tooltip)) + ggiraph::geom_point_interactive(size =5,pch =21) +scale_fill_brewer() +guides(fill =guide_legend(title="Development Stage")) +theme_minimal() +labs(x ="Odds Ratio", y ="-log10(P-value)",title ="Enrichment of Drug Safety Signals") p}