Add chord frequency ratio function, update documentation and unit tes…

…ts. Prep for next release.

DESCRIPTION

@@ -43,4 +43,4 @@ Imports:
     crayon,
     ggplot2
 VignetteBuilder: knitr
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.0

NAMESPACE

@@ -39,6 +39,11 @@ S3method(c,music)
 S3method(c,noteinfo)
 S3method(c,noteworthy)
 S3method(c,phrase)
+S3method(freq_ratio,default)
+S3method(freq_ratio,list)
+S3method(freq_ratio,music)
+S3method(freq_ratio,noteworthy)
+S3method(freq_ratio,numeric)
 S3method(head,lyrics)
 S3method(head,music)
 S3method(head,noteinfo)
@@ -158,6 +163,7 @@ export(duration_to_ticks)
 export(dyad)
 export(flatten_sharp)
 export(freq_pitch)
+export(freq_ratio)
 export(freq_semitones)
 export(from_chorrrds)
 export(from_music21)
@@ -330,6 +336,7 @@ export(score)
 export(seconds)
 export(seconds_per_measure)
 export(seconds_per_step)
+export(semitone_freq)
 export(semitone_pitch)
 export(semitone_range)
 export(semitone_span)

NEWS.md

@@ -1,5 +1,6 @@
 # tabr 0.4.2
 
+* Added `freq_ratio` generic for generating a data frame of frequency ratios from frequencies, noteworthy objects, or music objects.
 * Added utility functions for retrieving LilyPond version and installation directory and `tabr` LilyPond API details.
 * Fixed bug where multiple sharps in tuning broke tab staff string label LilyPond syntax.
 * Updated documentation.

R/freq.R

@@ -1,6 +1,6 @@
 #' Pitch conversions
 #'
-#' Convert between pitch and other quantities.
+#' Convert between pitches, chords, semitones and frequencies.
 #'
 #' Frequencies are in Hertz. Values are based on the 12-tone equal-tempered
 #' scale. When converting an arbitrary frequency to pitch, it is rounded to the
@@ -23,7 +23,7 @@
 #' @param collapse logical, collapse result into a single string.
 #' \code{key} and \code{style}.
 #'
-#' @return numeric vector
+#' @return integer, numeric or noteworthy vector
 #' @export
 #'
 #' @examples
@@ -44,7 +44,7 @@
 #' chord_semitones(x)
 #' chord_freq(x)
 pitch_freq <- function(notes, a4 = 440){
-  a4 * (2 ^ (1 / 12)) ^ (pitch_semitones(notes) - 69)
+  semitone_freq(pitch_semitones(notes), a4)
 }
 
 #' @export
@@ -103,7 +103,131 @@ semitone_pitch <- function(semitones, octaves = c("tick", "integer"),
   .asnw(x, o, a)
 }
 
+#' @export
+#' @name pitch_freq
+semitone_freq <- function(semitones, a4 = 440){
+  a4 * (2 ^ (1 / 12)) ^ (semitones - 69)
+}
+
 .check_semitone <- function(x){
   if(any(x < 0, na.rm = TRUE) | any(x > 131, na.rm = TRUE))
     stop("Semitones must range from 0 to 131.", call. = FALSE)
 }
+
+#' Frequency ratios
+#'
+#' Obtain frequency ratios data frame.
+#'
+#' This generic function returns a data frame of frequency ratios from
+#' a vector or list of frequencies, a noteworthy object, or a music object. For
+#' frequency inputs, a list can be used to represent multiple timesteps.
+#' Octave numbering and accidentals are inferred from noteworthy and music
+#' objects, but can be specified for frequency. See examples.
+#'
+#' By default ratios are returned for all combinations of intervals in each
+#' chord (\code{ratios = "all"}). \code{ratios = "root"} filters the result to
+#' only include chord ratios with respect to the root note of each chord.
+#' \code{ratios = "range"} filters to only the chord ratio between the root and
+#' highest note.
+#'
+#' @param x noteworthy or music object, or a numeric vector or list of numeric
+#' vectors for frequencies.
+#' @param ... additional arguments: \code{ratios}, which is one of \code{"all"}
+#' (default), \code{"root"}, or \code{"range"} for filtering results. For
+#' frequency input, you may also specify \code{octaves} and \code{accidentals}.
+#' See details and examples.
+#'
+#' @return a tibble data frame
+#' @export
+#'
+#' @examples
+#' x <- as_music("c4 e_ g ce_g")
+#' (fr <- freq_ratio(x))
+#'
+#' x <- music_notes(x)
+#' identical(fr, freq_ratio(x))
+#'
+#' x <- chord_freq(x)
+#' identical(fr, freq_ratio(x))
+#'
+#' freq_ratio(x, accidentals = "sharp")
+#'
+#' freq_ratio(x, ratios = "root")
+#'
+#' freq_ratio(x, ratios = "range")
+freq_ratio <- function(x, ...){
+  UseMethod("freq_ratio", x)
+}
+
+#' @export
+freq_ratio.list <- function(x, ...){
+  y <- .freq_ratio_args(...)
+  freq_ratio.numeric(x, ratios = y$r, octaves = y$o, accidentals = y$a)
+}
+
+#' @export
+freq_ratio.noteworthy <- function(x, ...){
+  r <- .freq_ratio_args(...)$r
+  o <- octave_type(x)
+  a <- accidental_type(x)
+  freq_ratio.numeric(unname(chord_freq(x)), ratios = r, octaves = o,
+                     accidentals = a)
+}
+
+#' @export
+freq_ratio.music <- function(x, ...){
+  freq_ratio.noteworthy(music_notes(x), ...)
+}
+
+#' @export
+freq_ratio.numeric <- function(x, ...){
+  if(!is.list(x)) x <- list(x)
+  names(x) <- NULL
+  y <- .freq_ratio_args(...)
+  purrr::map_dfr(x, .freq_ratio, r = y$r, o = y$o, a = y$a, .id = "timestep") %>%
+    dplyr::mutate(
+      timestep = as.integer(.data[["timestep"]]),
+      notes = as_noteworthy(.data[["notes"]], y$o, y$a, "vector")
+    ) %>%
+    dplyr::select_at(c("timestep", "notes", "freq1", "freq2", "ratio"))
+}
+
+#' @export
+freq_ratio.default <- function(x, ...){
+  r <- .freq_ratio_args(...)$r
+  freq_ratio.noteworthy(as_noteworthy(x), r)
+}
+
+.freq_ratio <- function(x, r, o, a){
+  if(length(x) == 1){
+    d <- dplyr::tibble(
+      notes = as.character(freq_pitch(x, o, a)),
+      freq1 = x, freq2 = NA_real_, ratio = NA_real_
+    )
+    return(d)
+  }
+  x <- sort(x)
+  if(r == "range"){
+    x <- range(x)
+  }
+  x <- utils::combn(x, 2)
+  if(r == "root") x <- x[, x[1, ] == x[1, 1]]
+  ratio <- x[2, ] / x[1, ]
+  f <- function(x, y, o, a){
+    gsub("NA", "", paste0(freq_pitch(x, o, a), freq_pitch(y, o, a)))
+  }
+  dplyr::tibble(freq1 = x[1, ], freq2 = x[2, ], ratio = ratio) %>%
+    dplyr::mutate(notes = f(.data[["freq1"]], .data[["freq2"]], o, a))
+}
+
+
+.freq_ratio_args <- function(...){
+  x <- list(...)
+  r <- if(is.null(x$ratios)) "all" else
+    match.arg(x$ratios, c("all", "root", "range"))
+  o <- if(is.null(x$octaves)) "tick" else
+    match.arg(x$octaves, c("tick", "integer"))
+  a <- if(is.null(x$accidentals)) "flat" else
+    match.arg(x$accidentals, c("flat", "sharp"))
+  list(r = r, o = o, a = a)
+}

codemeta.json

@@ -14,10 +14,10 @@
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
-    "version": "3.6.2",
+    "version": "3.6.3",
     "url": "https://r-project.org"
   },
-  "runtimePlatform": "R version 3.6.2 (2019-12-12)",
+  "runtimePlatform": "R version 3.6.3 (2020-02-29)",
   "provider": {
     "@id": "https://cran.r-project.org",
     "@type": "Organization",
@@ -281,5 +281,5 @@
   ],
   "relatedLink": "https://CRAN.R-project.org/package=tabr",
   "developmentStatus": "http://www.repostatus.org/#active",
-  "fileSize": "333.11KB"
+  "fileSize": "334.826KB"
 }

cran-comments.md

@@ -1,7 +1,7 @@
 ## Test environments
 
-* local Windows 10 install, R 3.6.2
-* Windows 10 (AppVeyor), R 3.6.2
+* local Windows 10 install, R 3.6.3
+* Windows 10 (AppVeyor), R 3.6.3
 * Ubuntu 16.04 (Travis CI), R-devel, R-release, R-oldrel
 * win-builder (devel and release)