theHarmonicAlgorithm-3.0.0: Real-time harmonic progression generation for TidalCycles live performance
Safe HaskellSafe-Inferred
LanguageHaskell2010

Harmonic.Evaluation.Scoring.VoiceLeading

Description

Part of the Evaluation (E) component of the Creative Systems Framework: voice-leading cost scores the quality of movement between sonorities. It does not run in the per-step generation loop — it enters evaluation at the whole-progression level (Harmonic.Evaluation.Scoring.Progression, used by attempt) and is applied by the Tidal Arranger when realising voicings.

KEY DESIGN DECISIONS:

  1. Cost Function Approach Rather than hard constraints, voice leading quality is measured via a cost function. This allows flexible optimization strategies.
  2. Cyclic Dynamic Programming Uses DP to find globally optimal voicings for the entire cyclic progression, considering wrap-around from last to first chord.
  3. Register Constraints Candidate pitches live in [7, 35] (pitchPlacements over [minPitch, maxPitch] bounds; the effective ceiling is 35 = 11+24). First chord starts in compact root position, and the whole result is shifted so the first root lands in [-12, -1].
  4. Two DP Paradigms (plus extractors and the chroma engine): * solveRoot (grid): smooth, compact voice leading, root always in bass * solveFlow (flow): smooth, compact voice leading, any inversion
Synopsis

Cost Functions

voiceLeadingCost :: [Int] -> [Int] -> Int Source #

Calculate the voice leading cost between two chords.

Cost components: * Base: sum of absolute MIDI movements per voice. * Parallel penalty: +3 for each parallel perfect 5th / octave between ANY voice pair (not just adjacent), when at least one voice moves. * Large leap penalty: +2 per voice moving > 4 semitones. * Register-exchange penalty: +4 per adjacent voice pair where both voices move ≥5 semitones in opposite directions (split-leap pattern producing register inversion). Note: not classical "voice crossing" — sorted MIDI voicings have no voice identity to cross — but the same musical effect of register-swapping leaps. * Contrary motion bonus: −1 per voice pair (any pair) where both voices move ≤4 semitones in opposite directions (modest divergence). * Stepwise motion bonus: −1 per stepping voice (movement ∈ {1, 2}) when ≥2 voices step. Single-voice steps contribute 0.

Magnitudes calibrated to compose: contrary motion and register exchange are deliberately disjoint by magnitude (≤4 vs ≥5 thresholds), aligning with the leap-penalty trigger so the same motion is never both rewarded and penalised. They also differ in pair scope by design: register exchange scans ADJACENT pairs only (a register swap is a neighbouring-voices phenomenon), while contrary motion rewards ANY pair.

The total is floored at 1 for any actual motion (from /= to): bonuses could otherwise exceed base + penalties and drive a moving transition below the held-chord cost of 0 — inverting the musical preference. A held chord ("available static movement") is always strictly cheapest; bonuses still discriminate among positive-cost alternatives. The floor applies to the TOTAL only — component bonuses stay un-clamped inside the sum (e.g. [0,4,7]→[-1,2,7] = base 3 + stepwise −1 = 2). Cross-cardinality transitions (mixed-set seams: lead' cues, hand-built fromChords material) are costed by optimal monotone padding: the smaller sorted voicing is expanded by duplicating tones per the minimal-distance non-crossing alignment in which every voice of BOTH chords participates (alignVoices), then the full cost above runs verbatim on the aligned pair. An extra voice pays exactly its distance to the tone it splits from (a literal unison doubling is free); no voice can appear or vanish unpenalised. Historical note: this branch was a flat 999 sentinel, which in the DP acted as "ignore this edge" — seam registers were decided by downstream edges alone and the cyclic wrap objective was silently disabled on mixed material.

alignVoices :: [Int] -> [Int] -> ([Int], [Int]) Source #

Optimal monotone padding for cross-cardinality voice leading. Given two SORTED voicings of different lengths, expands the smaller by duplicating tones so both have the larger's length, choosing the duplication per the minimal-total-|distance| monotone (non-crossing) alignment in which every voice of BOTH chords participates: each voice of the larger maps to exactly one voice of the smaller, the mapping is non-decreasing, and every smaller voice is used at least once. This is the "lowest / middle / highest voices of the larger lead the smaller" intuition: a 5-note chord resolves into a triad through its outer and inner voices, and the doubled tones pay exactly their split distance. O(m·n) DP (≤ 49 cells at max cardinality 7). Symmetric in its result (roles of from/to only decide which side gets padded). Equal-length input is returned unchanged.

totalCost :: [[Int]] -> Int Source #

Calculate total voice leading cost for a sequence of chords

cyclicCost :: [[Int]] -> Int Source #

Calculate cyclic cost: total cost including wrap-around from last to first. This is essential for loop-aware optimization.

From the evaluation document: "Adding wrap-around cost to the voice leading solver solves the drift issue elegantly. It forces the algorithm to find a path that is not just locally optimal, but topologically closed."

Voice Movement Calculation

voiceMovement :: Int -> Int -> Int Source #

Calculate the movement for a single voice between two concrete pitches. Movement is measured in absolute semitones (not mod 12 since we're working with concrete pitches in the [0,36] range).

minimalMovement :: PitchClass -> PitchClass -> Int Source #

Calculate minimal movement between two pitch class values (mod 12). Exported API; currently unused inside the engine (kept for REPL and downstream use).

Candidate Generation

allVoicings :: [Int] -> [[Int]] Source #

Generate all valid voicings for a pitch-class set of any cardinality. Each pitch class is placed at its pitchPlacements octaves (PCs 0-6 get 2 placements in [12, 30]; PCs 7-11 get 3 in [7, 35]) — candidate count is the per-PC placement product (2^a·3^b: typically 12 for a triad, 36 for a tetrad, 72 for a 5-PC set), NOT 3^N. The key-dependent window asymmetry is a known calibration; widening it changes every solved voicing globally and is deferred behind a before/after listening protocol. Results are sorted low-to-high and deduplicated.

Historical note: this was hard-coded to 3 notes, with non-triads falling back to the single candidate [sort pcs] pinned in octave [0,11] — which collapsed bars 2..n of any multi-bar 4+-note progression ~2 octaves below bar 1 under flow/grid (bar 1 goes through initialCompact, the rest through here, then normalizeByFirstRoot applies one uniform shift).

pitchPlacements :: Int -> [Int] Source #

Get all valid octave placements for a pitch class within [minPitch, maxPitch] Generates placements at base, +12, and +24 semitones (3 octaves)

initialCompact :: Int -> [Int] -> [Int] Source #

Create initial compact voicing: root in bass in target octave (12-23), upper voices stacked compactly above.

Paradigm Solvers (Cyclic DP)

solveRoot :: [[Int]] -> [[Int]] Source #

Solve with root always in bass (root paradigm). Filters candidates at each position to only those where bass note mod 12 == root PC. Result is normalized so first chord's root is in [-12,-1].

solveFlow :: [[Int]] -> [[Int]] Source #

Solve FLOW paradigm using cyclic DP: Smoothest voice leading with any inversion allowed for bars 1..n-1. Bar 0 is anchored to the compact root-position voicing (initialCompact) so the progression's starting register is predictable and normalizeByFirstRoot has a stable anchor. Voice crossings permitted in subsequent bars for optimal smoothness. Result is normalized so first chord's root is in [-12, -1].

liteVoicing :: [[Int]] -> [[Int]] Source #

LITE paradigm: Literal voicing with no optimization. Takes raw pitch class lists and normalizes them. Normalized so first chord's root is in [-12,-1]. Use this for comparing raw pitch classes against optimized voicings.

bassVoicing :: [[Int]] -> [[Int]] Source #

BASS paradigm: Bass note only (root pitch class per chord). Extracts the root note (first element, mod 12) from each chord. Returns as single-element lists in [0,11] range. Use this for bass line extraction from voiced progressions.

Post-processing

normalizeByFirstRoot :: [[Int]] -> [[Int]] Source #

Normalize a progression by a single uniform shift placing the first chord's root (bass note) at firstRootPC + targetFirstRootMin — i.e. into [-12, -1]. One constant transposition for the whole progression: consistent output register regardless of key or where the solver explored. (In practice the shift is always -24 after the DP solvers, whose bar 0 is initialCompact in [12, 23], and -12 for liteVoicing, whose raw input has its root in [0, 11].)