{-# LANGUAGE DeriveGeneric #-}

-- |
-- 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
  , rankedTriads
  , topTriads

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

import GHC.Generics (Generic)
import Data.List (sort, nub, sortBy, intercalate)
import Data.Function (on)

import Harmonic.Rules.Types.Pitch (PitchClass(..), mkPitchClass, unPitchClass)
import Harmonic.Evaluation.Scoring.Dissonance (dissonanceLevel, mostConsonant, rankByConsonance)

-------------------------------------------------------------------------------
-- 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

-------------------------------------------------------------------------------
-- Ranked Triad Selection
-------------------------------------------------------------------------------

-- |Generate triads ranked by consonance (most consonant first).
-- Uses Hindemith dissonance scores from the Dissonance module.
rankedTriads :: (Int, [Int]) -> [[Int]]
rankedTriads :: (Int, [Int]) -> [[Int]]
rankedTriads (Int, [Int])
input = [[Int]] -> [[Int]]
rankByConsonance ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (Int, [Int]) -> [[Int]]
possibleTriads (Int, [Int])
input

-- |Get the top N most consonant triads from a fundamental\/overtone pair.
-- Used by the multi-triad branching logic (3\/2\/1 weighting).
--
-- Returns at most n triads, or fewer if not enough valid triads exist.
topTriads :: Int -> (Int, [Int]) -> [[Int]]
topTriads :: Int -> (Int, [Int]) -> [[Int]]
topTriads Int
n (Int, [Int])
input = Int -> [[Int]] -> [[Int]]
forall a. Int -> [a] -> [a]
take Int
n ([[Int]] -> [[Int]]) -> [[Int]] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ (Int, [Int]) -> [[Int]]
rankedTriads (Int, [Int])
input

-------------------------------------------------------------------------------
-- Utility: Count Valid Triads
-------------------------------------------------------------------------------

-- |Count how many valid triads can be formed from a fundamental\/overtone pair.
-- Useful for diagnostic logging.
countPossibleTriads :: (Int, [Int]) -> Int
countPossibleTriads :: (Int, [Int]) -> Int
countPossibleTriads = [[Int]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Int]] -> Int)
-> ((Int, [Int]) -> [[Int]]) -> (Int, [Int]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Int]) -> [[Int]]
possibleTriads

-------------------------------------------------------------------------------
-- 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 :: [(String, Int)] -> [Int] -> [(Int, [(String, Int)])]
annotateOvertones [(String, Int)]
tuning [Int]
pitches = (Int -> (Int, [(String, Int)]))
-> [Int] -> [(Int, [(String, Int)])]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (Int, [(String, 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, [(String, Int)])
annotate Int
p = (Int
p, ((String, Int) -> [(String, Int)])
-> [(String, Int)] -> [(String, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> (String, Int) -> [(String, Int)]
forall {a}. Int -> (a, Int) -> [(a, Int)]
sourcesFor Int
p) [(String, 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 :: [(String, Int)] -> [Int] -> (Int -> String) -> String
formatOvertoneAnnotation [(String, Int)]
tuning [Int]
pitches Int -> String
pcToName =
  let annotated :: [(Int, [(String, Int)])]
annotated = [(String, Int)] -> [Int] -> [(Int, [(String, Int)])]
annotateOvertones [(String, Int)]
tuning [Int]
pitches
      entries :: [String]
entries = [ Int -> String
pcToName Int
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, Int)] -> String
forall {a}. Show a => [(String, a)] -> String
formatSources [(String, Int)]
sources
                | (Int
p, [(String, Int)]
sources) <- [(Int, [(String, Int)])]
annotated
                , Bool -> Bool
not ([(String, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Int)]
sources)
                ]
  in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
entries then String
"" else String
"{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
entries String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}"
  where
    formatSources :: [(String, a)] -> String
formatSources [(String, a)]
sources =
      let grouped :: [(String, [a])]
grouped = [(String, a)] -> [(String, [a])]
forall {a} {a}. Eq a => [(a, a)] -> [(a, [a])]
groupByString [(String, a)]
sources
      in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall {a}. Show a => [a] -> String
formatNums [a]
nums | (String
name, [a]
nums) <- [(String, [a])]
grouped ]
    formatNums :: [a] -> String
formatNums [a
n] = a -> String
forall a. Show a => a -> String
show a
n
    formatNums [a]
ns  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
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 :: [(String, Int)] -> [Int] -> (Int -> String) -> String
formatOvertoneAnnotationPipe [(String, Int)]
tuning [Int]
pitches Int -> String
pcToName =
  let annotated :: [(Int, [(String, Int)])]
annotated = [(String, Int)] -> [Int] -> [(Int, [(String, Int)])]
annotateOvertones [(String, Int)]
tuning [Int]
pitches
      entries :: [String]
entries = [ Int -> String
pcToName Int
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, Int)] -> String
forall {a}. Show a => [(String, a)] -> String
formatSources [(String, Int)]
sources
                | (Int
p, [(String, Int)]
sources) <- [(Int, [(String, Int)])]
annotated
                , Bool -> Bool
not ([(String, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Int)]
sources)
                ]
  in if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
entries then String
"" else String
"overtones=| " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
e -> String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | ") [String]
entries
  where
    formatSources :: [(String, a)] -> String
formatSources [(String, a)]
sources =
      let grouped :: [(String, [a])]
grouped = [(String, a)] -> [(String, [a])]
forall {a} {a}. Eq a => [(a, a)] -> [(a, [a])]
groupByString [(String, a)]
sources
      in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" [ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall {a}. Show a => [a] -> String
formatNums [a]
nums | (String
name, [a]
nums) <- [(String, [a])]
grouped ]
    formatNums :: [a] -> String
formatNums [a
n] = a -> String
forall a. Show a => a -> String
show a
n
    formatNums [a]
ns  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ((a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
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 ]