Nothing
#' Spectrograms of selected signals
#'
#' \code{spectrograms} creates spectrograms of signals from selection tables.
#' @usage spectrograms(X, wl = 512, flim = "frange", wn = "hanning", pal = reverse.gray.colors.2,
#' ovlp = 70, inner.mar = c(5, 4, 4, 2), outer.mar = c(0, 0, 0, 0), picsize = 1, res = 100,
#' cexlab = 1, propwidth = FALSE, xl = 1, osci = FALSE, gr = FALSE, sc = FALSE, line = TRUE,
#' col = "#07889B", fill = adjustcolor("#07889B", alpha.f = 0.15), lty = 3,
#' mar = 0.05, it = "jpeg", parallel = 1, path = NULL, pb = TRUE, fast.spec = FALSE,
#' by.song = NULL, sel.labels = "selec", title.labels = NULL, dest.path = NULL,
#' box = TRUE, axis = TRUE, ...)
#' @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. If using an
#' 'extended_selection_table' the sound files are not required (see \code{\link{selection_table}}).
#' @param wl A numeric vector of length 1 specifying the window length of the spectrogram, default
#' is 512.
#' @param flim A numeric vector of length 2 for the frequency limit (in kHz) of
#' the spectrogram, as in \code{\link[seewave]{spectro}}. The function also
#' accepts 'frange' (default) which produces spectrograms with a frequency
#' limit around the range of each signal (adding a 1 kHz margin).
#' @param wn Character vector of length 1 specifying window name. Default is
#' "hanning". See function \code{\link[seewave]{ftwindow}} for more options.
#' @param pal A color palette function to be used to assign colors in the
#' plot, as in \code{\link[seewave]{spectro}}. Default is reverse.gray.colors.2.
#' @param ovlp Numeric vector of length 1 specifying the percent overlap between two
#' consecutive windows, as in \code{\link[seewave]{spectro}}. Default is 70.
#' @param inner.mar Numeric vector with 4 elements, default is c(5,4,4,2).
#' Specifies number of lines in inner plot margins where axis labels fall,
#' with form c(bottom, left, top, right). See \code{\link[graphics]{par}}.
#' @param outer.mar Numeric vector with 4 elements, default is c(0,0,0,0).
#' Specifies number of lines in outer plot margins beyond axis labels, with
#' form c(bottom, left, top, right). See \code{\link[graphics]{par}}.
#' @param picsize Numeric argument of length 1. Controls relative size of
#' spectrogram. Default is 1. Ignored when propwidth is \code{TRUE}.
#' @param res Numeric argument of length 1. Controls image resolution.
#' Default is 100 (faster) although 300 - 400 is recommended for publication/
#' presentation quality.
#' @param cexlab Numeric vector of length 1 specifying the relative size of axis
#' labels. See \code{\link[seewave]{spectro}}.
#' @param propwidth Logical argument to scale the width of spectrogram
#' proportionally to duration of the selection. Default is \code{FALSE}.
#' @param xl Numeric vector of length 1. A constant by which to scale
#' spectrogram width if propwidth = \code{TRUE}. Default is 1.
#' @param osci Logical argument to add an oscillogram underneath spectrogram, as
#' in \code{\link[seewave]{spectro}}. Default is \code{FALSE}.
#' @param gr Logical argument to add grid to spectrogram. Default is \code{FALSE}.
#' @param sc Logical argument to add amplitude scale to spectrogram, default is
#' \code{FALSE}.
#' @param line Logical argument to add lines at start and end times of selection
#' (or box if bottom.freq and top.freq columns are provided). Default is \code{TRUE}.
#' @param col Color of 'line'. Default is "#07889B".
#' @param fill Fill color of box around selections. Default is \code{adjustcolor("#07889B", alpha.f = 0.15)}.
#' @param lty Type of 'line' as in \code{\link[graphics]{par}}. Default is 1.
#' @param mar Numeric vector of length 1. Specifies the margins adjacent to the start and end points of selections,
#' dealineating spectrogram limits. Default is 0.05.
#' @param it A character vector of length 1 giving the image type to be used. Currently only
#' "tiff" and "jpeg" are admitted. Default is "jpeg".
#' @param parallel Numeric. Controls whether parallel computing is applied.
#' It specifies the number of cores to be used. Default is 1 (i.e. no parallel computing).
#' @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 pb Logical argument to control progress bar. Default is \code{TRUE}.
#' @param fast.spec Logical. If \code{TRUE} then image function is used internally to create spectrograms,
#' which substantially increases performance (much faster), although some options become unavailable,
#' as collevels, and sc (amplitude scale). This option is indicated for signals with high background noise
#' levels. Palette colors \code{\link[monitoR:specCols]{gray.1}}, \code{\link[monitoR:specCols]{gray.2}},
#' \code{\link[monitoR:specCols]{gray.3}}, \code{\link[monitoR:specCols]{topo.1}} and \code{\link[monitoR:specCols]{rainbow.1}}
#' (which should be imported from the package monitoR) seem to work better with 'fast' spectrograms.
#' Palette colors \code{\link[monitoR:specCols]{gray.1}}, \code{\link[monitoR:specCols]{gray.2}}, \code{\link[monitoR:specCols]{gray.3}}
#' offer decreasing darkness levels.
#' @param by.song Character string with the column name containing song labels. If
#' provide a single spectrogram containing all elements for each song will be produce. Note that
#' the function assumes that each song has a unique label within a sound file. If \code{NULL} (default), spectrograms are produced for single selections.
#' @param sel.labels Character string with the name of the column(s) for selection
#' labeling. Default is 'selec'. Set to \code{NULL} to remove labels.
#' @param title.labels Character string with the name(s) of the column(s) to use as title. Default is \code{NULL} (no title). Only sound file and song included if 'by.song' is provided.
#' @param dest.path Character string containing the directory path where the image files will be saved.
#' If \code{NULL} (default) then the folder containing the sound files will be used instead.
#' @param box Logical to control if the box around the spectrogram is plotted (see \code{\link[graphics]{box}}). Default is \code{TRUE}.
#' @param axis Logical to control if the Y and X axis are of the spectrogram are plotted (see \code{\link[graphics]{box}}). Default is \code{TRUE}.
#' @param ... Additional arguments to be passed to the internal spectrogram
#' creating function for customizing graphical output. The function is a modified
#' version of \code{\link[seewave]{spectro}}, so it takes the same arguments.
#' @return Image files containing spectrograms of the signals listed in the input data frame.
#' @family spectrogram creators
#' @seealso \code{\link{track_freq_contour}} for creating spectrograms to visualize
#' frequency measurements by \code{\link{spectro_analysis}}, \code{\link{snr_spectrograms}} for
#' creating spectrograms to optimize noise margins used in \code{\link{sig2noise}}
#' @export
#' @name spectrograms
#' @details This function provides access to batch process of (a modified version of) the \code{\link[seewave]{spectro}} function from the 'seewave' package. The function creates spectrograms for visualization of vocalizations.
#' Setting inner.mar to c(4,4.5,2,1) and outer.mar to c(4,2,2,1) works well when picsize = 2 or 3.
#' Title font size, inner.mar and outer.mar (from mar and oma) don't work well when osci or sc = TRUE,
#' this may take some optimization by the user. Setting 'fast' argument to TRUE significantly increases speed, although
#' some options become unavailable, as collevels, and sc (amplitude scale). This option is indicated for signals with
#' high background noise levels.
#' @examples
#' {
#' # load and save data
#' data(list = c("Phae.long1", "Phae.long2", "lbh_selec_table"))
#' writeWave(Phae.long1, file.path(tempdir(), "Phae.long1.wav")) # save sound files
#' writeWave(Phae.long2, file.path(tempdir(), "Phae.long2.wav"))
#'
#' # make spectrograms
#' spectrograms(
#' X = lbh_selec_table, flim = c(0, 11), res = 300, mar = 0.05,
#' wl = 300, path = tempdir()
#' )
#'
#' # check this folder
#' tempdir()
#' }
#'
#' @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}) and Grace Smith Vidaurre
# last modification on mar-13-2018 (MAS)
spectrograms <-
function(X,
wl = 512,
flim = "frange",
wn = "hanning",
pal = reverse.gray.colors.2,
ovlp = 70,
inner.mar = c(5, 4, 4, 2),
outer.mar = c(0, 0, 0, 0),
picsize = 1,
res = 100,
cexlab = 1,
propwidth = FALSE,
xl = 1,
osci = FALSE,
gr = FALSE,
sc = FALSE,
line = TRUE,
col = "#07889B",
fill = adjustcolor("#07889B", alpha.f = 0.15),
lty = 3,
mar = 0.05,
it = "jpeg",
parallel = 1,
path = NULL,
pb = TRUE,
fast.spec = FALSE,
by.song = NULL,
sel.labels = "selec",
title.labels = NULL,
dest.path = NULL,
box = TRUE,
axis = TRUE,
...) {
#### set arguments from options
# get function arguments
argms <- methods::formalArgs(spectrograms)
# 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]])
}
}
# check path to working directory
if (is.null(path)) {
path <- getwd()
} else if (!dir.exists(path)) {
stop("'path' provided does not exist")
} else {
path <- normalizePath(path)
}
# check dest.path to working directory
if (is.null(dest.path)) {
dest.path <- path
} else if (!dir.exists(dest.path)) {
stop("'dest.path' provided does not exist")
} else {
dest.path <- normalizePath(dest.path)
}
# if X is not a data frame
if (!any(
is.data.frame(X),
is_selection_table(X),
is_extended_selection_table(X)
)) {
stop("X is not of a class 'data.frame', 'selection_table' or 'extended_selection_table'")
}
if (!all(c(
"sound.files", "selec",
"start", "end"
) %in% colnames(X))) {
stop(paste(paste(
c("sound.files", "selec", "start", "end")[!(c(
"sound.files", "selec",
"start", "end"
) %in% colnames(X))],
collapse = ", "
), "column(s) not found in data frame"))
}
# check song and element label
if (!is.null(by.song)) {
if (!any(names(X) == by.song)) {
stop("'by.song' not found")
}
}
if (!is.null(sel.labels)) {
if (!any(names(X) %in% sel.labels)) {
stop("'sel.labels' not found")
}
}
# if there are NAs in start or end stop
if (any(is.na(c(X$end, X$start)))) {
stop("NAs found in start and/or end")
}
# if end or start are not numeric stop
if (any(!is(X$end, "numeric"), !is(X$start, "numeric"))) {
stop("'start' and 'end' must be numeric")
}
# if any start higher than end stop
if (any(X$end - X$start <= 0)) {
stop(paste(
"The start is higher than or equal to the end in",
length(which(X$end - X$start <= 0)),
"case(s)"
))
}
if (flim[1] != "frange") {
if (!is.vector(flim)) {
stop("'flim' must be a numeric vector of length 2")
} else if (!length(flim) == 2) {
stop("'flim' must be a numeric vector of length 2")
}
# add bottom and top freq if not included
if (!is.null(flim[1])) {
# top minus 1 kHz
if (is.null(X$bottom.freq)) {
X$bottom.freq <- flim[1] - 1
}
# top plus 1 kHz
if (is.null(X$top.freq)) {
X$top.freq <- flim[2] + 1
}
} else {
# negative bottom so bottom line is not plotted
if (is.null(X$bottom.freq)) {
X$bottom.freq <- -1
}
# if no top freq then make it 501 kHz (which is half the highest sampling rate (1 million) + 1)
if (is.null(X$top.freq)) {
X$top.freq <- 501
}
}
} else {
if (!any(names(X) == "bottom.freq") &
!any(names(X) == "top.freq")) {
stop("'flim' = frange requires bottom.freq and top.freq columns in X")
}
if (any(is.na(c(X$bottom.freq, X$top.freq)))) {
stop("NAs found in bottom.freq and/or top.freq")
}
if (any(c(X$bottom.freq, X$top.freq) < 0)) {
stop("Negative values found in bottom.freq and/or top.freq")
}
if (any(X$top.freq - X$bottom.freq <= 0)) {
stop("top.freq should be higher than bottom.freq")
}
}
# if it argument is not "jpeg" or "tiff"
if (!any(it == "jpeg", it == "tiff")) {
stop(paste("Image type", it, "not allowed"))
}
# error if not title.labels character
if (!is.character(title.labels) &
!is.null(title.labels)) {
stop("'title.labels' must be a character string")
}
# missing label columns
if (!all(title.labels %in% colnames(X))) {
stop(paste(
paste(title.labels[!(title.labels %in% colnames(X))], collapse = ", "),
"label column(s) not found in data frame"
))
}
# return warning if not all sound files were found
if (!is_extended_selection_table(X)) {
recs.wd <-
list.files(
path = path,
pattern = "\\.wav$|\\.wac$|\\.mp3$|\\.flac$",
ignore.case = TRUE
)
if (length(unique(X$sound.files[(X$sound.files %in% recs.wd)])) != length(unique(X$sound.files))) {
(paste(
length(unique(X$sound.files)) - length(unique(X$sound.files[(X$sound.files %in% recs.wd)])),
"sound file(s) not found"
))
}
# count number of sound files in working directory and if 0 stop
d <- which(X$sound.files %in% recs.wd)
if (length(d) == 0) {
stop("The sound files are not in the working directory")
} else {
X <- X[d, , drop = FALSE]
}
}
if (propwidth) {
picsize <- 1
}
# If parallel is not numeric
if (!is.numeric(parallel)) {
stop("'parallel' must be a numeric vector of length 1")
}
if (any(!(parallel %% 1 == 0), parallel < 1)) {
stop("'parallel' should be a positive integer")
}
# by song
if (!is.null(by.song)) {
Y <- X
X <- song_analysis(
X = Y,
song_colm = by.song,
pb = FALSE
)
X$selec <- 1
# fix extended selection table again
if (warbleR::is_extended_selection_table(Y)) {
X <- fix_extended_selection_table(X, Y, to.by.song = TRUE)
}
}
# create function to run within Xapply functions downstream
specreFUN <-
function(X,
Y,
i,
mar,
flim,
xl,
picsize,
res,
wl,
ovlp,
cexlab,
by.song,
sel.labels,
pal,
dest.path,
fill) {
# Read sound files, initialize frequency and time limits for spectrogram
r <-
warbleR::read_sound_file(
X = X,
path = path,
index = i,
header = TRUE,
from = 0,
to = X$end[i] + mar
)
f <- r$sample.rate
t <- c(X$start[i] - mar, X$end[i] + mar)
mar1 <- mar
mar2 <- mar1 + X$end[i] - X$start[i]
if (t[1] < 0) {
mar1 <- mar1 + t[1]
mar2 <- mar2 + t[1]
t[1] <- 0
}
if (t[2] > r$samples / f) {
t[2] <- r$samples / f
}
# add low high freq
if (flim[1] == "frange") {
flim <- range(c(X$bottom.freq[i], X$top.freq[i])) + c(-1, 1)
}
fl <-
flim # in case flim its higher than can be due to sampling rate
if (fl[2] >= f / 2000) {
fl[2] <- ((f - 1) / 2000)
}
if (fl[1] < 0) {
fl[1] <- 0
}
# Spectrogram width can be proportional to signal duration
if (propwidth) {
pwc <-
(10.16) * ((t[2] - t[1]) / 0.27) * xl * picsize
} else {
pwc <- (10.16) * xl * picsize
}
if (is.null(by.song)) {
fn <- paste(X$sound.files[i], "-", X$selec[i], ".", it, sep = "")
} else if (by.song == "sound.files") {
fn <- paste(X$sound.files[i], ".", it, sep = "")
} else {
fn <- paste(X$sound.files[i], "-", X[i, by.song], ".", it, sep = "")
}
img_wrlbr_int(
filename = fn,
path = dest.path,
width = pwc,
height = (10.16) * picsize,
units = "cm",
res = res
)
# Change relative heights of rows for spectrogram when osci = TRUE
if (osci) {
hts <- c(3, 2)
} else {
hts <- NULL
}
# Change relative widths of columns for spectrogram when sc = TRUE
if (sc) {
wts <- c(3, 1)
} else {
wts <- NULL
}
# Change inner and outer plot margins
par(mar = inner.mar)
par(oma = outer.mar)
# Generate spectrogram using spectro_wrblr_int (modified from seewave::spectro)
spectro_wrblr_int(
wave = warbleR::read_sound_file(
X = X,
path = path,
index = i,
from = t[1],
to = t[2]
),
f = f,
wl = wl,
ovlp = ovlp,
heights = hts,
wn = "hanning",
widths = wts,
palette = pal,
osc = osci,
grid = gr,
scale = sc,
collab = "black",
cexlab = cexlab,
cex.axis = 1,
flim = fl,
tlab = "Time (s)",
flab = "Frequency (kHz)",
alab = "",
trel = FALSE,
fast.spec = fast.spec,
box = box,
axisX = axis,
axisY = axis,
...
)
# Add title to spectrogram
if (is.null(title.labels)) {
if (!is.null(by.song)) {
if (by.song == "sound.files") {
title(X$sound.files[i], cex.main = cexlab)
} else {
title(paste0(X$sound.files[i], "-", X[i, by.song]), cex.main = cexlab)
}
}
} else {
title(paste0(X[i, title.labels], collapse = " "), cex.main = cexlab)
}
# Plot lines to visualize selections (start and end of signal)
if (line) {
if (any(names(X) == "bottom.freq") & any(names(X) == "top.freq")) {
if (!is.null(by.song)) {
W <-
Y[Y$sound.files == X$sound.files[i] &
Y[, by.song, drop = TRUE] == X[i, by.song, drop = TRUE], , drop = FALSE]
W$start <- W$start - X$start[i] + mar1
W$end <- W$end - X$start[i] + mar1
} else {
W <- X[i, , drop = FALSE]
W$start <- mar1
W$end <- mar2
}
for (e in 1:nrow(W))
{
# if freq columns are not provided
ys <- if (is.null(W$top.freq)) {
fl[c(1, 2, 2, 1)]
} else {
c(
W$bottom.freq[e],
W$top.freq[e],
W$top.freq[e],
W$bottom.freq[e]
)
}
# plot polygon
polygon(
x = rep(c(W$start[e], W$end[e]), each = 2),
y = ys,
lty = lty,
border = col,
col = fill,
lwd = 1.2
)
if (!is.null(sel.labels)) {
text(
labels = paste(W[e, sel.labels], collapse = "-"),
x = (W$end[e] + W$start[e]) / 2,
y = if (is.null(W$top.freq)) {
fl[2] - 2 * ((fl[2] - fl[1]) / 12)
} else {
W$top.freq[e]
},
pos = 3
)
}
}
}
}
dev.off()
}
# set clusters for windows OS
if (Sys.info()[1] == "Windows" & parallel > 1) {
cl <- parallel::makePSOCKcluster(getOption("cl.cores", parallel))
} else {
cl <- parallel
}
# run loop apply function
out <-
pblapply_wrblr_int(
pbar = pb,
X = 1:nrow(X),
cl = cl,
FUN = function(i) {
specreFUN(
X,
Y,
i,
mar,
flim,
xl,
picsize,
res,
wl,
ovlp,
cexlab,
by.song,
sel.labels,
pal,
dest.path,
fill
)
}
)
}
##############################################################################################################
#' alternative name for \code{\link{spectrograms}}
#'
#' @keywords internal
#' @details see \code{\link{spectrograms}} for documentation. \code{\link{specreator}} will be deprecated in future versions.
#' @export
specreator <- spectrograms
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.