Merge pull request #21 from pmcharrison/dev

hrep 0.15.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: hrep
 Title: Harmony Representations
-Version: 0.14.0
+Version: 0.15.0
 Authors@R: person("Peter", "Harrison", email = "pmc.harrison@gmail.com", role = c("aut", "cre"))
 Description: This package provides utilities for representing and manipulating 
     chord sequences for perceptually informed harmony modelling.

NEWS.md

@@ -1,3 +1,11 @@
+# hrep 0.15.0
+
+- Add and propagate a `coherent` option for summing amplitudes. 
+Setting `coherent == TRUE` means coherent phases, so amplitudes are summed using addition;
+setting `coherent == FALSE` means incoherent phases, so amplitudes are summed using 
+the root mean square. This argument is now available in many `hrep` functions
+where spectra are constructed.
+
 # hrep 0.14.0
 
 - Add `[.wave` method.

R/expand-harmonics.R

@@ -23,12 +23,15 @@
 #' If TRUE, then the harmonics in the resulting spectrum are labelled with their harmonic numbers.
 #'
 #' @rdname expand_harmonics
+#'
+#' @inheritParams collapse_summing_amplitudes
 #' @export
 expand_harmonics <- function(x,
                              num_harmonics = 11L,
                              roll_off = 1,
                              digits = 6,
-                             label_harmonics = FALSE) {
+                             label_harmonics = FALSE,
+                             coherent = FALSE) {
   UseMethod("expand_harmonics")
 }
 
@@ -38,12 +41,14 @@ expand_harmonics.sparse_fr_spectrum <- function(x,
                                                 num_harmonics = 11L,
                                                 roll_off = 1,
                                                 digits = 6,
-                                                label_harmonics = FALSE) {
+                                                label_harmonics = FALSE,
+                                                coherent = FALSE) {
   expand_harmonics(sparse_pi_spectrum(x),
                    num_harmonics = num_harmonics,
                    roll_off = roll_off,
                    digits = digits,
-                   label_harmonics = label_harmonics) %>%
+                   label_harmonics = label_harmonics,
+                   coherent = coherent) %>%
     sparse_fr_spectrum()
 }
 
@@ -53,9 +58,9 @@ expand_harmonics.sparse_pi_spectrum <- function(x,
                                                 num_harmonics = 11L,
                                                 roll_off = 1,
                                                 digits = 6,
-                                                label_harmonics = FALSE) {
+                                                label_harmonics = FALSE,
+                                                coherent = FALSE) {
   template <- pi_harmonic_template(num_harmonics, roll_off)
-
   purrr::map2(pitch(x), amp(x),
               function(pitch, amp) {
                 df <- data.frame(
@@ -65,7 +70,7 @@ expand_harmonics.sparse_pi_spectrum <- function(x,
                 if (label_harmonics) df$labels <- seq_along(template$interval)
                 df
               }) %>%
-    collapse_summing_amplitudes(digits = digits) %>%
+    collapse_summing_amplitudes(digits = digits, coherent = coherent) %>%
     {.sparse_pi_spectrum(pitch = .$x, amplitude = .$y, labels = .$labels)}
 }
 
@@ -75,7 +80,8 @@ expand_harmonics.pi_chord <- function(x,
                                       num_harmonics = 11L,
                                       roll_off = 1,
                                       digits = 6,
-                                      label_harmonics = FALSE) {
+                                      label_harmonics = FALSE,
+                                      coherent = FALSE) {
   sparse_pi_spectrum(x,
                      num_harmonics = num_harmonics,
                      roll_off = roll_off,

R/smooth-pc-spectrum.R

@@ -56,6 +56,7 @@ is.smooth_pc_spectrum <- function(x) {
 #' Provided for S3 method consistency.
 #'
 #' @inheritParams expand_harmonics
+#' @inheritParams collapse_summing_amplitudes
 #'
 #' @seealso
 #' This representation was inspired by \code{\link{milne_pc_spectrum}},
@@ -69,27 +70,40 @@ is.smooth_pc_spectrum <- function(x) {
 #' \insertAllCited{}
 #'
 #' @export
-smooth_pc_spectrum <- function(x, sigma = 6.83, ...) {
+smooth_pc_spectrum <- function(
+  x,
+  ...,
+  sigma = 6.83,
+  num_harmonics = 11L,
+  roll_off = 1,
+  coherent = FALSE
+) {
   UseMethod("smooth_pc_spectrum")
 }
 
 #' @rdname smooth_pc_spectrum
 #' @export
-smooth_pc_spectrum.default <- function(x,
-                                       sigma = 6.83,
-                                       num_harmonics = 11L,
-                                       roll_off = 1,
-                                       ...) {
+smooth_pc_spectrum.default <- function(
+  x,
+  ...,
+  sigma = 6.83,
+  num_harmonics = 11L,
+  roll_off = 1,
+  coherent = FALSE
+) {
   smooth_pc_spectrum(sparse_pc_spectrum(x,
                                         num_harmonics = num_harmonics,
-                                        roll_off = roll_off),
-                     sigma = sigma, ...)
+                                        roll_off = roll_off,
+                                        coherent = coherent),
+                     sigma = sigma,
+                     coherent = coherent,
+                     ...)
 }
 
 #' @rdname smooth_pc_spectrum
 #' @export
-smooth_pc_spectrum.sparse_pc_spectrum <- function(x, sigma = 6.83, ...) {
-  df <- collapse_summing_amplitudes(list(x), digits = 2, modulo = 12)
+smooth_pc_spectrum.sparse_pc_spectrum <- function(x, ..., sigma = 6.83, coherent = FALSE) {
+  df <- collapse_summing_amplitudes(list(x), digits = 2, modulo = 12, coherent = coherent)
   df$ind <- 1 + df$x * 100
 
   checkmate::qassert(df$ind, "X[1,12000]")

R/smooth-pi-spectrum.R

@@ -56,6 +56,7 @@ is.smooth_pi_spectrum <- function(x) {
 #' Provided for S3 method consistency.
 #'
 #' @inheritParams expand_harmonics
+#' @inheritParams collapse_summing_amplitudes
 #'
 #' @seealso
 #' This representation was inspired by \code{\link{milne_pc_spectrum}},
@@ -79,18 +80,21 @@ smooth_pi_spectrum.default <- function(x,
                                        sigma = 6.83,
                                        num_harmonics = 11L,
                                        roll_off = 1,
+                                       coherent = FALSE,
                                        ...) {
   smooth_pi_spectrum(sparse_pi_spectrum(x,
                                         num_harmonics = num_harmonics,
                                         roll_off = roll_off,
+                                        coherent = coherent,
                                         ...),
-                     sigma = sigma)
+                     sigma = sigma,
+                     coherent = coherent)
 }
 
 #' @rdname smooth_pi_spectrum
 #' @export
-smooth_pi_spectrum.sparse_pi_spectrum <- function(x, sigma = 6.83, ...) {
-  df <- collapse_summing_amplitudes(list(x), digits = 2)
+smooth_pi_spectrum.sparse_pi_spectrum <- function(x, sigma = 6.83, coherent = FALSE, ...) {
+  df <- collapse_summing_amplitudes(list(x), digits = 2, coherent = coherent)
   df$ind <- 1 + df$x * 100
 
   checkmate::qassert(df$ind, "X[1,12000]")

R/sparse-pc-spectrum.R

@@ -56,6 +56,7 @@ is.sparse_pc_spectrum <- function(x) {
 #'
 #' @param x Input sonority.
 #'
+#' @inheritParams collapse_summing_amplitudes
 #' @inheritDotParams expand_harmonics
 #'
 #' @return An object of class \code{sparse_pc_spectrum}.
@@ -71,13 +72,13 @@ sparse_pc_spectrum.sparse_pc_spectrum <- function(x, ...) {
   x
 }
 
-sparse_pc_spectrum.sparse_pi_spectrum <- function(x, digits = 6) {
+sparse_pc_spectrum.sparse_pi_spectrum <- function(x, digits = 6, coherent = FALSE, ...) {
   df <- data.frame(x = pitch(x),
                    y = amp(x))
   if (!is.null(x$labels)) df$labels <- x$labels
   df %>%
     list() %>%
-    collapse_summing_amplitudes(digits = digits, modulo = 12) %>%
+    collapse_summing_amplitudes(digits = digits, modulo = 12, coherent = coherent) %>%
     {
       .sparse_pc_spectrum(pc = .[[1]],
                           amplitude = .[[2]],
@@ -87,8 +88,8 @@ sparse_pc_spectrum.sparse_pi_spectrum <- function(x, digits = 6) {
 
 #' @rdname sparse_pc_spectrum
 #' @export
-sparse_pc_spectrum.sparse_fr_spectrum <- function(x, ...) {
-  sparse_pc_spectrum(sparse_pi_spectrum(x))
+sparse_pc_spectrum.sparse_fr_spectrum <- function(x, coherent = FALSE, ...) {
+  sparse_pc_spectrum(sparse_pi_spectrum(x, coherent = coherent), coherent = coherent, ...)
 }
 
 #' @rdname sparse_pc_spectrum
@@ -117,8 +118,10 @@ sparse_pc_spectrum.default <- function(x, ...) {
 #' @export
 sparse_pc_spectrum.pi_chord <- function(x,
                                         amplitude = 1,
+                                        coherent = FALSE,
                                         ...) {
-  sparse_pc_spectrum(sparse_pi_spectrum(x, amplitude = amplitude, ...))
+  sparse_pc_spectrum(sparse_pi_spectrum(x, amplitude = amplitude, coherent = coherent, ...),
+                     coherent = coherent)
 }
 
 #' @export

R/sparse-pi-spectrum.R

@@ -106,15 +106,19 @@ sparse_pi_spectrum.default <- function(x, ...) {
 #'
 #' @rdname sparse_pi_spectrum
 #'
+#' @inheritParams expand_harmonics
+#'
 #' @export
 sparse_pi_spectrum.pi_chord <- function(x,
                                         amplitude = 1,
+                                        coherent = FALSE,
                                         ...) {
   checkmate::qassert(amplitude, "N")
   if (length(amplitude) == 1L) amplitude <- rep_to_match(amplitude, x)
   stopifnot(length(amplitude) == length(x))
   expand_harmonics(.sparse_pi_spectrum(pitch = as.numeric(x),
                                        amplitude = amplitude),
+                   coherent = coherent,
                    ...)
 }
 

R/sparse-spectrum.R

@@ -168,8 +168,10 @@ transform_y.sparse_spectrum <- function(x, f, y_unit, y_lab) {
 #'
 #' @return A sparse spectrum object.
 #'
+#' @inheritParams collapse_summing_amplitudes
+#'
 #' @export
-combine_sparse_spectra <- function(..., digits = 6) {
+combine_sparse_spectra <- function(..., digits = 6, coherent = FALSE) {
   checkmate::qassert(digits, "X1[0,)")
   input <- list(...)
   if (length(input) == 0) stop("combine_sparse_spectra needs at least 1 input")
@@ -199,7 +201,7 @@ combine_sparse_spectra <- function(..., digits = 6) {
 
   res <-
     lapply(input, as.data.frame) %>%
-    collapse_summing_amplitudes(digits = digits) %>%
+    collapse_summing_amplitudes(digits = digits, coherent = coherent) %>%
     {
       f <- if (octave_invariant) .sparse_pc_spectrum else .sparse_pi_spectrum
       f(.$x, .$y, labels = .$labels)
@@ -208,7 +210,25 @@ combine_sparse_spectra <- function(..., digits = 6) {
   if (output_class == "sparse_fr_spectrum") sparse_fr_spectrum(res) else res
 }
 
-collapse_summing_amplitudes <- function(x, digits, modulo = NA_real_) {
+#' Collapse summing amplitudes
+#'
+#' Takes a dataframe of spectral components (locations \code{x}, amplitudes \code{y}),
+#' rounds \code{x}, and then combines spectral components with the same location.
+#'
+#' @param x Input dataframe.
+#'
+#' @param digits Number of digits to which \code{x} should be rounded.
+#'
+#' @param modulo Optional modulo value for the rounding of \code{x}.
+#'
+#' @param coherent Whether the amplitudes from different spectral components should be combined
+#' assuming coherent summation, where the amplitudes simply add together
+#' (default is \code{FALSE}).
+#' Otherwise incoherent summation is used, where the amplitudes are squared, added, then
+#' square rooted.
+#'
+#' @return A dataframe.
+collapse_summing_amplitudes <- function(x, digits, modulo = NA_real_, coherent = FALSE) {
   checkmate::qassert(modulo, "n1(0,)")
   if (!is.list(x) ||
       !all(purrr::map_lgl(x, ~ is.data.frame(.) &&
@@ -219,19 +239,21 @@ collapse_summing_amplitudes <- function(x, digits, modulo = NA_real_) {
   x %>%
     data.table::rbindlist() %>%
     {
+      if (!is.na(modulo)) .$x <- .$x %% modulo
       .$x <- round(.$x, digits = digits)
       if (!is.na(modulo)) .$x <- .$x %% modulo
+      # Modulo needs to be done before and after because of subtle edge cases!
       .
     } %>%
     {reduce_by_key(
       keys = .$x,
       values = if (has_labels) purrr::map2(.$y, .$labels, ~ list(amplitude = .x, label = .y)) else .$y,
       function(x, y) {
         if (has_labels) {
-          list(amplitude = sum_amplitudes(x, y$amplitude, coherent = FALSE),
+          list(amplitude = sum_amplitudes(x, y$amplitude, coherent = coherent),
                label = y$label)
         } else {
-          sum_amplitudes(x, y, coherent = FALSE)
+          sum_amplitudes(x, y, coherent = coherent)
         }
       },
       key_type = "numeric"