R/plotting.R

# Convenience plotting scripts

#=========================================================================>
# Helper functions

#------------------------------------------------------------------------
#' Generate colour from wavelength
#'
#' Approximates colour of visual light spectrum.
#
#' @param wavelengths A vector of wavelengths (nm) between 300 and 800.
#
#' @return A vector of colours in hex code notation.
#' @export
#'
calculate_colours <- function(wavelengths) {

  colours <- c('black', 'darkviolet', 'blue', 'green', 
         'yellow', 'orange', 'red', 'black')
  x <- c(300, 415, 472.5, 527.5, 580, 605, 685, 800)
  x.break <- c(380, 450, 495, 570, 590, 620, 750)

  colours.rgb <- col2rgb(colours)
  index <- 1:(length(colours) - 1)
  colours.rgb.break <- (colours.rgb[, index + 1] + colours.rgb[, index])/2

  x.i <- c(x, x.break)
  colours.i <- cbind(colours.rgb, colours.rgb.break)

  r.out <- approx(x.i, colours.i[1, ], xout = wavelengths)$y
  g.out <- approx(x.i, colours.i[2, ], xout = wavelengths)$y
  b.out <- approx(x.i, colours.i[3, ], xout = wavelengths)$y

  out <- rgb(r = r.out, g = g.out, b = b.out, maxColorValue = 255)
  return(out)
}

#=========================================================================>
# Plotting functions

#------------------------------------------------------------------------
#' Plot emission and excitation spectra.
#'
#' Generates a ggplot2 plot with an overview of excitation and 
#' emission spectra.
#
#' @param wavelengths A vector of wavelengths (nm).
#' @param excitations A vector of excitation intensities.
#' @param emissions A vector of emmision intensities.
#' @param proteins A vector of protein labels that correspond to each
#'                 measurement.
#' @param lasers Optional vector of lasers to highlight e.g. c(488, 642)
#' @param channels Optional vector of channels to highlight 
#'                e.g. c('530/30', '670LP').
#' @param palette Name of colorbrewer palette for discrete scale (if NA,
#'                spectra are coloured by emission wavelength.
#' @param background.alpha Transparency value for channel highlight. 
#
#' @return ggplot2 plot object.
#' @export
#'
plot_spectra <- function(wavelengths, excitations, emissions, proteins, 
                         lasers = NA, channels = NA, palette = NA,
                         background.alpha = 0.1) {

  # Generating dataframe 
  d <- data.frame(protein = proteins, wavelength = wavelengths, 
                  excitation = excitations, emission = emissions)

  # Scaling colours
  d.max <- d %>%
             group_by(protein) %>%
             summarize(wavelength = wavelength[emission == max(emission)]) %>%
             arrange(wavelength)

  # Ordering factors
  d$protein <- factor(as.character(d$protein), 
                      levels = as.character(d.max$protein))

  ranges <- calculate_ranges(channels, min(wavelengths), max(wavelengths))
  
  # Plotting
  p <- ggplot(d)
  p <- p + coord_fixed(ratio = 200)

  for (i in 1:length(ranges)) {
    p <- p + annotate('rect', xmin = ranges[[i]][1], xmax = ranges[[i]][2],
                       ymin = -Inf, ymax = Inf,  
                       fill = calculate_colours(mean(ranges[[i]])),
                       colour = 'black', linetype = 2,
                       alpha = background.alpha)
  }

  for (i in 1:length(lasers)) {
    p <- p + geom_vline(xintercept = lasers[i], 
                        colour = calculate_colours(lasers[i]))
  }

  p <- p + geom_line(aes(x = wavelength, y = emission, colour = protein), 
                     linetype = 1)
  p <- p + geom_line(aes(x = wavelength, y = excitation, colour = protein),
                     linetype = 2)

  if (is.na(palette)) {
    values <- calculate_colours(d.max$wavelength)
    names(values) <- d.max$protein
    p <- p + scale_colour_manual(values = values)
  } else {
    p <- p + scale_colour_brewer(palette = palette)
  }

  p <- p + theme_bw(18)

  return(p)
}

#------------------------------------------------------------------------
#' Plot emission spectra as excited by specified laser.
#'
#' Generates a ggplot2 with emission spectra generated by specified laser. 
#
#' @param wavelengths A vector of wavelengths (nm).
#' @param excitations A vector of excitation intensities.
#' @param emissions A vector of emmision intensities.
#' @param proteins A vector of protein labels that correspond to each
#'                 measurement.
#' @param lasers Vector of lasers exciting given proteins e.g. c(488, 642)
#' @param channels Optional vector of channels to highlight 
#'                e.g. c('530/30', '670LP').
#' @param palette Name of colorbrewer palette for discrete scale (if NA,
#'                spectra are coloured by emission wavelength.
#' @param size Line size for emission spectra.
#' @param background.alpha Transparency value for channel highlight. 
#
#' @return ggplot2 plot object.
#' @export
#'
plot_emissions <- function(wavelengths, excitations, emissions, proteins, 
                           lasers, channels = NA, palette = NA, size = 2, 
                           background.alpha = 0.1) {

  # Generating dataframe and scaling by excitation 
  d <- data.frame(protein = proteins, wavelength = wavelengths, 
                  excitation = excitations, emission = emissions)

  f_scale <- function(wavelengths, excitations, emissions, laser) {
    f_excitation <- splinefun(wavelengths, excitations)
    emissions <- emissions * sum(f_excitation(lasers))/max(excitations)
  }

  d <- d %>%
         group_by(protein) %>%
         mutate(emission = f_scale(wavelength, excitation, emission, laser))

  # Scaling colours
  d.max <- d %>%
             group_by(protein) %>%
             summarize(wavelength = wavelength[emission == max(emission)]) %>%
             arrange(wavelength)

  # Ordering factors
  d$protein <- factor(as.character(d$protein), 
                      levels = as.character(d.max$protein))

  ranges <- calculate_ranges(channels, min(wavelengths), max(wavelengths))
  
  # Plotting
  p <- ggplot(d, aes(x = wavelength, y = emission, colour = protein))
  p <- p + coord_fixed(ratio = 200)

  for (i in 1:length(ranges)) {
    p <- p + annotate('rect', xmin = ranges[[i]][1], xmax = ranges[[i]][2],
                       ymin = -Inf, ymax = Inf,  
                       fill = calculate_colours(mean(ranges[[i]])),
                       colour = 'black', linetype = 2,
                       alpha = background.alpha)
  }

  for (i in 1:length(lasers)) {
    p <- p + geom_vline(xintercept = lasers[i], 
                        colour = calculate_colours(lasers[i]))
  }

  p <- p + geom_line(size = size)

  if (is.na(palette)) {
    values <- calculate_colours(d.max$wavelength)
    names(values) <- d.max$label
    p <- p + scale_colour_manual(values = values)
  } else {
    p <- p + scale_colour_brewer(palette = palette)
  }

  p <- p + theme_bw(18)

  return(p)
}
ssokolen/fluoroscripts documentation built on May 30, 2019, 8:43 a.m.