R hack to create legends for Circos heatmaps by parsing the log file

circos-legend.R

# Parse logs from circos -debug_group legend to generate heatmap legends
#
# circos_legend(
#   logfile = "logs/circos.log",
#   outdir = "figures/legends",
#   width = 4,
#   height = 1,
#   horizontal = TRUE
# )
# 
# 
# circos_legend(
#   logfile = "logs/circos.log",
#   outdir = "figures/legends",
#   width = 1,
#   height = 4,
#   horizontal = FALSE
# )

circos_legend <- function(
  logfile, 
  outdir, 
  width, 
  height, 
  horizontal = FALSE, 
  raster = FALSE, ...) {

  require("readr", quietly = TRUE)
  require("stringr", quietly = TRUE)
  require("magrittr", quietly = TRUE)
  
  stopifnot(file.exists(logfile))
  dir.create(outdir, showWarnings = FALSE, recursive = TRUE)
  
  # identify heatmap tracks
  tracks <- readr::read_lines(logfile) %>% 
    stringr::str_subset("track") %>%
    stringr::str_replace_all(fixed("inf"), "Inf") %>% 
    readr::read_delim(
      delim = " ", 
      col_names = FALSE, 
      col_types = cols(X13 = col_character()),
      trim_ws = TRUE
    )
  
  # isolate and convert useful vars
  # (names are my best guess, the format doesn't appear to be documented)
  tracks <- tracks %>%
    subset(select = paste0("X", 4:13)) %>% 
    setNames(
      c(
        "track",
        "start",
        "end",
        "width",
        "start_remap",
        "end_remap",
        "width_remap",
        "block",
        "palette",
        "color"
      )
    )
  
  tracks <- tracks %>% 
    subset(!is.infinite(start) & !is.infinite(end)) %>% 
    transform(midpoint = width / 2 + start)

  # convert to hex colors
  rgbmat <- tracks$color %>% 
    str_split_fixed(pattern = ",", n = 3) %>% 
    apply(2, as.numeric)
  
  tracks$color <- apply(rgbmat / 255, 1, function(x) rgb(x[1], x[2], x[3]))

  # create legend for reach track
  tracks <- split(tracks, tracks$track)

  for (i in seq_along(tracks)) {

    track <- tracks[[i]]
    breaks <- union(track$start, track$end)
    zmat <- t(track[, "block", drop = F])
    
    if (horizontal) {
      zmat <- t(zmat)
      x <- breaks
      y <- 1
      side <- 1
      mar <- c(3, 1, 1, 1)
      las <- 1
    } else {
      x <- 1
      y <- breaks
      side <- 2
      mar <- c(1, 3, 1, 1)
      las <- 2
    }

    outfile <- sprintf("%s/legend-track%i.pdf", outdir, i)
    message("Created ", outfile)

    pdf(outfile, width = width, height = height)
      par(mar = mar, ...)
      image(
        x = x,
        y = y,
        z = zmat,
        col = track$color,
        axes = FALSE, 
        # ylab = "", 
        # xlab = "",
        xaxs = "i", 
        yaxs = "i",
        useRaster = raster
      )
      axis(side, at = breaks, lty = 1, las = 1, lwd = 0, lwd.ticks = 1)
    dev.off()
  }
}