#' @title acoustic summary
#' @description Statistical summary of acoustic matrix by defined time-periods
#'
#' @param x data.frame or matrix
#' @param dates Column or vector containing date-time corresponding to number of rows in x
#' @param breaks Breaks in dates. Accepts vector of times or "auto" note; use Date or POSIX format)
#' @param splits Split based on left (default) or right breaks
#' @param size If breaks == "auto", the minimum cluster size
#'
#' @return data.frame with columns for start and end time for summaries and summary statistics
#' see \code{\link[spatialEco]{moments}} for details on summary statistics
#'
#' @note breaks are character in a "00:00:00" (ie., HH:MM:SS) format (see example).
#'
#' @author Jeffrey S. Evans <jeffrey_evans@@tnc.org>
#'
#' @examples
#' m <- read.csv("site1_20171115_PMN.csv")[,-1]
#' hr <- seq.POSIXt(as.POSIXct("2018-11-15"),
#' (as.POSIXct("2018-11-15") + nrow(m)*60),
#' by = "1 min")[-1441]
#'
#' cat("Using automatic change point breaks", "\n")
#' ( am <- acoustic.summary(m, dates = hr) )
#'
#' am <- am[-1,] # first row is a summary of the entire matrix
#' par(mfrow=c(2,2))
#' plot(am$start, am$max, type="b", xlab="start time",
#' ylab="maximum", main="maximum")
#' plot(am$start, am$median, type="b", xlab="start time",
#' ylab="median", main="median")
#' plot(am$start, am$var, type="b", xlab="start time",
#' ylab="variance", main="variance")
#' plot(am$start, am$nmodes, type="b", xlab="start time",
#' ylab="n-modes", main="number of modes")
#'
#' cat("Using", "6am-10am,", "10am-2pm,", "2pm-6pm,",
#' "6pm-10pm,", "10pm-2am", "and 2am-6am breaks", "\n")
#' ( am <- acoustic.summary(m[,-1], dates = hr, breaks = c("02:00:00", "06:00:00",
#' "10:00:00", "14:00:00", "17:00:00", "21:00:00") ) )
#'
#' @seealso \code{\link[spatialEco]{moments}} for details on summary statistics
#'
#' @export
acoustic.summary <- function(x, dates, breaks = "auto", splits = "left",
size = 120, cp.idx = FALSE) {
use.breaks <- breaks
if(!class(x) == "data.frame" & !class(x) == "matrix")
stop("x must be data.frame or matrix")
if(use.breaks[1] == "auto") {
breaks.idx <- change.point(x, sig = 0.005, min.size = size,
alpha = 1)$estimates
breaks <- dates[breaks.idx[-c(1,length(breaks.idx))]]
}
breaks <- c(as.character(data.table::as.ITime(min(dates))),
as.character(data.table::as.ITime(breaks)),
as.character(data.table::as.ITime(max(dates))))
cat("Using", as.character(use.breaks), "for change points", "\n")
idx <- list()
for(i in 1:(length(breaks)-1)) {
start = breaks[i]
end = breaks[i+1]
idx.values <- c(grep(start, dates):grep(end, dates))
if(splits == "left") {
idx.values <- idx.values[-length(idx.values)]
} else {
idx.values <- idx.values[-1]
}
idx[[i]] <- idx.values
}
d <- data.frame(start=dates[1], end=dates[length(dates)],
t(spatialEco::moments(as.numeric(as.matrix(x)))) )
for(i in 1:length(idx)) {
x.sub <- as.matrix(x[idx[[i]],])
if( nrow(x.sub) > 2) {
d <- rbind(d, data.frame(start=dates[min(idx[[i]])],
end=dates[max(idx[[i]])],
t(spatialEco::moments(as.numeric(as.matrix(x.sub))))) )
} else {
d[nrow(d)+1,][1] <- dates[min(idx[[i]])]
d[nrow(d),][2] <- dates[max(idx[[i]])]
}
}
if( cp.idx == TRUE ) {
return( list(x = d, idx = breaks.idx) )
} else {
return(d)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.