-- |
-- Module      : Harmonic.Rules.Import.Transform
-- Description : YCACL data transformation into cadence structures
--
-- Transforms raw CSV corpus records into 'Harmonic.Rules.Types.Harmony.Cadence' structures suitable for
-- Neo4j graph storage: fundamental extraction, triad generation via
-- "Harmonic.Rules.Constraints.Overtone", and dissonance scoring.
--
-- == Node-key naming contract ==
--
-- The LIVE database's node keys (@show@ = movement + functionality) carry
-- functionality names produced under LEGACY naming rules — e.g. zero form
-- @[0,3,8]@ is stored as @maj_1stInv@, @[0,2,7]@ as @sus4_1stInv@. The
-- modern namers ('H.toTriad' via 'H.toCadence') deliberately diverge from
-- those rules (@min#5@, @sus2@ for the same forms). BOTH sides of the
-- pipeline therefore route through 'H.corpusFunctionality' (the 55-form
-- @corpusNameTable@ transcribed from the live database, 2026-08-19):
-- the read side when building fetch keys, and this module when stamping
-- the functionality that becomes a node's @show@ key. Re-ingestion under
-- this contract reproduces the live keyspace exactly (verified: the node
-- set is the complete 55 zero-forms x 12 movements grid, and @show@ is a
-- pure function of the zero form).
--
-- After any re-ingestion, verify with an online @gen'@ run: graph counts
-- (@[nG\/...]@) must stay nonzero across steps that select inversion forms.

module Harmonic.Rules.Import.Transform (
    -- * Transition counting
    buildTransitionCounts, buildTransitionCountsPerPiece,

    -- * Interpretation expansion
    sliceInterpretations,
) where

import           Harmonic.Rules.Import.Types
import qualified Data.Map.Strict as Map
import qualified Data.List as L
import           Data.List (sortOn)

import           Harmonic.Evaluation.Analysis.Markov (TransitionCounts)

-- Phase B modules
import qualified Harmonic.Rules.Types.Harmony as H
import qualified Harmonic.Evaluation.Scoring.Dissonance as D
import qualified Harmonic.Rules.Constraints.Overtone as O

-- |Weighted triad interpretations of one slice, most consonant first.
-- The top three candidates (by Hindemith dissonance, "Harmonic.Evaluation.Scoring.Dissonance")
-- carry a @[3,2,1]@ preference profile, NORMALISED so every
-- slice's interpretation weights sum to 1 — an ambiguous 7-PC vertical
-- contributes exactly the same total probability mass as an unambiguous
-- triad, instead of shouting several times louder purely because it was
-- ambiguous. Ties keep 'Harmonic.Rules.Constraints.Overtone.possibleTriads'
-- enumeration order ('sortOn' is stable).
--
-- Falls back to a single flat triad at weight 1 if ranking yields no
-- candidates (e.g. the exporter filtered the slice below 3 unique PCs).
sliceInterpretations :: ChordSlice -> [(H.Chord, Double)]
sliceInterpretations :: ChordSlice -> [(Chord, Double)]
sliceInterpretations ChordSlice
slice =
  let ranked :: [(Chord, Double)]
ranked = ChordSlice -> [(Chord, Double)]
forall {b}. Fractional b => ChordSlice -> [(Chord, b)]
rankedTriads ChordSlice
slice
   in if [(Chord, Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Chord, Double)]
ranked
        then [([Int] -> Chord
H.flatTriad (ChordSlice -> [Int]
slicePitches ChordSlice
slice), Double
1)]
        else [(Chord, Double)]
ranked
  where
    rankedTriads :: ChordSlice -> [(Chord, b)]
rankedTriads ChordSlice
sl =
      let fundamental :: Int
fundamental = ChordSlice -> Int
sliceFundamental ChordSlice
sl
          uniquePcs :: [Int]
uniquePcs   = [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub (ChordSlice -> [Int]
slicePitches ChordSlice
sl)
          overtones :: [Int]
overtones   = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
fundamental) [Int]
uniquePcs
          candidates :: [[Int]]
candidates  = (Int, [Int]) -> [[Int]]
forall a. (Integral a, Num a) => (a, [a]) -> [[a]]
O.possibleTriads'' (Int
fundamental, [Int]
overtones)
          scored :: [(Integer, Chord)]
scored      = ([Int] -> (Integer, Chord)) -> [[Int]] -> [(Integer, Chord)]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> (Integer, Chord)
score [[Int]]
candidates
          top :: [(Integer, Chord)]
top         = Int -> [(Integer, Chord)] -> [(Integer, Chord)]
forall a. Int -> [a] -> [a]
take Int
3 (((Integer, Chord) -> Integer)
-> [(Integer, Chord)] -> [(Integer, Chord)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Integer, Chord) -> Integer
forall a b. (a, b) -> a
fst [(Integer, Chord)]
scored)
          raw :: [(Chord, b)]
raw         = [Chord] -> [b] -> [(Chord, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Integer, Chord) -> Chord) -> [(Integer, Chord)] -> [Chord]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Chord) -> Chord
forall a b. (a, b) -> b
snd [(Integer, Chord)]
top) [b
3, b
2, b
1]
          total :: b
total       = [b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Chord, b) -> b) -> [(Chord, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Chord, b) -> b
forall a b. (a, b) -> b
snd [(Chord, b)]
raw)
       in [ (Chord
chord, b
w b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
total) | (Chord
chord, b
w) <- [(Chord, b)]
raw ]

    score :: [Int] -> (Integer, Chord)
score [Int]
triad =
      -- Hindemith dissonance gives an ordinal ranking; lower is more
      -- consonant, so ascending sort puts the preferred reading first.
      let pcs :: [Int]
pcs    = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) [Int]
triad
          (Integer
diss, [Int]
_) = [Int] -> (Integer, [Int])
D.dissonanceLevel [Int]
pcs
       in (Integer
diss, [Int] -> Chord
H.flatTriad [Int]
pcs)

-- |Fold one piece's slice sequence into Markov transition counts over
-- every CONSISTENT interpretation path.
--
-- A cadence is a movement onto a target chord, so an edge is built from a
-- slice TRIPLE @(s1, s2, s3)@: the cadence @a -> b@ followed by the cadence
-- @b -> c@, where the middle interpretation @b@ is shared by both sides.
-- Each such edge accumulates weight @w_a * w_b * w_c@ from the (per-slice
-- normalised) interpretation weights, so the total mass contributed by
-- each slice triple is exactly 1.
--
-- Sharing the middle reading is what keeps the expansion honest: every
-- reasonable reading of an ambiguous vertical informs the model
-- (recovering movement that triad reduction trims away), while two
-- alternative readings of the SAME moment can never be counted as a
-- transition between moments. Genuine corpus pedals (roughly a quarter
-- of YCACL slices repeat their predecessor) produce self-edges via the
-- same triple rule as every other transition.
--
-- Pieces with fewer than three slices contribute no edges (no complete
-- triple exists).
buildTransitionCounts :: [ChordSlice] -> TransitionCounts
buildTransitionCounts :: [ChordSlice] -> TransitionCounts
buildTransitionCounts [ChordSlice]
slices =
  let ts :: [[(Chord, Double)]]
ts      = (ChordSlice -> [(Chord, Double)])
-> [ChordSlice] -> [[(Chord, Double)]]
forall a b. (a -> b) -> [a] -> [b]
map ChordSlice -> [(Chord, Double)]
sliceInterpretations [ChordSlice]
slices
      triples :: [([(Chord, Double)], [(Chord, Double)], [(Chord, Double)])]
triples = [[(Chord, Double)]]
-> [[(Chord, Double)]]
-> [[(Chord, Double)]]
-> [([(Chord, Double)], [(Chord, Double)], [(Chord, Double)])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[(Chord, Double)]]
ts (Int -> [[(Chord, Double)]] -> [[(Chord, Double)]]
forall a. Int -> [a] -> [a]
drop Int
1 [[(Chord, Double)]]
ts) (Int -> [[(Chord, Double)]] -> [[(Chord, Double)]]
forall a. Int -> [a] -> [a]
drop Int
2 [[(Chord, Double)]]
ts)
   in (Double -> Double -> Double)
-> [TransitionCounts] -> TransitionCounts
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
        [ (Double -> Double -> Double)
-> [(Edge, Double)] -> TransitionCounts
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
            [ ( ( Cadence -> Cadence
corpusNamed ((Chord, Chord) -> Cadence
H.toCadence (Chord
a, Chord
b))
                , Cadence -> Cadence
corpusNamed ((Chord, Chord) -> Cadence
H.toCadence (Chord
b, Chord
c)) )
              , Double
wa Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wb Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
wc )
            | (Chord
a, Double
wa) <- [(Chord, Double)]
t1, (Chord
b, Double
wb) <- [(Chord, Double)]
t2, (Chord
c, Double
wc) <- [(Chord, Double)]
t3
            ]
        | ([(Chord, Double)]
t1, [(Chord, Double)]
t2, [(Chord, Double)]
t3) <- [([(Chord, Double)], [(Chord, Double)], [(Chord, Double)])]
triples
        ]
  where
    -- NODE-KEY DECISION POINT: the functionality stamped here becomes
    -- the graph node's @show@ key. Write-side naming is routed through
    -- 'H.corpusFunctionality' so the emitted keyspace is IDENTICAL to
    -- the live database's legacy-named keys (@corpusNameTable@) — the
    -- read side ("Harmonic.Evaluation.Database.Query") builds fetch
    -- keys through the same table, keeping both sides on one contract.
    -- For 3-PC forms the table is total (55/55 transcribed); non-triad
    -- forms fall back to the modern namers inside 'H.corpusFunctionality'
    -- (they are never corpus keys).
    corpusNamed :: Cadence -> Cadence
corpusNamed Cadence
c =
      Cadence
c { H.cadenceFunctionality = H.corpusFunctionality (H.cadenceIntervals c) }

-- |Sum 'buildTransitionCounts' over a composer's pieces. Each piece is
-- counted independently, so no transition can be invented across the
-- boundary between the last slices of one piece and the first of the
-- next (the flattened pipeline leaked exactly such edges).
buildTransitionCountsPerPiece :: [[ChordSlice]] -> TransitionCounts
buildTransitionCountsPerPiece :: [[ChordSlice]] -> TransitionCounts
buildTransitionCountsPerPiece = (Double -> Double -> Double)
-> [TransitionCounts] -> TransitionCounts
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) ([TransitionCounts] -> TransitionCounts)
-> ([[ChordSlice]] -> [TransitionCounts])
-> [[ChordSlice]]
-> TransitionCounts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ChordSlice] -> TransitionCounts)
-> [[ChordSlice]] -> [TransitionCounts]
forall a b. (a -> b) -> [a] -> [b]
map [ChordSlice] -> TransitionCounts
buildTransitionCounts