Label timing manipulations.

NAMESPACE

@@ -9,6 +9,8 @@ export(dutyCycle)
 export(entropyStats)
 export(frequencyStats)
 export(gs_transcribe)
+export(labelPadding)
+export(labelReduction)
 export(ntd)
 export(parseFilename)
 export(pd_dietrich2004)

R/labels.R

@@ -0,0 +1,62 @@
+#' Pad labels with interval
+#'
+#' Takes labels from Google Speech API transcript and pads the time by a specified number of seconds.
+#'
+#' @param t Transcript from Google Speech API
+#' @param pad Amount of time (in seconds) to add to start and end
+#' @param max_t Optional. The duration of the file, so padding does not exceed length of file.
+#' @export
+#'
+labelPadding <- function(t, pad=0.5, max_t=NULL) {
+  if (is.null(t$timings)) {
+    stop("At present this function only handles the outpout of Google Speech API")
+  }
+  t <- gs_preprocess_transcript(t)
+  t$timings$startTime <- validateTimeInSeconds(t$timings$startTime - pad, coerceNegative=TRUE, max_t=max_t, coerceMaximum=TRUE)
+  t$timings$endTime <- validateTimeInSeconds(t$timings$endTime + pad, coerceNegative=TRUE, max_t=max_t, coerceMaximum=TRUE)
+  return(t)
+}
+
+#' Combines labels which overlap into single continuous regions
+#'
+#' Takes labels from Google Speech API transcript and combines overlapping labels.
+#'
+#' @param t Transcript from Google Speech API
+#' @export
+#'
+labelReduction <- function(t) {
+  if (is.null(t$timings)) {
+    stop("At present this function only handles the outpout of Google Speech API")
+  }
+  t <- gs_preprocess_transcript(t)
+  return(labelReductionExecute(list(starts=t$timings$startTime, ends=t$timings$endTime)))
+}
+
+labelReductionExecute <- function(t) {
+  starts <- c(t$starts[[1]])
+  ends <- c(t$ends[[1]])
+  for (i in 2:length(t$starts)) {
+    overlap <- FALSE
+    for (j in 1:length(starts)) {
+      if (t$starts[[i]] >= starts[[j]] & t$starts[[i]] <= ends[[j]]) {
+        if (t$ends[[i]] >= ends[[j]]) {
+          ends[[j]] <- t$ends[[i]]
+          overlap <- TRUE
+        }
+      } else if (t$starts[[i]] <= starts[[j]] & t$ends[[i]] <= ends[[j]]) {
+        starts[[j]] <- starts[[i]]
+        overlap <- TRUE
+      } else if (t$starts[[i]] <= starts[[j]] & t$ends[[i]] >= ends[[j]]) {
+        starts[[j]] <- starts[[i]]
+        ends[[j]] <- ends[[i]]
+        overlap <- TRUE
+      }
+    }
+    if (overlap==FALSE) {
+      starts <- c(starts, t$starts[[i]])
+      ends <- c(ends, t$ends[[i]])
+    }
+  }
+  result <- list(starts=starts, ends=ends)
+  return(result)
+}

R/validationFunctions.R

@@ -147,3 +147,28 @@ validateComparableSpectra <- function(s1, s2) {
   }
 
 }
+
+validateTimeInSeconds <- function(t, coerceNegative=FALSE, max_t=NULL, coerceMaximum=FALSE) {
+  for (i in 1:length(t)) {
+    if (!is.numeric(t[[i]])) {
+      stop("Time in Seconds must be numeric.")
+    }
+    if (t[[i]] < 0) {
+      if (coerceNegative) {
+        t[[i]] <- 0
+      } else {
+        stop("Time in Seconds cannot be negative")
+      }
+    }
+  }
+  if (!is.null(max_t)){
+    if (t[[i]] > max_t) {
+      if (coerceMaximum) {
+        t[[i]] <- max_t
+      } else {
+        stop("Time in Seconds cannot be longer than max_t")
+      }
+    }
+  }
+  return(t)
+}