R/noise.matrix.R

In Ruido: Soundscape Background Noise, Power, and Saturation

# noise.matrix class ------------------------------------------------------

setClass(
  "noise.matrix.generic",
  slots = representation(
    values = "list",
    timeBins = "numeric",
    sampRate = "numeric",
    channel = "character"
  )
)

#' @title noise.matrix class
#'
#' @description
#' This class object is generated by the [bgNoise] function. It can be read by [soundSat].
#' <br>Methods: [show()] and [plot()][plot,noise.matrix,ANY-method]
#'
#' @slot values a list containing the values of BGN and POW. Indices are separated in individual data.frames by channel
#' @slot timeBins numeric vector containing the duration of each time bin
#' @slot sampRate single numeric string containing the audio's sampling rate
#' @slot wl single numeric string containing the spectrogram's window length
#' @slot channel single character string containing the channel or channels used to calculated the indices
#'
#' @returns
#' A `noise.matrix` object
#'
#' @export
#'
#' @seealso [bgNoise()]
setClass(
  "noise.matrix",
  contains = "noise.matrix.generic",
  slots = representation(wl = "numeric")
)

setClass(
  "noise.matrix.internal",
  contains = "noise.matrix.generic",
  slots = representation(path = "character")
)

# show --------------------------------------------------------------------

setMethod("show", signature(object = "noise.matrix"), function(object) {
  nBins <- length(object@timeBins)

  cat("Background Noise and Soundscape Power")
  cat("\nChannel:               ", object@channel)
  cat("\nSampling Rate (Hz):    ", object@sampRate)
  cat("\nWindow Length:         ", object@wl)
  cat("\nTemporal Bins:         ", nBins, "\n")

  if (object@channel == "stereo") {
    if (nBins == 1) {
      cat("\n@values$left\n")

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", 13)),
        paste(
          capture.output(rbind(setNames(
            head(format(object@values$left$BGN), 5), "$BGN1"
          ), "...")),
          capture.output(rbind(setNames(
            head(format(object@values$left$POW), 5), "$POW1"
          ), "...")),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

      cat("\n@values$right\n")

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", 13)),
        paste(
          capture.output(rbind(setNames(
            head(format(object@values$right$BGN), 5), "$BGN1"
          ), "...")),
          capture.output(rbind(setNames(
            head(format(object@values$right$POW), 5), "$POW1"
          ), "...")),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )
    } else if (nBins > 1 && nBins <= 5) {
      cat("\n@values$left\n")

      powDist <- nBins * 10 + 3

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", powDist)),
        paste(
          capture.output(rbind(setNames(
            head(format(object@values$left$BGN), 5), paste0("$BGN", 1:nBins)
          ), "...")),
          capture.output(rbind(setNames(
            head(format(object@values$left$POW), 5), paste0("$POW", 1:nBins)
          ), "...")),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

      cat("\n@values$right\n")

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", powDist)),
        paste(
          capture.output(rbind(setNames(
            head(format(object@values$right$BGN), 5), paste0("$BGN", 1:nBins)
          ), "...")),
          capture.output(rbind(setNames(
            head(format(object@values$right$POW), 5), paste0("$POW", 1:nBins)
          ), "...")),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

    } else {
      cat("\n@values$left\n")

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", 38)),
        paste(
          capture.output(setNames(
            cbind(rbind(head(
              format(object@values$left$BGN[1:5, 1:3]), 5
            ), "..."), "..."), c(paste0("$BGN", 1:3), "$BGN.")
          )),
          capture.output(setNames(
            cbind(rbind(head(
              format(object@values$left$POW[1:5, 1:3]), 5
            ), "..."), "..."), c(paste0("$POW", 1:3), "$POW.")
          )),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

      cat("\n@values$right\n")

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", 38)),
        paste(
          capture.output(setNames(
            cbind(rbind(head(
              format(object@values$right$BGN[1:5, 1:3]), 5
            ), "..."), "..."), c(paste0("$BGN", 1:3), "$BGN.")
          )),
          capture.output(setNames(
            cbind(rbind(head(
              format(object@values$right$POW[1:5, 1:3]), 5
            ), "..."), "..."), c(paste0("$POW", 1:3), "$POW")
          )),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

    }
  } else {
    rChannel = object@channel

    cat("\n@values$", rChannel, "\n", sep = "")

    if (nBins == 1) {
      cat(
        paste("$BGN", "$POW", sep = strrep(" ", 13)),
        paste(
          capture.output(rbind(setNames(
            head(format(object@values[[rChannel]]$BGN), 5), "$BGN1"
          ), "...")),
          capture.output(rbind(setNames(
            head(format(object@values[[rChannel]]$POW), 5), "$POW1"
          ), "...")),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

    } else if (nBins > 1 && nBins <= 5) {
      powDist <- nBins * 10 + 3

      cat(
        paste("$BGN", "$POW", sep = strrep(" ", powDist)),
        paste(
          capture.output(rbind(setNames(
            head(format(object@values[[rChannel]]$BGN), 5), paste0("$BGN", 1:nBins)
          ), "...")),
          capture.output(rbind(setNames(
            head(format(object@values[[rChannel]]$POW), 5), paste0("$POW", 1:nBins)
          ), "...")),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

    } else {
      cat(
        paste("$BGN", "$POW", sep = strrep(" ", 38)),
        paste(
          capture.output(setNames(
            cbind(rbind(head(
              format(object@values[[rChannel]]$BGN[1:5, 1:3]), 5
            ), "..."), "..."), c(paste0("$BGN", 1:3), "$BGN.")
          )),
          capture.output(setNames(
            cbind(rbind(head(
              format(object@values[[rChannel]]$POW[1:5, 1:3]), 5
            ), "..."), "..."), c(paste0("$POW", 1:3), "$POW.")
          )),
          sep = strrep(" ", 5)
        ),
        sep = "\n"
      )

    }
  }
})

# plot --------------------------------------------------------------------

#' Plot noise.matrix objects
#'
#' @param x an `noise.matrix` object generated by [bgNoise]
#' @param channel channel or channels to be ploted. By default, this set to `x@channel`, but can be changed to `left` or `right` if `x@channel` = `stereo`
#' @param bin temporal bin to be plotted. Defaults to `1`
#' @param index a character vector of length 1 or 2 with indeces to be plotted. Available indices are: BGN and POW. Defaults to `c("BGN", "POW)`
#' @param nbreaks amount of breaks of the y axis. Defaults to `5`
#' @param yunit frequency unit to be used in plot. Available units are: `"hz"` and `"khz"`. Defaults to `"hz"`
#' @param main title for the plot. Set two strings if you are plotting and stereo noise.matrix. If set to `NULL`, default title will be `left/right/mono channel`
#' @param xlab label for the x-axis. Defaults to `"dB"`
#' @param ylab label for the y-axis. Defaults to `"Frequency"`
#' @param col plotting color for de indices. Defaults to `c("blue","red")`
#' @param type desired plot type. For details see [base::plot]
#' @param draw0 if a stripped line should be drawn at 0. Defaults to `TRUE`
#' @param box if a box should be drawn around the plot. Defaults to `TRUE`
#' @param axes if axes should be drawn. Defaults to `TRUE`
#' @param annotate if bin information should be added to the plot. Defaults to `TRUE`
#' @param ... further [graphical parameters] passed down to plot
#'
#' @details This is a method to quickly plot the results of [bgNoise]. This calls the helper function `plotBGN`, which is not meant to be used or seen by the user.
#'
#' @importFrom grDevices xy.coords
#' @importFrom graphics abline
#' @importFrom graphics axis
#' @importFrom graphics mtext
#' @importFrom graphics par
#' @importFrom graphics plot.new
#' @importFrom graphics plot.window
#' @importFrom graphics plot.xy
#' @importFrom methods new
#' @importFrom utils head
#'
setMethod("plot", signature(x = "noise.matrix"), function(x, channel = NULL, bin = 1, index = c("BGN", "POW"), nbreaks = 5,
                                                          yunit = c("hz", "khz"), main = NULL, xlab = "dB", ylab = "Frequency", col = c("blue", "red"),
                                                          type = "p", draw0 = TRUE, box = TRUE, axes = TRUE, annotate = TRUE,
                                                          ...) {

  if (!is.null(channel)) {
    channel <- match.arg(channel, c("stereo", "mono", "left", "right"))
  } else {
    channel <- x@channel
  }

  if (is.null(main)) {
    main <- "channel"
  }

  yunit <- match.arg(yunit)

  if (length(x@timeBins) < bin) {
    bin <- length(x@timeBins)
  }

  plotBGN(
    x = x,
    channel = channel,
    bin = bin,
    index = index,
    nbreaks = nbreaks,
    yunit = yunit,
    main = main,
    xlab = xlab,
    ylab = ylab,
    col = col,
    type = type,
    draw0 = draw0,
    box = box,
    axes = axes,
    annotate = TRUE,
    ...
  )

})