Make plots interactive

[RHReynolds]

Given just how much information can be gleaned from these plots it would be incredibly useful if plots could be interactive (to allow for zooming, moving along a transcript structure, etc.). plotly enables some ggplot2 geoms to be made interactive via ggplotly(), however, as ggtranscript introduces new geoms these are not implemented.

[dzhang32]

I agree, this would be super useful.

From a quick google, it looks like there's a list of ggplot2 extensions that are planned to undergo integration with ggplotly().

From plotly's book this integration looks to be trivial for some extensions, whilst being more complex for others.

My hope is that most of ggtranscript geoms (other than geom_junction_label_repel) will land on the trivial side. I'll test this and keep you updated.

[mpage21]

I'm curious about the progress on this. @dzhang32 is this still something that is actively being pursued?

[dzhang32]

No, unfortunately I didn't get time to work on this whilst developing ggtranscript - I've since moved on to another job.

Would welcome any contributions! :)

[mebbert]

Hello,

We've been toying with this a bit. It's not a full port of ggtranscript to plotly code, but wanted to share a baseline. If we continue down this path, we will share further updates and code, but probably won't ever convert it to a full-on package or pull request.

Basically, I asked my "friend" to help me convert this to plotly. To be fair, my "friend" did most of the work, other than I was there to criticize them when they made a mistake. My "friend" will remain nameless, but their initials are C. GPT. :-P

Together, and in only 1/2 hour of effort, we were able to reproduce the example plot from the ggtranscript readme.

Here is a screenshot of the plot:

Here is the code:

library(plotly)
library(dplyr)
library(ggtranscript)

sod1_annotation %>% head()
# extract exons
sod1_exons <- sod1_annotation %>% dplyr::filter(type == "exon")

# Assuming sod1_exons is already defined
# Calculate introns
sod1_introns <- sod1_exons %>%
  arrange(transcript_name, start) %>%
  group_by(transcript_name) %>%
  summarize(
    start = lead(start) - 1,  # Start of intron is the end of the previous exon + 1
    end = lag(end) + 1,  # End of intron is the start of the next exon - 1
    strand = first(strand),
    .groups = 'drop'
  ) %>%
  filter(!is.na(start) & !is.na(end))  # Remove NA rows which may result from lead/lag

# Example of creating a color mapping for transcript_biotype
unique_biotype <- unique(sod1_exons$transcript_biotype)
colors <- c("protein_coding" = "#00BFC4", "processed_transcript" = "#F8766D") # Extend as needed

# Ensure all biotypes are covered
biotype_colors <- setNames(colors[unique_biotype], unique_biotype)

# Create a numeric factor for y-axis placement based on transcript names
sod1_exons$y_numeric <- as.numeric(factor(sod1_exons$transcript_name))
sod1_introns$y_numeric <- as.numeric(factor(sod1_introns$transcript_name, levels = levels(factor(sod1_exons$transcript_name))))

# Prepare y-axis numeric mapping for transcript names
transcript_levels <- unique(sod1_exons$transcript_name)
sod1_exons$y_numeric <- match(sod1_exons$transcript_name, transcript_levels)
sod1_introns$y_numeric <- match(sod1_introns$transcript_name, transcript_levels)

shapes <- list()

# Add exon shapes with color based on transcript_biotype
for(i in 1:nrow(sod1_exons)) {
  exon <- sod1_exons[i, ]
  shapes[[length(shapes) + 1]] <- list(
    type = "rect",
    x0 = exon$start, x1 = exon$end,
    y0 = exon$y_numeric - 0.3, y1 = exon$y_numeric + 0.3,
    fillcolor = biotype_colors[exon$transcript_biotype],
    line = list(color = "black")
  )
}

# Intron lines
for(i in 1:nrow(sod1_introns)) {
  intron <- sod1_introns[i, ]
  shapes[[length(shapes) + 1]] <- list(
    type = "line",
    x0 = intron$start, x1 = intron$end,
    y0 = intron$y_numeric, y1 = intron$y_numeric,
    line = list(color = "grey", width = 1)
  )
}

# Initialize Plotly plot with a dummy scatter trace
p <- plot_ly() %>%
  add_trace(type = 'scatter', mode = 'markers', x = NA, y = NA, marker = list(opacity = 0)) %>%
  layout(
    title = "Genomic Features Visualization",
    shapes = shapes,
    yaxis = list(
      title = "Transcripts",
      tickmode = "array",
      tickvals = 1:length(unique(sod1_exons$transcript_name)), # Ensure these are correctly defined
      ticktext = unique(sod1_exons$transcript_name)
    ),
    xaxis = list(title = "Genomic Position")
  )

p