R/timestamp_dmon.R

In hansenjohnson/lfdcs2raven: Review LFDCS Output in Raven Pro

#' Add a timestamp DMON wav files
#'
#' @details
#' Digital acoustic monitoring instruments (DMON) hydrophones log audio data in a `wav` file
#' and metadata in a `xml` file. This program simply renames the wav file to include the file start time, which
#' is useful for viewing the data in other sound analysis software (such as Raven Pro).
#' This is achieved by extracting the start time of the wav file from the associated xml header file.
#' The original and new timestamps will be saved in an R data file (`dmon_filenames.rds`) in the dmon data directory.
#' See \code{undo_timestamp_dmon()} for how to convert back to the original timestamps.
#' NOTE - this will only work for continuous DMON data (i.e., *not* duty cycled).
#'
#' @param dmon_dir The directory containing dmon wav and xml files
#' @param prefix String to be added to new filename before timestamp
#' @param suffix String to be added to new filename after timestamp
#'
#' @examples
#' '\dontrun{
#' timestamp_dmon(dmon_dir = 'data/dmon/')
#' }
#'
#' @seealso \code{\link{undo_timestamp_dmon}}
#'
#' @author Hansen Johnson (\email{hansen.johnson@@dal.ca})
#'
#' @export
timestamp_dmon <- function(dmon_dir, prefix = '',suffix = ''){

  # list wav files
  flist <- list.files(dmon_dir,pattern = '.wav$', full.names = TRUE)

  # define timestamp_table_file
  timestamp_table_file <- paste0(dmon_dir, 'dmon_filenames.rds')

  # make file name / timestamp table
  df <- dplyr::tibble(
    old_fname = flist,
    new_fname = NA,
    start_time = NA,
    end_time = NA
  )

  # convert to basenames
  flist <- tools::file_path_sans_ext(flist)

  # loop through files
  for(ii in seq_along(flist)){

    # paths to wav and xml files
    iwav <- paste0(flist[ii], '.wav')
    ixml <- paste0(flist[ii], '.xml')

    message('\nReading data from ', iwav)

    # check for xml file
    if(!file.exists(ixml)){
      message(basename(ixml), ' does not exist!')
      message('There must be a xml header associated with each wav file')
      return(message('Cancelling timestamping :('))
    }

    # read in xml
    x <- xml2::read_xml(ixml)

    # extract all event logs
    evt <- xml2::xml_find_all(x, "EVENT")

    # extract timestring to first event
    tstr <- xml2::xml_attr(evt, "TIME")[1]

    # parse beginning timestamp
    t0 <- as.POSIXct(tstr, '%Y,%m,%d,%H,%M,%S', tz = 'UTC')

    # print start time
    message('Start time from xml file: ', t0)

    # determine start time of subsequent audio files
    if(ii>1){

      # difference between file start times
      dif <- as.numeric(t1)-as.numeric(t0)
      message('Expected start time based on previous file: ', t1)
      message('Difference: ', round(dif,3), ' seconds')

      if(abs(dif)>5){
        message('Large gap between audio files! Using start time from log file')
      } else {
        message('Updating start time to what it *should* be based on previous audio file')
        t0 <- t1
      }
    }

    # get wav file info
    wav_info <- tuneR::readWave(iwav, header = TRUE)
    fs <- wav_info$sample.rate
    n <- wav_info$samples
    wav_dur <- n/fs

    # determine end timestamp
    t1 <- t0+wav_dur

    # construct file name
    new_fname <- paste0(dmon_dir, '/', prefix, format(t0, '%Y%m%d_%H%M%S'), suffix, '.wav')

    # update table
    df$new_fname[ii] <- new_fname
    df$start_time[ii] <- t0
    df$end_time[ii] <- t1
  }

  # fix timestamps
  df$start_time <- as.POSIXct(df$start_time,tz = 'UTC', origin = '1970-01-01')
  df$end_time <- as.POSIXct(df$end_time, tz = 'UTC', origin = '1970-01-01')

  # show table
  message('\nThe DMON files will be renamed as follows:')
  df_show = dplyr::tibble(old=basename(df$old_fname),new=basename(df$new_fname))
  print(df_show, max = 500)

  # ask for input
  message("Would you like to proceed? [y/n]: ")
  go <- readline()

  if(go == 'y'){
    # rename files
    saveRDS(object = df, file = timestamp_table_file)
    file.rename(from = df$old_fname, to = df$new_fname)

    message('Timestamping complete :)')
    message('The original filenames were saved in:\n    ', timestamp_table_file)
    message('You can revert to the original filenames by running:\n    undo_timestamp_dmon(\'', timestamp_table_file,'\')')
  } else {
    message('Timestamping cancelled :(')
  }
}

#' Revert DMON wav files to original file names
#'
#' @param timestamp_file The `dmon_filenames.rds` generated by \code{timestamp_dmon()}
#' containing dmon wav and xml files
#'
#' @examples
#' '\dontrun{
#' undo_timestamp_dmon(timestamp_file = 'data/dmon/dmon_filenames.rds')
#' }
#'
#' @seealso \code{\link{timestamp_dmon}}
#'
#' @author Hansen Johnson (\email{hansen.johnson@@dal.ca})
#'
#' @export
undo_timestamp_dmon <- function(timestamp_file){

  # throw error
  if(!file.exists(timestamp_file)){
    stop('Could not find original filenames :(')
  }

  # read in data
  df <- readRDS(timestamp_file)

  # show table
  message('\nThe DMON files will be renamed as follows:')
  df_show = dplyr::tibble(new=basename(df$old_fname),old=basename(df$new_fname))
  print(df_show, max = 500)

  # ask for input
  message("Would you like to proceed? [y/n]: ")
  go <- readline()

  if(go == 'y'){

    # rename
    file.rename(from = df$new_fname, to = df$old_fname)

    message('Files renamed :)')

  } else {
    message('Files not renamed :(')
  }
}