-- |
-- Module      : Harmonic.Evaluation.Analysis.Markov
-- Description : Markov transition probability computation (ingestion-only)
--
-- This module is used exclusively during data ingestion (@app\/Main.hs@) to
-- compute transition probabilities from the YCACL corpus. These probabilities
-- are stored as edge weights in the Neo4j graph database.
--
-- This module is NOT used in the runtime generation path. At runtime,
-- transition weights are read from Neo4j edges by
-- "Harmonic.Evaluation.Database.Query".
--
-- == Academic Lineage
--
-- /Data Science In The Creative Process/ (South, 2018), Section: Markov
-- module. The Markov chain approach resolves "Generative Uninspiration" —
-- the problem of manually traversing exhaustive overtone combination charts
-- — by training transition probabilities on the Yale Classical Archives
-- Corpus (Bach chorales and other composers).

module Harmonic.Evaluation.Analysis.Markov
  ( Edge
  , TransitionCounts
  , probabilitiesFromCounts
  ) where

import           Harmonic.Rules.Types.Harmony (Cadence)

import qualified Data.Map.Strict as Map
import           Data.Map.Strict (Map)

-- |Representation of a transition between cadences.
type Edge = (Cadence, Cadence)

-- | Raw observed (possibly fractional) counts per edge, before
-- normalisation. Produced by
-- 'Harmonic.Rules.Import.Transform.buildTransitionCounts'.
type TransitionCounts = Map Edge Double

-- | Total outgoing weight per source cadence, the denominator used when
-- normalising counts into probabilities.
type Totals = Map Cadence Double

-- | Normalise edge counts into per-source transition probabilities, so
-- the outgoing edges of each cadence sum to 1.
probabilitiesFromCounts :: TransitionCounts -> Map Edge Double
probabilitiesFromCounts :: TransitionCounts -> TransitionCounts
probabilitiesFromCounts TransitionCounts
counts =
  let totals :: Totals
totals = TransitionCounts -> Totals
buildTotals TransitionCounts
counts
   in (Edge -> Double -> Double) -> TransitionCounts -> TransitionCounts
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (Totals -> Edge -> Double -> Double
normalise Totals
totals) TransitionCounts
counts
  where
    buildTotals :: TransitionCounts -> Totals
    buildTotals :: TransitionCounts -> Totals
buildTotals = (Totals -> (Edge, Double) -> Totals)
-> Totals -> [(Edge, Double)] -> Totals
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Totals -> (Edge, Double) -> Totals
forall {k} {a} {b}.
(Ord k, Num a) =>
Map k a -> ((k, b), a) -> Map k a
accumulate Totals
forall k a. Map k a
Map.empty ([(Edge, Double)] -> Totals)
-> (TransitionCounts -> [(Edge, Double)])
-> TransitionCounts
-> Totals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionCounts -> [(Edge, Double)]
forall k a. Map k a -> [(k, a)]
Map.toList
      where
        accumulate :: Map k a -> ((k, b), a) -> Map k a
accumulate Map k a
acc ((k
from,b
_), a
weight) = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith a -> a -> a
forall a. Num a => a -> a -> a
(+) k
from a
weight Map k a
acc

    normalise :: Totals -> Edge -> Double -> Double
    normalise :: Totals -> Edge -> Double -> Double
normalise Totals
totals (Cadence
from, Cadence
_) Double
weight =
      case Cadence -> Totals -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Cadence
from Totals
totals of
        Just Double
total | Double
total Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 -> Double
weight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total
        Maybe Double
_                     -> Double
0