R/voice-pc-chord.R

In pmcharrison/voicer: Analyzing and Generating Chord Voicings

voice.vec_pc_chord <- function(x, 
                               opt = voice_opt(),
                               fix_melody = rep(NA_integer_, times = length(x)), 
                               fix_content = lapply(x, function(...) integer()),
                               fix_chords = vector("list", length(x))) {
  if (any(purrr::map_lgl(x, function(z) length(z) == 0L)))
    stop("empty chords not permitted")
  if (opt$verbose) message("Enumerating all possible chord voicings...")
  y <- all_voicings_vec_pc_chord(x = x, 
                                 opt = opt,
                                 fix_melody = fix_melody, 
                                 fix_content = fix_content,
                                 fix_chords = fix_chords)
  if (any(purrr::map_lgl(y, function(z) length(z) == 0L)))
    stop("no legal revoicings found")
  seqopt::seq_opt(y,
                  cost_funs = opt$features,
                  weights = opt$weights,
                  minimise = FALSE,
                  exp_cost = opt$exp_cost,
                  norm_cost = opt$norm_cost,
                  log_cost = opt$log_cost,
                  verbose = opt$verbose) %>%
    hrep::vec(type = "pi_chord")
}

all_voicings_vec_pc_chord <- function(x, 
                                      opt,
                                      fix_melody, 
                                      fix_content,
                                      fix_chords) {
  purrr::pmap(list(x = x,
                   fix_melody = fix_melody,
                   fix_content = fix_content,
                   fix_chord = fix_chords), 
              all_voicings_pc_chord,
              min_octave = opt$min_octave, 
              max_octave = opt$max_octave,
              dbl_change = opt$dbl_change, 
              min_notes = opt$min_notes, 
              max_notes = opt$max_notes)
}


#' All voicings (pc_chord)
#'
#' Lists all the possible voicings for an object of class
#' \code{\link[hrep]{pc_chord}}.
#' @param x Object to voice.
#' @param min_octave See \code{\link{voice_opt}}.
#' @param max_octave See \code{\link{voice_opt}}.
#' @param dbl_change See \code{\link{voice_opt}}.
#' @param min_notes See \code{\link{voice_opt}}.
#' @param max_notes See \code{\link{voice_opt}}.
#' 
#' @param fix_melody
#' (Numeric scalar)
#' Determines the MIDI pitch for the melody (i.e. the top note of the voicing).
#' If NA, no constraint is applied.
#' 
#' @param fix_content
#' (Numeric vector)
#' Specifies a set of MIDI pitches that must be contained in the voicing.
#' 
#' @param fix_chord
#' (NULL or numeric vector)
#' If not NULL, the function returns just one voicing with the MIDI pitches
#' specified in this vector.
#' 
#' @return A list of possible voicings.
#' 
#' @export
all_voicings_pc_chord <- function(x,
                                  min_octave, max_octave,
                                  dbl_change, min_notes, max_notes,
                                  fix_melody = NA_integer_, 
                                  fix_content = integer(),
                                  fix_chord = NULL) {
  if (!is.null(fix_chord)) return(check_fix_chord(fix_chord))
  
  x <- as.numeric(x)
  if (length(x) == 0L) stop("empty chords not permitted")
  bass_pc <- hrep::get_bass_pc(x)
  all_pc <- as.numeric(x)

  x <- if (dbl_change)
    all_voicings_pc_set(all_pc,
                        min_octave, max_octave,
                        dbl_change, min_notes, max_notes,
                        fix_melody, 
                        fix_content) else
      all_voicings_pc_multiset(all_pc, min_octave, max_octave,
                               fix_melody, 
                               fix_content)

  purrr::keep(x, function(z) (z[1] %% 12 == bass_pc))
}
all_voicings_pc_chord <- memoise::memoise(all_voicings_pc_chord)