#' Add spectrograms onto phylogenetic trees
#'
#' \code{phylo_spectro} Add spectrograms to the tips of an objects of class phylo.
#' @param X 'selection_table', 'extended_selection_table' or data frame containing columns for sound file name
#' (sound.files), selection number (selec), and start and end time of signals (start and end).
#' 'top.freq' and 'bottom.freq' columns are optional. In addition, the data frame must include the column 'tip.label' that contains the names of the tip labels found in the tree (e.g. '\code{tree$tip.label}). This column is used to match rows and tip labels. If using an
#' 'extended_selection_table' the sound files are not required (see \code{\link{selection_table}}).
#' @param tree Object of class 'phylo' (i.e. a phylogenetic tree). Ultrametric trees may produce better results.
#' If \code{NULL} (default) then the current working directory is used. Tip labels must match the names provided in the 'tip.label' column in 'X' (see 'X' argument).
#' @param type Character string of length 1 specifying the type of phylogeny to be drawn
#' (as in \code{\link[ape]{plot.phylo}}). Only 'phylogram' (default) and 'fan' are allowed.
#' @param par.mar Numeric vector with 4 elements, default is \code{rep(1, 4)}. Specifies the number of lines
#' in inner plot margins where axis labels fall, with form c(bottom, left, top, right).
#' See \code{\link[graphics]{par}}. See 'inner.par' argument for controlling spectrogram margins.
#' @param size Numeric vector of length 1 controlling the relative size of spectrograms. Higher numbers increase the height of spectrograms. Default is 1.
#' Numbers between range \code{c(>0, Inf)} are allowed.
#' @param offset Numeric vector of length 1 controlling the space between tips and spectrograms. Default is 0.
#' @param path Character string containing the directory path where the sound files are located.
#' If \code{NULL} (default) then the current working directory is used.
#' @param ladder Character string controlling whether the phylogeny is ladderized (i.e. the internal structure of the
#' tree is reorganized to get the ladderized effect when plotted). Only 'left' of 'right' values are accepted. Default is
#' \code{NULL} (no ladderization). See \code{\link[ape]{ladderize}} for more details.
#' @param horizontal Logical. Controls whether spectrograms in a fan phylogeny are place in a horizontal position
#' \code{FALSE} or in the same angle as the tree tips. Currently only horizontal spectrograms are available.
#' @param box Logical to control if the box around spectrograms is plotted (see \code{\link[graphics]{box}}). Default is \code{TRUE}.
#' @param axis Logical to control if the Y and X axis of spectrograms are plotted (see \code{\link[graphics]{box}}). Default is \code{TRUE}.
#' @param ... Additional arguments to be passed to the internal spectrogram
#' creating function (\code{\link{spectrograms}}) or phylogeny plotting function (\code{\link[ape]{plot.phylo}}) for
#' customizing graphical output. Only rightwards phylogenies can be plotted.
#' @return A phylogenetic tree with spectrograms on tree tips is plotted in the current graphical device.
#' @family spectrogram creators
#' @seealso \code{\link{spectrograms}}, \code{\link[ape]{plot.phylo}}
#' @export
#' @name phylo_spectro
#' @details The function add the spectrograms of sounds annotated in a selection table ('X' argument) onto the tips of a phylogenetic tree.
#' The 'tip.label' column in 'X' is used to match spectrograms and tree tips. The function uses internally the \code{\link[ape]{plot.phylo}} function to plot the tree
#' and the \code{\link{spectrograms}} function to create the spectrograms. Arguments for both of these functions
#' can be provided for further customization.
#' @examples {
#' \donttest{
#' # First set empty folder
#'
#'
#' # save example sound files
#' data(list = c("Phae.long1", "Phae.long2", "Phae.long3", "lbh_selec_table"))
#' writeWave(Phae.long1, file.path(tempdir(), "Phae.long1.wav"))
#' writeWave(Phae.long2, file.path(tempdir(), "Phae.long2.wav"))
#' writeWave(Phae.long3, file.path(tempdir(), "Phae.long3.wav"))
#'
#' # set spectrogram options (can be done at the phylo_spectro() function too)
#' warbleR_options(wl = 200, ovlp = 90, flim = "frange", wav.path = tempdir())
#'
#' # subset example selection table
#' X <- lbh_selec_table[1:8, ]
#'
#' # create random tree (need ape to be installed)
#' set.seed(1)
#' tree <- ape::rtree(nrow(X))
#'
#' # Force tree to be ultrametric
#' tree <- ape::chronoMPL(tree)
#'
#' # add tip label column to example selection table (just for the sake of the example)
#' X$tip.label <- tree$tip.label
#'
#' # print phylogram with spectros
#' phylo_spectro(X = X, tree = tree, par.mar = c(0, 0, 0, 8), size = 2)
#'
#' # no margin in spectrograms and showing tip labels (higher offset)
#' phylo_spectro(X = X, tree = tree, offset = 0.1, par.mar = c(0, 0, 0, 6),
#' inner.mar = rep(0, 4), size = 2, box = FALSE, axis = FALSE)
#'
#' # print fan tree and no margin in spectrograms
#' phylo_spectro(X = X, tree = tree, offset = 0.6, par.mar = rep(3, 4),
#' inner.mar = rep(0, 4), size = 2, type = "fan", show.tip.label = FALSE, box = FALSE, axis = FALSE)
#'
#' # changing edge color and witdh
#' phylo_spectro(X = X, tree = tree, offset = 0.2, par.mar = rep(3, 4), inner.mar = rep(0, 4),
#' size = 2, type = "fan", show.tip.label = FALSE, edge.color = "red", edge.width = 2,
#' box = FALSE, axis = FALSE)
#'
#' # plotting a tree representing cross-correlation distances
#' xcorr_mat <- cross_correlation(X, bp = c(1, 10))
#'
#' xc.tree <- ape::chronoMPL(ape::as.phylo(hclust(as.dist(1 - xcorr_mat))))
#'
#' X$tip.label <- xc.tree$tip.label
#'
#' phylo_spectro(X = X, tree = xc.tree, offset = 0.03, par.mar = rep(3, 4),
#' inner.mar = rep(0, 4), size = 0.3, type = "fan", show.tip.label = FALSE,
#' edge.color = "red", edge.width = 2, box = FALSE, axis = FALSE)
#' }
#' }
#' @references {
#' Araya-Salas, M., & Smith-Vidaurre, G. (2017). warbleR: An R package to streamline analysis of animal acoustic signals. Methods in Ecology and Evolution, 8(2), 184-191.
#' }
#' @author Marcelo Araya-Salas (\email{marcelo.araya@@ucr.ac.cr})
#last modification on oct-1-2018 (MAS)
phylo_spectro <- function(X, tree, type = "phylogram", par.mar = rep(1, 4), size = 1, offset = 0,
path = NULL, ladder = NULL, horizontal = TRUE, axis = TRUE, box = TRUE, ...) {
# error message if ape is not installed
if (!requireNamespace("ape",quietly = TRUE))
stop2("must install 'ape' to use phylo_spectro()")
# error message if jpeg package is not installed
if (!requireNamespace("jpeg",quietly = TRUE))
stop2("must install 'jpeg' to use this function")
# currenlt only horizontal is allowed
if (!horizontal) message2("Currently only horizontal spectrograms are allowed")
horizontal <- TRUE
#check path if not provided set to working directory
if (is.null(path)) path <- getwd() else
if (!dir.exists(path)) stop2("'path' provided does not exist") else
path <- normalizePath(path)
## save par current setting and restores it later
opar <- par # save
on.exit(opar) # restore
#### set arguments from options
# get function arguments
argms <- methods::formalArgs(phylo_spectro)
# get warbleR options
opt.argms <- if(!is.null(getOption("warbleR"))) getOption("warbleR") else SILLYNAME <- 0
# remove options not as default in call and not in function arguments
opt.argms <- opt.argms[!sapply(opt.argms, is.null) & names(opt.argms) %in% argms]
# get arguments set in the call
call.argms <- as.list(base::match.call())[-1]
# remove arguments in options that are in call
opt.argms <- opt.argms[!names(opt.argms) %in% names(call.argms)]
# set options left
if (length(opt.argms) > 0)
for (q in seq_len(length(opt.argms)))
assign(names(opt.argms)[q], opt.argms[[q]])
# ladderize
if (!is.null(ladder)) tree <- ape::ladderize(phy = tree, right = ladder == "right")
# check tip labels match
if (!identical(sort(as.character(X$tip.label)), sort(tree$tip.label))) stop2("tree tip labels (tree$tip.label) and 'tip.label' column in 'X' do not match")
#sort X as in tip labels
X <- X[match(tree$tip.label, X$tip.label), ]
# map arguments provided
argus <- c(opt.argms, call.argms)
## SPECTROGRAMS (save in temporary directory)
# save specreator call
cll.spec <- quote(spectrograms(line = FALSE, pb = FALSE, dest.path = tempdir()))
# keep arguments in ... found in specreator
shr.args <- argus[names(argus) %in% names(formals(spectrograms))]
# add new arguments to call (if present rewrite if no add)
if (length(shr.args) > 0)
for(i in seq_len(length(shr.args)))
if( any(names(cll.spec) == names(shr.args)[i])) cll.spec[names(cll.spec) == names(shr.args)[i]] <- shr.args[[i]] else
{
cll.spec[[length(cll.spec) + 1]] <- shr.args[[i]]
names(cll.spec)[length(cll.spec)] <- names(shr.args)[i]
}
# call specreator to save jpegs in temporary directory
suppressWarnings(eval(cll.spec))
## PHYLOGENY
# keep arguments in ... found in specreator
cll.phylo <- quote(ape::plot.phylo(x = tree, direction = "rightwards"))
# keep arguments in ... found in specreator
shr.args2 <- argus[names(argus) %in% names(formals(ape::plot.phylo))]
# add new arguments to call (if present rewrite if no add)
if (length(shr.args2) > 0)
for(i in seq_len(length(shr.args2)))
if( any(names(cll.phylo) == names(shr.args2)[i])) cll.phylo[names(cll.phylo) == names(shr.args2)[i]] <- shr.args2[[i]] else
{
cll.phylo[[length(cll.phylo) + 1]] <- shr.args2[[i]]
names(cll.phylo)[length(cll.phylo)] <- names(shr.args2)[i]
}
# set graphic parameter margins
par(mar = par.mar)
# plot tree
eval(cll.phylo)
# get border coordinates
usr <- par()$usr
# plt <- par()$plt
#
# # correct for margins
# usr[2] <- usr[2] + ((usr[2] - usr[1]) * (1 - plt[2]))
# usr[1] <- usr[1] - ((usr[2] - usr[1]) * plt[1])
# y limits
plt.y.rng <- usr[4] - usr[3]
# fix size according to number of tips in tree
size <- plt.y.rng / nrow(X) * size
# get coordinates for spectrograms
lastPP <- get("last_plot.phylo", envir = ape::.PlotPhyloEnv)
xs <- lastPP$xx[1:nrow(X)]
ys <- lastPP$yy[1:nrow(X)]
# fix offset (taken from ape::tiplabels)
if (offset != 0) {
if (lastPP$type %in% c("phylogram", "cladogram")) {
switch(lastPP$direction, rightwards = {
xs <- xs + offset
}, leftwards = {
xs <- xs - offset
}, upwards = {
ys <- ys + offset
}, downwards = {
ys <- ys - offset
})
}
if (lastPP$type %in% c("fan", "radial")) {
tmp <- ape::rect2polar(xs, ys)
tmp <- ape::polar2rect(tmp$r + offset, tmp$angle)
xs <- tmp$x
ys <- tmp$y
}
}
# get degrees
dgs <- rep(0, length(xs))
# if position of not horizontal
if (!horizontal & lastPP$type %in% c("fan", "radial"))
{
# cuadrant I
dgs[xs > 0 & ys > 0] <- asin(abs(ys[xs > 0 & ys > 0])/ sqrt((xs[xs > 0 & ys > 0])^2 + (ys[xs > 0 & ys > 0])^2)) * 180 /pi
# cuadrant II
dgs[xs > 0 & ys < 0] <- asin((ys[xs > 0 & ys < 0])/ sqrt((xs[xs > 0 & ys < 0])^2 + (ys[xs > 0 & ys < 0])^2)) * 180 /pi
# cuadrant III
dgs[xs < 0 & ys < 0] <- asin(abs(ys[xs < 0 & ys < 0])/ sqrt((xs[xs < 0 & ys < 0])^2 + (ys[xs < 0 & ys < 0])^2)) * 180 /pi
# cuadrant IV
dgs[xs < 0 & ys > 0] <- (acos((xs[xs < 0 & ys > 0])/ sqrt((xs[xs < 0 & ys > 0])^2 + (ys[xs < 0 & ys > 0])^2)) * 180 /pi) + 180
}
# empty list for images
imgs <- list()
# image coordinate data frame
coors <- data.frame(xs, ys, size, dgs, asp = NA, xleft = NA, xright = NA,
ybottom = NA, ytop = NA)
# read images and calculate margins for spectrograms
for(y in 1:nrow(X)) {
# read images
imgs[[1 + length(imgs)]] <- jpeg::readJPEG(source = file.path(tempdir(), paste0(X$sound.files[y], "-", X$selec[y], ".jpeg")))
# get image dimensions
dims <- dim(imgs[[length(imgs)]])
# get image aspect
coors$asp[y] <- 1 / (dims[1] / dims[2])
# calculate image limits
# if (lastPP$type == "phylogram")
coors$xleft[y] <- coors$xs[y]
coors$xright[y] <- coors$xs[y] + size * coors$asp[y]
coors$difx[y] <- size * coors$asp[y]
coors$ybottom[y] <- coors$ys[y] - (size / 2)
coors$ytop[y] <- coors$ys[y] + (size / 2)
}
# add spectros to phylogeny
for(y in 1:nrow(X)) {
# allow to plot outside main image area
par(xpd = TRUE)
# add spectrograms
if (lastPP$type == "phylogram")
graphics::rasterImage(image = imgs[[y]], xleft = coors$xleft[y], ybottom = coors$ybottom[y], xright = coors$xleft[y] + coors$difx[y], ytop = coors$ytop[y], angle = dgs[y])
else
graphics::rasterImage(image = imgs[[y]], xleft = xs[y] - (size / 2), ybottom = ys[y] - (size / 2 * coors$asp[y]), xright = xs[y] + (size / 2), ytop = ys[y] + (size * coors$asp[y] / 2), angle = dgs[y])
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.