-- |
-- Module      : Harmonic.Rules.Constraints.Overtone
-- Description : Constructive generation of valid triads from overtone sets
--
-- This module implements the Rules (R) component of the Creative Systems
-- Framework for constraining the "search space" of possible harmonies.
--
-- == Academic Lineage
--
-- /The Harmonic Algorithm/ (South, 2016), Section Two: the exhaustive
-- combinatorial charts of 3-note overtone combinations across 12 chromatic
-- bass notes for EAeGB, EAeGC, and EADG tunings. This module is the
-- computational realisation of those charts.
--
-- /Data Science In The Creative Process/ (South, 2018): the @overtoneSets@
-- function is ported from the MusicData module (lines 382-385).
--
-- == Design
--
-- Constructive generation: only valid combinations are produced in the
-- first place, avoiding O(n³) generate-then-filter.
--
-- The overtone series provides the "palette" of available tones, and
-- the combinatorial generator produces all valid 3-note subsets rooted
-- on a specified fundamental. The 'annotateOvertones' function provides
-- reverse-mapping from pitch classes back to string\/overtone sources,
-- using the thesis notation (@E3\/e1@, @G1+3@).

module Harmonic.Rules.Constraints.Overtone
  ( -- * Triad Generation
    possibleTriads
  , possibleTriads''   -- ^ Legacy alias for MusicData compatibility
  , possibleTriadsFrom
  , overtoneSets

    -- * Combination Utilities
  , nCr
  , combinations

    -- * Triad Selection

    -- * Overtone Annotation
  , annotateOvertones
  , formatOvertoneAnnotation
  , formatOvertoneAnnotationPipe
  ) where

import Data.List (sort, nub, intercalate)

import Harmonic.Rules.Types.Pitch (PitchClass(..), mkPitchClass, unPitchClass)

-------------------------------------------------------------------------------
-- Combination Generator (nCr)
-------------------------------------------------------------------------------

-- |Generate all combinations of size n from a list.
-- This is the mathematical "n choose r" operation.
--
-- Implementation uses direct recursion for clarity:
--   * nCr 0 xs = [[]]           -- One way to choose nothing
--   * nCr n [] = []              -- Can't choose from empty
--   * nCr n (x:xs) = with x ++ without x
--
-- Ported from legacy MusicData.hs nCr function.
nCr :: Int -> [a] -> [[a]]
nCr :: forall a. Int -> [a] -> [[a]]
nCr Int
0 [a]
_      = [[]]
nCr Int
_ []     = []
nCr Int
n (a
x:[a]
xs) = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
nCr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
nCr Int
n [a]
xs

-- |Alias for nCr with more descriptive name
combinations :: Int -> [a] -> [[a]]
combinations :: forall a. Int -> [a] -> [[a]]
combinations = Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
nCr

-------------------------------------------------------------------------------
-- Overtone Set Generation
-------------------------------------------------------------------------------

-- |Generate all valid subsets of size n from a fundamental and overtone palette.
-- 
-- CONSTRUCTIVE: This function directly builds valid sets rather than
-- generating all and filtering. Each set contains:
--   * Exactly one element from the fundamental list
--   * Exactly (n-1) elements from the overtone list
--   * No duplication of the fundamental in the overtone selection
--
-- Ported from legacy MusicData.hs (lines 382-385):
-- @
-- overtoneSets n rs ps = [ i:j | i <- rs,
--                          j <- sort <$> (nCr $ n-1) ps,
--                          not $ i `elem` j]
-- @
overtoneSets :: (Eq a, Ord a) => Int -> [a] -> [a] -> [[a]]
overtoneSets :: forall a. (Eq a, Ord a) => Int -> [a] -> [a] -> [[a]]
overtoneSets Int
n [a]
roots [a]
overtones = 
  [ a
root a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
overtoneSet 
  | a
root <- [a]
roots
  , [a]
overtoneSet <- [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> [[a]] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
nCr (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
overtones
  , a
root a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
overtoneSet  -- Constructive constraint: no doubling
  ]

-------------------------------------------------------------------------------
-- Triad Generation (n=3 specialization)
-------------------------------------------------------------------------------

-- |Generate all possible triads rooted on a given fundamental.
-- 
-- Input: (fundamental pitch class, available overtone pitch classes)
-- Output: List of triads, each as [root, tone1, tone2] where:
--   * Root is the specified fundamental
--   * tone1 < tone2 (sorted)
--   * Neither tone equals root
--
-- This is the workhorse function called during ingestion to derive
-- harmonic interpretations from YCACL slices.
--
-- Ported from legacy MusicData.hs (lines 388-391):
-- @
-- possibleTriads'' (r, ps) =
--   let fund = (\x -> [x]) . fromIntegral $ r
--    in overtoneSets 3 fund ps
-- @
possibleTriads :: (Int, [Int]) -> [[Int]]
possibleTriads :: (Int, [Int]) -> [[Int]]
possibleTriads (Int
root, [Int]
overtones) =
  let fundList :: [Int]
fundList = [Int
root Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12]
      -- Remove fundamental from overtones to avoid doubling
      availableOvertones :: [Int]
availableOvertones = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
x -> Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
root Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) [Int]
overtones
      -- Generate 2-element combinations from available overtones
  in Int -> [Int] -> [Int] -> [[Int]]
forall a. (Eq a, Ord a) => Int -> [a] -> [a] -> [[a]]
overtoneSets Int
3 [Int]
fundList ([Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (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]
availableOvertones)

-- |Alternative signature taking PitchClasses
possibleTriadsFrom :: PitchClass -> [PitchClass] -> [[PitchClass]]
possibleTriadsFrom :: PitchClass -> [PitchClass] -> [[PitchClass]]
possibleTriadsFrom PitchClass
root [PitchClass]
overtones =
  let rootInt :: Int
rootInt = PitchClass -> Int
unPitchClass PitchClass
root
      overtoneInts :: [Int]
overtoneInts = (PitchClass -> Int) -> [PitchClass] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PitchClass -> Int
unPitchClass [PitchClass]
overtones
      triads :: [[Int]]
triads = (Int, [Int]) -> [[Int]]
possibleTriads (Int
rootInt, [Int]
overtoneInts)
  in ([Int] -> [PitchClass]) -> [[Int]] -> [[PitchClass]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> PitchClass) -> [Int] -> [PitchClass]
forall a b. (a -> b) -> [a] -> [b]
map Int -> PitchClass
mkPitchClass) [[Int]]
triads

-------------------------------------------------------------------------------
-- Legacy Compatibility Aliases
-------------------------------------------------------------------------------

-- |Legacy alias for 'possibleTriads'.
-- Matches the signature from MusicData.hs for smooth migration:
-- @
-- possibleTriads'' :: (Integral a, Num a) => (a, [a]) -> [[a]]
-- @
--
-- This version converts to\/from Int internally to maintain type safety
-- while preserving the polymorphic signature for backward compatibility.
possibleTriads'' :: (Integral a, Num a) => (a, [a]) -> [[a]]
possibleTriads'' :: forall a. (Integral a, Num a) => (a, [a]) -> [[a]]
possibleTriads'' (a
r, [a]
ps) =
  let intResult :: [[Int]]
intResult = (Int, [Int]) -> [[Int]]
possibleTriads (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r, (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [a]
ps)
  in ([Int] -> [a]) -> [[Int]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [[Int]]
intResult

-------------------------------------------------------------------------------
-- Overtone Annotation
-------------------------------------------------------------------------------

-- |Annotate pitch classes with their possible overtone sources from a tuning.
--
-- For each pitch in the chord, finds all (stringName, overtoneNumber) pairs
-- where that string's overtone series contains the pitch class.
--
-- Overtone numbering follows the thesis convention:
--   OT1 = fundamental (offset 0), OT2 = P5 (offset 7), OT3 = M3 (offset 4)
-- Annotation covers OT1-OT3 — the distinct pitch classes of the playable
-- tapped-harmonic domain.
--
-- Example:
-- @
-- annotateOvertones [("E",4),("A",9),("D",2),("G",7)] [11,7,2]
-- -- → [(11,[("E",2),("G",3)]), (7,[("G",1)]), (2,[("D",1),("G",2)])]
-- @
annotateOvertones :: [(String, Int)] -> [Int] -> [(Int, [(String, Int)])]
annotateOvertones :: [([Char], Int)] -> [Int] -> [(Int, [([Char], Int)])]
annotateOvertones [([Char], Int)]
tuning [Int]
pitches = (Int -> (Int, [([Char], Int)]))
-> [Int] -> [(Int, [([Char], Int)])]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, [([Char], Int)])
annotate [Int]
pitches
  where
    -- OT1-OT3 only: the playable tapped-harmonic domain (root, P5, M3)
    otOffsets :: [(Int, Int)]
otOffsets = [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
3] [Int
0, Int
7, Int
4 :: Int]
    annotate :: Int -> (Int, [([Char], Int)])
annotate Int
p = (Int
p, (([Char], Int) -> [([Char], Int)])
-> [([Char], Int)] -> [([Char], Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> ([Char], Int) -> [([Char], Int)]
forall {a}. Int -> (a, Int) -> [(a, Int)]
sourcesFor Int
p) [([Char], Int)]
tuning)
    sourcesFor :: Int -> (a, Int) -> [(a, Int)]
sourcesFor Int
p (a
name, Int
fund) =
      [ (a
name, Int
otNum)
      | (Int
otNum, Int
offset) <- [(Int, Int)]
otOffsets
      , (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fund) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
offset
      ]

-- |Format overtone annotation for a chord as a display string.
--
-- Uses thesis notation:
--   @"\/"@ separates alternative sources from different strings
--   @"+"@ connects multiple overtone numbers from the same string
--
-- Example output: @"{B: E2\/D4, G: G1, D: E5\/D1}"@
formatOvertoneAnnotation :: [(String, Int)] -> [Int] -> (Int -> String) -> String
formatOvertoneAnnotation :: [([Char], Int)] -> [Int] -> (Int -> [Char]) -> [Char]
formatOvertoneAnnotation [([Char], Int)]
tuning [Int]
pitches Int -> [Char]
pcToName =
  let annotated :: [(Int, [([Char], Int)])]
annotated = [([Char], Int)] -> [Int] -> [(Int, [([Char], Int)])]
annotateOvertones [([Char], Int)]
tuning [Int]
pitches
      entries :: [[Char]]
entries = [ Int -> [Char]
pcToName Int
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [([Char], Int)] -> [Char]
forall {a}. Show a => [([Char], a)] -> [Char]
formatSources [([Char], Int)]
sources
                | (Int
p, [([Char], Int)]
sources) <- [(Int, [([Char], Int)])]
annotated
                , Bool -> Bool
not ([([Char], Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], Int)]
sources)
                ]
  in if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
entries then [Char]
"" else [Char]
"{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
entries [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
  where
    formatSources :: [([Char], a)] -> [Char]
formatSources [([Char], a)]
sources =
      let grouped :: [([Char], [a])]
grouped = [([Char], a)] -> [([Char], [a])]
forall {a} {a}. Eq a => [(a, a)] -> [(a, [a])]
groupByString [([Char], a)]
sources
      in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall {a}. Show a => [a] -> [Char]
formatNums [a]
nums | ([Char]
name, [a]
nums) <- [([Char], [a])]
grouped ]
    formatNums :: [a] -> [Char]
formatNums [a
n] = a -> [Char]
forall a. Show a => a -> [Char]
show a
n
    formatNums [a]
ns  = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"+" ((a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
show [a]
ns)
    groupByString :: [(a, a)] -> [(a, [a])]
groupByString [(a, a)]
sources =
      let names :: [a]
names = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a
name | (a
name, a
_) <- [(a, a)]
sources]
      in [ (a
name, [a
num | (a
n, a
num) <- [(a, a)]
sources, a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
name]) | a
name <- [a]
names ]

-- |Format overtone annotation in pipe-delimited style for inline display.
-- Produces: @"overtones=| Bb: E2 | D: G3\/A4 |"@  (empty string if no annotations)
formatOvertoneAnnotationPipe :: [(String, Int)] -> [Int] -> (Int -> String) -> String
formatOvertoneAnnotationPipe :: [([Char], Int)] -> [Int] -> (Int -> [Char]) -> [Char]
formatOvertoneAnnotationPipe [([Char], Int)]
tuning [Int]
pitches Int -> [Char]
pcToName =
  let annotated :: [(Int, [([Char], Int)])]
annotated = [([Char], Int)] -> [Int] -> [(Int, [([Char], Int)])]
annotateOvertones [([Char], Int)]
tuning [Int]
pitches
      entries :: [[Char]]
entries = [ Int -> [Char]
pcToName Int
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [([Char], Int)] -> [Char]
forall {a}. Show a => [([Char], a)] -> [Char]
formatSources [([Char], Int)]
sources
                | (Int
p, [([Char], Int)]
sources) <- [(Int, [([Char], Int)])]
annotated
                , Bool -> Bool
not ([([Char], Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], Int)]
sources)
                ]
  in if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
entries then [Char]
"" else [Char]
"overtones=| " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
e -> [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" | ") [[Char]]
entries
  where
    formatSources :: [([Char], a)] -> [Char]
formatSources [([Char], a)]
sources =
      let grouped :: [([Char], [a])]
grouped = [([Char], a)] -> [([Char], [a])]
forall {a} {a}. Eq a => [(a, a)] -> [(a, [a])]
groupByString [([Char], a)]
sources
      in [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"/" [ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [a] -> [Char]
forall {a}. Show a => [a] -> [Char]
formatNums [a]
nums | ([Char]
name, [a]
nums) <- [([Char], [a])]
grouped ]
    formatNums :: [a] -> [Char]
formatNums [a
n] = a -> [Char]
forall a. Show a => a -> [Char]
show a
n
    formatNums [a]
ns  = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"+" ((a -> [Char]) -> [a] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [Char]
forall a. Show a => a -> [Char]
show [a]
ns)
    groupByString :: [(a, a)] -> [(a, [a])]
groupByString [(a, a)]
sources =
      let names :: [a]
names = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a
name | (a
name, a
_) <- [(a, a)]
sources]
      in [ (a
name, [a
num | (a
n, a
num) <- [(a, a)]
sources, a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
name]) | a
name <- [a]
names ]