| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
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:
- Cost Function Approach Rather than hard constraints, voice leading quality is measured via a cost function. This allows flexible optimization strategies.
- Cyclic Dynamic Programming Uses DP to find globally optimal voicings for the entire cyclic progression, considering wrap-around from last to first chord.
- 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].
- 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
- voiceLeadingCost :: [Int] -> [Int] -> Int
- alignVoices :: [Int] -> [Int] -> ([Int], [Int])
- totalCost :: [[Int]] -> Int
- cyclicCost :: [[Int]] -> Int
- voiceMovement :: Int -> Int -> Int
- minimalMovement :: PitchClass -> PitchClass -> Int
- allVoicings :: [Int] -> [[Int]]
- pitchPlacements :: Int -> [Int]
- initialCompact :: Int -> [Int] -> [Int]
- solveRoot :: [[Int]] -> [[Int]]
- solveFlow :: [[Int]] -> [[Int]]
- liteVoicing :: [[Int]] -> [[Int]]
- bassVoicing :: [[Int]] -> [[Int]]
- normalizeByFirstRoot :: [[Int]] -> [[Int]]
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.
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].)