R/wellformedness.R

In musicMCT: Analyze the Structure of Musical Scales

#' Well-formedness, Myhill's property, and/or moment of symmetry
#'
#' Tests whether a scale has the property of "well-formedness" or "moment of symmetry."
#'
#' The three concepts of "well-formedness," "Myhill's property," and "moment of symmetry"
#' refer to nearly the same scalar property, generalizing one of the most important features
#' of the familiar diatonic scale. See Clough, Engebretsen, and Kochavi (1999, 77; 
#' \doi{doi:10.2307/745921}) for a useful discussion of their relationships. In short,
#' except for a few edge cases, a scale possesses these properties if it is generated by copies
#' of a single interval (as the Pythagorean diatonic is generated by the ratio 3:2) and all copies 
#' of the generator belong to the same generic interval (as the 3:2 generator of the diatonic
#' always corresponds to a "fifth" within the scale). Such a structure typically means that
#' all generic intervals come in 2 distinct sizes, which is the definition of "Myhill's property."
#' An exception occurs if the generator manages to produce a perfectly even scale, e.g. when
#' the whole tone scale is generated by 6 copies of `1/6` of the octave. Such a scale lacks
#' Myhill's property and Carey & Clampitt (1989, 200; \doi{doi:10.2307/745935}) call such cases
#' "degenerate well-formed." Instead of Myhill's property, such scales have only 1 specific value
#' in each [intervalspectrum()].
#'
#' Clough, Engebretsen, and Kochavi define a related concept, distributionally even scales,
#' which include the hexatonic and octatonic scales (Forte sc6-20 and sc8-28). Such scales are in
#' some sense halfway between "degenerate" and "non-degenerate well-formed" because some of their
#' interval spectra have 1 element while others have 2. From another perspective, distributionally
#' even scales are non-degenerate well formed with a period smaller than the octave (e.g. as the
#' hexatonic scales 1-3 step pattern repeats every third of an octave).
#'
#' The term "moment of symmetry" refers to the non-degenerate well-formed scales and was coined by
#' Erv Wilson 1975 (cited in Clough, Engebretsen, and Kochavi). It tends to be more widely used in 
#' microtonal music theory.
#'
#' Scales with this property have considerably interesting voice-leading properties and are 
#' some of the most important landmarks in the geometry of MCT. See "Modal Color Theory," pp. 14, 17,
#' 29, 33-34, and 36-37. A substantial portion of MCT amounts to an attempt to generalize ideas developed
#' for MOS/NDWF scales to all scale structures.
#'
#' @inheritParams tnprime
#' @inheritParams fpunique
#' @param stepword A vector representing the ranked step sizes of a scale (e.g.
#'   `c(2, 2, 1, 2, 2, 2, 1)` for the diatonic). The distinct values of the `setword`
#'   should be consecutive integers. If you want to test a step word instead of 
#'   a list of pitch classes, `set` must be entered as `NULL`.
#' @param allow_de Should the function test for degenerate well-formed and distributionally even scales too?
#'   Defaults to `FALSE`.
#' @returns Boolean answering "Is the scale MOS (with equivalence interval equal to
#'   the period)?" (if allow_de=FALSE) or "Is the scale well-formed
#'   in any sense?" (if allow_de=TRUE).
#' @examples
#' iswellformed(sc(7, 35))
#' iswellformed(c(0, 2, 4, 6))
#' iswellformed(c(0, 1, 6, 7))
#' iswellformed(c(0, 1, 6, 7), allow_de=TRUE)
#' iswellformed(NULL, stepword=c(2, 2, 1, 2, 1, 2, 1))
#' @export
iswellformed <- function(set, stepword=NULL, allow_de=FALSE, edo=12, rounder=10) {
  if (is.null(set)) { 
    set <- realize_stepword(stepword, edo) 
  }
  if (length(set) < 2) { 
    return(as.logical(allow_de)) 
  }

  speccount <- spectrumcount(set, edo, rounder)
  uniques <- unique(speccount)
  if (toString(uniques)=="2") { 
    return(TRUE) 
  }
  if (toString(uniques)=="1") { 
    return(as.logical(allow_de)) 
  }
  if (toString(sort(uniques))=="1, 2") { 
    return(as.logical(allow_de)) 
  }

  FALSE
}

#' Equivalence two step letters as in the definition of PWF
#'
#' Clampitt's definition of pairwise well formed scales requires that
#' every equivalencing of two letters in the PWF word results int 
#' a well-formed word. This function does that substitution.
#'
#' @param stepword A numeric vector: a step word of a scale to test
#' @param lowerbound Integer: the smallest entry in `setword` to equivalence
#' @param windowsize Integer: how many letters above `lowerbound`
#'   (inclusive) are included in the equivalence?
#'
#' @returns A step word (numeric vector) with only two letters.
#'
#' @noRd
equivocate <- function(stepword, lowerbound, windowsize) {
  highest <- max(stepword)
  toMatch <- lowerbound:(lowerbound+(windowsize-1))
  toMatch <- unique(((toMatch-1)%%highest)+1)
  replacement_positions <- which(stepword %in% toMatch)
  result <- replace(stepword, replacement_positions, 1)
  result <- replace(result, -replacement_positions, 2)
  result
}

#' Is a scale n-wise well formed?
#'
#' Tests whether a scale has a generalized type of well formedness (pairwise or
#' n-wise well formedness).
#'
#' David Clampitt's 1997 dissertation ("Pairwise Well-Formed Scales: 
#' Structural and Transformational Properties," SUNY Buffalo) offers
#' a generalization of the notion of well-formedness from 1-dimensional
#' structures with a single generator to 2-dimensional structures that 
#' mediate between two well-formed scales. Ongoing research suggests that
#' this can be extended further to "n-wise" or "general" well-formedness,
#' though n-wise well-formed scales are increasingly rare as n grows larger.
#'
#' @inheritParams iswellformed
#' @returns Boolean: is the set n-wise well formed?
#'
#' @examples
#' meantone_diatonic <- c(0, 2, 4, 5, 7, 9, 11)
#' just_diatonic <- j(dia)
#' some_weird_thing <- convert(c(0, 1, 3, 6, 8, 12, 14), 17, 12)
#' example_scales <- cbind(meantone_diatonic, just_diatonic, some_weird_thing)
#'
#' apply(example_scales, 2, howfree)
#' apply(example_scales, 2, isgwf)
#'
#' @export
isgwf <- function(set, stepword=NULL, allow_de=FALSE, edo=12, rounder=10) {
  if (is.null(stepword)) { 
    stepword <- asword(set, edo, rounder) 
  }
  if (anyNA(stepword)) { 
    return(FALSE)
  }

  highest <- max(stepword)
  equiv_parameters <- expand.grid(1:highest, 1:(highest-1))

  equiv_wrap <- function(params, stepword) equivocate(stepword, params[1], params[2])
  reduced_words <- apply(equiv_parameters, 1, equiv_wrap, stepword=stepword)

  iswf_wrap <- function(stepword, allow_de, edo, rounder)  {
    iswellformed(NULL, stepword, allow_de, edo, rounder)
  }

  tests <- apply(reduced_words,2, iswf_wrap, allow_de=allow_de, edo=edo, rounder=rounder)

  as.logical(prod(tests))
}


#' Voice leadings between inversions with maximal common tones
#'
#' @description
#' Clampitt (2007, 467; \doi{doi:10.1007/978-3-642-04579-0_46}) defines two \eqn{n}-note sets to be Q-related
#' if they:
#' * Have all but one tone in common
#' * Are related by [tni()]
#' * Have a strictly crossing-free voice leading which preserves all \eqn{n-1} common tones
#' This function finds all sets which are Q-related to an input `set` in this sense. The relation
#' is defined to generalize the smooth voice leadings between consonant triads and diatonic scales
#' to other sets, in particular demonstrating that non-singular pairwise well-formed scales (see [isgwf()])
#' demonstrate similarly nice voice leading properties.
#'
#' (Strictly speaking, Clampitt includes [tn()] in the second part of the definition. However, the first
#' criterion is only possible under [tn()] if the set is generated and therefore inversionally symmetrical.
#' Therefore if a set satisfies Clampitt's definition by [tn()], it also satisfies the [tni()] requirement.)
#'
#' If the third part of the definition is relaxed, allowing the voice leading to involve voice crossing,
#' Clampitt (1997, 121) identifies this as the Q*-relation. The Q*-relation can be computed
#' with this function by setting `method="hamming"`. (All other methods provided by [vl_dist()] give
#' equivalent results in this context.)
#'
#' When `method` is not "hamming", a synonym for "Q relation" is "Cohn flip" (Lewin 1996, 
#' \doi{doi:10.2307/843888}).
#'
#' @inheritParams tnprime
#' @param index Integer: which Q-related set and voice leading should be returned? Defaults to `NULL`,
#'   in which case all options are returned.
#' @inheritParams minimize_vl
#'
#' @seealso [isgwf()], [minimize_vl()], [normal_form()]
#'
#' @returns A list with two entries, `"sets"` and `"vls"`. The former is a matrix whose columns are
#'   the sets which are Q-related to the input `set`, in OP-normal form. The latter is a matrix
#'   whose rows represent the voice-leading motions which transform `set` into its goals.
#'   (This follows the general practice of musicMCT of representing scales as columns and
#'   voice leadings as rows.) The rows
#'   of `"vls"` correspond to the columns of `"sets"`, but the columns of `"vls"` correspond to the order
#'   of the input `set`, which may not match the normal form of the output `sets`. (See the last example.)
#'
#' @examples
#' # The Neo-Riemannian P, L, and R transformations on triads are all Q-relations:
#' major_triad <- c(0, 4, 7)
#' clampitt_q(major_triad)
#'
#' # A well-formed scale like the diatonic has two Q-relations given by its signature transformations:
#' major_scale <- c(0, 2, 4, 5, 7, 9, 11)
#' clampitt_q(major_scale)
#'
#' # A non-singular pairwise well-formed scale also has Q-relations:
#' clampitt_q(j(dia))
#'
#' # Set-class 7-31 is pairwise well-formed:
#' clampitt_q(sc(7, 31))
#' # It also has two additional Q*-related sets:
#' clampitt_q(sc(7, 31), method="hamming")
#'
#' # Most other types of scales have at most one Q-relation:
#' dominant_seventh <- c(0, 4, 7, 10)
#' clampitt_q(dominant_seventh)
#' 
#' # The order of "sets" may not match the order of "vls":
#' clampitt_q(c(0, 1, 4, 7))
#'
#' @export
clampitt_q <- function(set, 
                       index=NULL, 
                       method=c("taxicab", "euclidean", "chebyshev", "hamming"), 
                       edo=12, 
                       rounder=10) {
  card <- length(set)
  tiny <- 10^(-1 * rounder)
  method <- match.arg(method)

  subsets <- utils::combn(set, card-1)
  symmetry_index <- apply(subsets, 2, isym_index, edo=edo, rounder=rounder)
  has_isym <- !is.na(symmetry_index)

  tsym_index <- unlist(apply(subsets, 2, tsym_index, edo=edo, rounder=rounder))
  tsym_index <- fpunique(tsym_index, MARGIN=0, rounder=rounder)

  symmetry_index <- symmetry_index[has_isym]
  symmetry_index <- fpmod(as.vector(outer(symmetry_index, tsym_index, "-")), edo=edo, rounder=rounder)
  symmetry_index <- fpunique(symmetry_index, rounder=rounder)

  if (length(symmetry_index) == 0) {
    return(list(sets=matrix(nrow=card, ncol=0),
                vls=matrix(nrow=0, ncol=card)))
  }

  goals <- sapply(symmetry_index, tni, set=set, edo=edo, rounder=rounder)
  diffs <- apply(goals, 
                 2, 
                 mvl_tiebreak, 
                 source=set, 
                 method=method, 
                 tiebreak_method="hamming",
                 edo=edo, 
                 rounder=rounder)

  does_move <- abs(diffs) > tiny
  moving_notes <- colSums(does_move)

  kept_cols <- which(moving_notes==1)
  goals <- goals[, kept_cols]
  does_move <- does_move[, kept_cols]  
  diffs <- diffs[, kept_cols]

  if (length(kept_cols) < 2) {
    goals <- insist_matrix(goals)
    does_move <- insist_matrix(does_move)
    diffs <- insist_matrix(diffs)
  }

  vls <- replicate(dim(goals)[2], rep(0, card))
  vls[does_move] <- diffs[does_move]
  if (length(vls)==0) vls <- matrix(nrow=card, ncol=0)

  if (dim(goals)[2] > 0) goals <- apply(goals, 2, normal_form, optic="op", edo=edo, rounder=rounder)

  if (!is.null(index)) {
    goals <- goals[, index]
    vls <- vls[, index]
  }

  vls <- t(vls)
  list(sets = goals, vls = vls)
}