Nothing
# For finding peaks in output from corMatch or binMatch and identifying detections
# Modified: 2015 APR 2
findPeaks <-
function(
score.obj, # A scoreList object, complete output from corMatch or binMatch
fd.rat=1, # Factor to multiply template duration by for determining frame width
frame, # Or directly specify the frame width
parallel=FALSE
) {
if(missing(score.obj)) stop('Required argument score.obj is missing')
# Required packages
if(parallel) {
lapplyfun <- function(X, FUN, mc.cores) parallel::mclapply(X, FUN, mc.cores=parallel::detectCores())
} else lapplyfun <- lapply
# Finally start working on peaks.
score.names <- as.list(names(score.obj@templates))
names(score.names) <- c(score.names)
# Create an object to hold results.
results <- list()
# Work through all templates
if(missing(frame)) frame <- NA
results <- lapplyfun(
X=score.names,
FUN=function(i) {
dat <- score.obj@scores[[i]]
time <- dat$time
score <- dat$score
if(is.na(frame)) frame <- fd.rat*score.obj@templates[[i]]@duration
score.cutoff <- score.obj@templates[[i]]@score.cutoff
# Time step between points in time, score data
time.step <- time[2]-time[1]
# Convert frame from seconds to number of time bins, and call span
span <- min(length(score), floor(frame/time.step)) # embed function won't work for span > length(x)
# Make span odd--ensures that peaks (and not peak neighbors) are returned
if(span%%2 == 0) span <- span+1
halfspan <- span%/%2 # Should always be (span-1)/2, so the numbers of bins on either side of point to check.
# Extend score data so points close or at ends can be identified as peaks
score.extended <- c(rep(0, halfspan), score, rep(0, halfspan))
lagmat <- embed(score.extended, span) # Makes a matrix where score vector is lagged by one position between columns
result <- max.col(lagmat) == 1 + halfspan # Returns TRUE when center column of matrix has the maximum value
pks <- dat[result, ]
rownames(pks) <- 1:nrow(pks)
pks$detection <- pks$score>=score.cutoff
hits <- pks[pks$score>=score.cutoff, ]
hits$detection <- NULL
if(nrow(hits)>0) rownames(hits) <- 1:nrow(hits)
# Summarize peak results
summary <- c(n.peaks=round(nrow(pks)), n.hits=round(nrow(hits)), max.score=signif(max(score), 3), min.score=signif(min(score), 3))
cat('\nDone with ', i)
return(list(peaks=pks, detections=hits))
}
)
# Separate peaks and detections
peaks <- lapply(results, `[[`, 'peaks')
detections <- lapply(results, `[[`, 'detections')
object <- new('detectionList', survey.name=score.obj@survey.name, survey=score.obj@survey, survey.data=score.obj@survey.data, templates=score.obj@templates, scores=score.obj@scores, peaks=peaks, detections=detections)
cat('\nDone\n')
return(object)
}
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.