R/bioacoustica.tools.window.R

In BioAcoustica/BioAcousticaR-tools: What the package does (short line)

bioacoustica.tools.window <- function(wave, interval, increment, windowFunction, units=c("seconds")) {
  window_start <- 0; #Start position of current analysis window
  window_number <- 1;
  hit_end <- FALSE;  #The first time window overlaps end of wave treat as normal
  f <- wave@samp.rate;
  results <- data.frame();
  
  while (!isTRUE(hit_end)) {
    #Check if we will hit the end, if so adjust interval and flag.
    if (window_start + interval > duration(wave, f=f)) {
      interval <- duration(wave, f=f) - window_start;
      hit_end <- TRUE;
    }
    
    #Cut the window
    window <- cutw(wave, f=f, from=window_start, to=window_start + interval, output="Wave", units=units);
    
    #Pass the window to functions
    results <- rbind(results, windowFunction(window_number, window_start, window_start + interval, window, f));
    
    #Increment the window
    window_start <- window_start + increment;
    window_number <- window_number + 1;
  }
  names(results) <- windowFunction(NULL, NULL, NULL, NULL, NULL, headers=TRUE);
  return (results);
}

bioacoustica.biovel.window <- function(url, interval, increment) {
  window_start <- 0; #Start position of current analysis window
  window_number <- 1;
  hit_end <- FALSE;  #The first time window overlaps end of wave treat as normal
  window_list <- c();
  

  tempSoundFile <- tsf <- paste("bioacousticar",bioacoustica.int.getExt(url),sep=".");
  bioacoustica.tools.download(url,tempSoundFile,mode="wb");

  
  wave <- readWave(tempSoundFile);
  f = wave@samp.rate
  
  
  while (!isTRUE(hit_end)) {
    #Check if we will hit the end, if so adjust interval and flag.
    if (window_start + interval > duration(wave, f=f)) {
      interval <- duration(wave, f=f) - window_start;
      hit_end <- TRUE;
    }
    
    #Prepare the list
    row <- list(wn = window_number, ws = window_start, we = window_start + interval, file = toString(tsf), url=toString(url));
    window_list = c(window_list, toString(row));
    
    #Increment the window
    window_start <- window_start + increment;
    window_number <- window_number + 1;
  }
  window_list;
  return (window_list);
}




bioacoustica.tools.download <- function(url, ...) {
  options(timeout=300)
  url <- bioacoustica.int.trim(url)
  if (grepl('^https?://', url)) {
    if (.Platform$OS.type == "windows") {
      on.exit(suppressWarnings(setInternet2(use=FALSE)))    
      if (grepl('^https://', url)) suppressWarnings(setInternet2(use=TRUE))	  
      download.file(url, ...)      
    } else {
      if (nzchar(Sys.which("wget")[1])) {
        method <- "wget"
      } else if (nzchar(Sys.which("curl")[1])) {
        method <- "curl"
        orig_extra_options <- getOption("download.file.extra")
        on.exit(options(download.file.extra = orig_extra_options))
        options(download.file.extra = paste("-L", orig_extra_options))
      } else if (nzchar(Sys.which("lynx")[1])) {
        method <- "lynx"
      } else {
        stop("no download method found")
      }
      download.file(url, method = method, ...)
    }
  } else {  
    download.file(url, ...)
  }
}  

bioacoustica.int.trim <- function (x) gsub("^\\s+|\\s+$", "", x)

bioacoustica.int.getExt <- function (path){
  parts <- strsplit(path, "\\.")[[1]]
  last <- parts[length(parts)]
  last
}