{- |
Module      :  Physics.MultipletCombiner
Copyright   :  (c) Michael Dressel 2023
License     :  BSD3 (see LICENSE)
Maintainer  :  Michael Dressel <michael.dressel@kloenplatz.de>
Stability   :  experimental

This module contains operators and functions for
combining SU(n) multiplets according to the
algorithm presented by C.G. Wohl in the PDG book 2021 section 48
<https://pdg.lbl.gov/2022/reviews/rpp2022-rev-young-diagrams.pdf>.

It provides the operators '(><)' and '(>><)' for combining multiplets,
and the function 'multi' and 'multis' to calculate the multiplicities, e.g.:

@

    [1,0] '><' [0,1] = [[1,1],[0,0]]

    'multi' [1,0] = 3

    [1,0] '><' [1,0] '>><' [1,0] = [[3,0],[1,1],[1,1],[0,0]]

    'multis' $ [1,0] '><' [1,0] '>><' [1,0] = [10,8,8,1]

@




Example for combining two multiplets using Young-Diagrams:

@

    (0,0)x(0,0) = (0,0)
    #     a   # a  # a   # a
    # (x) b = #  > # b > # b
    #     c   #    #     # c

    (1,0)x(1,0) = (step ->)   (2,0)      +   (step ->) (0,1)
    # #    a a    # # a a    # # a a           # # a    # # a
    #   x  b    = #       >  # b         +     # a    > # a b
    #      c      #          # c               #        # c

@

-}



module Physics.MultipletCombiner
    (
    -- * Kronecker product like operators
        (><),
        (>><),
        (><^),
    -- * Multiplicity calculation
        multi,
        multis,
    -- * Basic data type
        Tableau,
    -- * Lower level functions
        ytSymbols,
        ytsSymbols,
        showt,
        ytNums,
        ytsNums,
        admis,
        unchain,
        sym2letter,
        appendAt,
        readTab,
        combis,
        tabs1,
        allTsFromSyms,
        allTs
    ) where

import Data.Char
import Data.Ratio

-- | Basic type used for a Tableau/Diagram
newtype Tableau = Tableau [String] deriving (Tableau -> Tableau -> Bool
(Tableau -> Tableau -> Bool)
-> (Tableau -> Tableau -> Bool) -> Eq Tableau
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tableau -> Tableau -> Bool
$c/= :: Tableau -> Tableau -> Bool
== :: Tableau -> Tableau -> Bool
$c== :: Tableau -> Tableau -> Bool
Eq)
instance Show Tableau where
    show :: Tableau -> String
show (Tableau [String]
t) = [String] -> String
unlines [String]
t

-- | Show like function to display a list of tableaux.
showt :: [Tableau] -> String
showt :: [Tableau] -> String
showt [] = String
"----"
showt [Tableau
t] = Tableau -> String
forall a. Show a => a -> String
show Tableau
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"----"
showt (Tableau
t:[Tableau]
ts) = Tableau -> String
forall a. Show a => a -> String
show Tableau
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"----\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Tableau] -> String
showt [Tableau]
ts

-- ytSymbols [0] = ["# ",
--                   "# "]
-- ytSymbols [1] = ["# # ",
--                   "# "]
-- ytSymbols [2] = ["# # ",
--                   "# "]
-- ytSymbols [0,0] = ["# ",
--                     "# ",
--                     "# "]
-- ytSymbols [0,1] = ["# # ",
--                     "# # ",
--                     "# "]
-- ytSymbols [1,0] = ["# # ",
--                     "# ",
--                     "# "]
-- ytSymbols [1,1] = ["# # #",
--                     "# # ",
--                     "# "]
-- ytSymbols [0,2] = ["# # #",
--                     "# # #",
--                     "# "]
-- ytSymbols [1,2] = ["# # # #",
--                     "# # #",
--                     "# "]
-- ytSymbols [2,2] = ["# # # # #",
--                     "# # #",
--                     "# "]
-- ytSymbols [2,1] = ["# # # #",
--                     "# #",
--                     "# "]
-- ytSymbols [2,0] = ["# # #",
--                     "# ",
--                     "# "]

-- | Build a tableau bottom up from it's label.
ytSymbols :: [Int] -> Tableau
ytSymbols :: [Int] -> Tableau
ytSymbols [] = [String] -> Tableau
Tableau []
ytSymbols [Int]
is = [Int] -> Tableau -> Tableau
go ([Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
is) ([String] -> Tableau
Tableau [String
"# "])
              where
                go :: [Int] -> Tableau -> Tableau
                go :: [Int] -> Tableau -> Tableau
go []         Tableau
t = Tableau
t
                go (Int
i:[Int]
is) (Tableau (String
r:[String]
rs)) = [Int] -> Tableau -> Tableau
go [Int]
is (Tableau -> Tableau) -> Tableau -> Tableau
forall a b. (a -> b) -> a -> b
$ [String] -> Tableau
Tableau ([String] -> Tableau) -> [String] -> Tableau
forall a b. (a -> b) -> a -> b
$
                        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String
r String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
i String
"# ") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
r String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rs
-- | Build multiple tableaux from multiple labels.
ytsSymbols :: [[Int]] -> [Tableau]
ytsSymbols :: [[Int]] -> [Tableau]
ytsSymbols = ([Int] -> Tableau) -> [[Int]] -> [Tableau]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Tableau
ytSymbols


-- | Calculate the number representation from a tableau.
ytNums :: Tableau -> [Int]
ytNums :: Tableau -> [Int]
ytNums (Tableau [])  = []
ytNums (Tableau [String
l]) = []
ytNums (Tableau (String
l:String
m:[String]
ns)) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
m' Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Tableau -> [Int]
ytNums ([String] -> Tableau
Tableau (String
mString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ns))
                    where l' :: String
l' = ShowS
noBlank String
l
                          m' :: String
m' = ShowS
noBlank String
m
                          noBlank :: String -> String
                          noBlank :: ShowS
noBlank String
xs = [ Char
x | Char
x <- String
xs, Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ']

-- | Calculate the list of labels fro a list of tableaux.
ytsNums :: [Tableau] -> [[Int]]
ytsNums :: [Tableau] -> [[Int]]
ytsNums [] = []
ytsNums (Tableau
t:[Tableau]
ts) = case Tableau -> [Int]
ytNums Tableau
t of
                            [] -> [Tableau] -> [[Int]]
ytsNums [Tableau]
ts
                            [Int]
is -> [Int]
is [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: [Tableau] -> [[Int]]
ytsNums [Tableau]
ts

-- | Check for the string for being composed of admissible letters.
--   Admissible and not admissible examples:
--
-- @
--
-- admis "aabacdaebbcbd"  = True
--
-- last letter not admissible
-- admis "abacae"  = False
-- admis "abacdec"  = False
--
-- @

admis :: String -> Bool
admis :: String -> Bool
admis String
xs = case Char -> String -> Maybe String
unchain Char
'a' String
xs of
                Maybe String
Nothing -> Bool
False
                Just [] -> Bool
True
                Just String
cs -> String -> Bool
admis String
cs

-- | Extract one strictly ordered chain from the given string, starting
--   at the given character.
unchain :: Char -> String -> Maybe String
unchain :: Char -> String -> Maybe String
unchain Char
_ [] = String -> Maybe String
forall a. a -> Maybe a
Just []
unchain Char
x (Char
c:String
cs) | Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c = Char -> String -> Maybe String
unchain (Int -> Char
chr (Char -> Int
ord Char
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) String
cs
                 | Char
cChar -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<Char
x  = case Char -> String -> Maybe String
unchain Char
x String
cs of
                           Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
                           Just String
cs'-> String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs')
                 | Char
cChar -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>Char
x  = Maybe String
forall a. Maybe a
Nothing

-- | Convert a tableau of symbols  into a tableau of letters
sym2letter :: Tableau -> Tableau
sym2letter :: Tableau -> Tableau
sym2letter (Tableau [String]
xss) = [String] -> Tableau
Tableau ([String] -> Tableau) -> [String] -> Tableau
forall a b. (a -> b) -> a -> b
$
                                (String -> Char -> String) -> [String] -> String -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Char -> String
line2let [String]
xss [Char
'a'..]
                where line2let :: String -> Char -> String
                      line2let :: String -> Char -> String
line2let [] Char
_ = []
                      line2let (Char
x:String
xs) Char
c | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String -> Char -> String
line2let String
xs Char
c
                                        | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String -> Char -> String
line2let String
xs Char
c


-- | Append a string to the i'th line of a tableau.
appendAt :: Int -> String -> Tableau -> Tableau
appendAt :: Int -> String -> Tableau -> Tableau
appendAt Int
_ String
_ (Tableau []) = [String] -> Tableau
Tableau []
appendAt Int
_ [] Tableau
t = Tableau
t
appendAt Int
i String
s (Tableau [String]
ts) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ts Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = [String] -> Tableau
Tableau []
                | Bool
otherwise = [String] -> Tableau
Tableau ([String] -> Tableau) -> [String] -> Tableau
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [String]
ts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [([String]
ts [String] -> Int -> String
forall a. [a] -> Int -> a
!! (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s]
                                [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
i [String]
ts

-- | Produce a list of placing-coordinates of all combinations for a tableau
--   with t rows to place c character.
--
--   E.g.: 3 rows, two characters -> 3*3 possible placements:
--
--       1:1, 1:2, 1:3, 2:1, 2:2, 2:3, 3:1, 3:2, 3:3
combis :: Int -> Int -> [[Int]]
combis :: Int -> Int -> [[Int]]
combis Int
t Int
c = Int -> Int -> [[Int]] -> [[Int]]
go Int
t Int
c [[]]
        where
            go :: Int -> Int -> [[Int]] -> [[Int]]
            go :: Int -> Int -> [[Int]] -> [[Int]]
go Int
_ Int
0 [[Int]]
is = [[Int]]
is
            go Int
0 Int
_ [[Int]]
is = [[Int]]
is
            go Int
t Int
c [[Int]]
is = Int -> Int -> [[Int]] -> [[Int]]
go Int
t (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> [[Int]] -> [[Int]]
extend Int
t [[Int]]
is)

extend  :: Int -> [[Int]] -> [[Int]]
extend :: Int -> [[Int]] -> [[Int]]
extend Int
p [[Int]]
is = [ Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
y  | Int
x <- [Int
1..Int
p], [Int]
y <- [[Int]]
is]

-- | Create a new tableau extended by string s, onto tableau t. Where
--   s is placed at every position given by the list of integers is.
newtab :: String -> Tableau -> [Int] -> Tableau
newtab :: String -> Tableau -> [Int] -> Tableau
newtab String
_ Tableau
t  [] = Tableau
t
newtab String
s Tableau
t (Int
i:[Int]
is) = String -> Tableau -> [Int] -> Tableau
newtab String
s (Int -> String -> Tableau -> Tableau
appendAt Int
i String
s Tableau
t) [Int]
is

-- | Create multiple new tableau using newtab given one tableau and
--  one line of a right side tableau.
--
--   e.g.: tabs1 (ytSymbols [1,1,1]) "a a "
tabs1 :: Tableau -> String -> [Tableau]
tabs1 :: Tableau -> String -> [Tableau]
tabs1 Tableau
t String
r = Tableau -> String -> [[Int]] -> [Tableau]
go Tableau
t String
s (Int -> Int -> [[Int]]
combis Int
j Int
k)
            where
                go :: Tableau -> String -> [[Int]] -> [Tableau]
                go :: Tableau -> String -> [[Int]] -> [Tableau]
go Tableau
_ String
_ [] = []
                go Tableau
t String
s ([Int]
is:[[Int]]
iss) | Tableau -> Bool
rowsOK Tableau
t' Bool -> Bool -> Bool
&& Tableau -> Bool
colsOK Tableau
t' = Tableau
t' Tableau -> [Tableau] -> [Tableau]
forall a. a -> [a] -> [a]
: Tableau -> String -> [[Int]] -> [Tableau]
go Tableau
t String
s [[Int]]
iss
                                | Bool
otherwise = Tableau -> String -> [[Int]] -> [Tableau]
go Tableau
t String
s [[Int]]
iss
                                where
                                    t' :: Tableau
t' = String -> Tableau -> [Int] -> Tableau
newtab String
s Tableau
t [Int]
is
                s :: String
s = ShowS
sym String
r
                j :: Int
j = Tableau -> Int
nlines Tableau
t
                k :: Int
k = String -> Int
elemrow String
r

nlines :: Tableau -> Int
nlines :: Tableau -> Int
nlines (Tableau [String]
ts) = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ts

rowsOK :: Tableau -> Bool
rowsOK :: Tableau -> Bool
rowsOK (Tableau []) = Bool
True
rowsOK (Tableau [String
x]) = Bool
True
rowsOK (Tableau (String
x:String
y:[String]
zs)) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
y Bool -> Bool -> Bool
&& Tableau -> Bool
rowsOK ([String] -> Tableau
Tableau (String
yString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
zs))

colsOK :: Tableau -> Bool
colsOK :: Tableau -> Bool
colsOK (Tableau []) = Bool
True
colsOK (Tableau [String
s]) = Bool
True
colsOK (Tableau (String
x:String
y:[String]
zs)) = String -> String -> Bool
col2OK String
x String
y Bool -> Bool -> Bool
&& Tableau -> Bool
colsOK ([String] -> Tableau
Tableau (String
yString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
zs))

col2OK :: String -> String -> Bool
col2OK :: String -> String -> Bool
col2OK String
_ [] = Bool
True
col2OK [] String
_ = Bool
True
col2OK (Char
l:String
ls) (Char
r:String
rs) | Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = String -> String -> Bool
col2OK String
ls String
rs
                     | Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
r Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' = String -> String -> Bool
col2OK String
ls String
rs
                     | Char
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
r = Bool
False
                     | Bool
otherwise = String -> String -> Bool
col2OK String
ls String
rs

-- | allTs [1,0]  [1,1]
--
--   Create all tableau from two tableaux identified by their labels.
--
--   @
--   putStrLn $ showt $ noDoubs.admisTabs $ allTs [1,1] [1,1]
--   ytsNums $ noDoubs.admisTabs $ allTs [1,1] [1,1]
--   [[2,2],[3,0],[0,3],[1,1],[1,1],[0,0]]
--   @

allTs :: [Int] -> [Int] -> [Tableau]
allTs :: [Int] -> [Int] -> [Tableau]
allTs [Int]
lt [Int]
rt | [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rt = []
            | Bool
otherwise = Tableau -> Tableau -> [Tableau]
allTsFromSyms ([Int] -> Tableau
ytSymbols [Int]
lt)
                ((Tableau -> Tableau
sym2letter(Tableau -> Tableau) -> ([Int] -> Tableau) -> [Int] -> Tableau
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> Tableau
ytSymbols) [Int]
rt)

-- | Create all tableaux from two given tableaux.
allTsFromSyms :: Tableau -> Tableau -> [Tableau]
allTsFromSyms :: Tableau -> Tableau -> [Tableau]
allTsFromSyms Tableau
lts Tableau
rts | Tableau -> Int
nlines Tableau
lts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Tableau -> Int
nlines Tableau
rts = []
                      | Bool
otherwise = [Tableau] -> Tableau -> [Tableau]
go [Tableau
lts] Tableau
rts
                        where
                            go :: [Tableau] -> Tableau-> [Tableau]
                            go :: [Tableau] -> Tableau -> [Tableau]
go  [Tableau]
ts (Tableau []) = [Tableau]
ts
                            go  [] Tableau
_  = []
                            go  (Tableau
t:[Tableau]
ts) (Tableau (String
r:[String]
rs)) =
                                        [Tableau] -> Tableau -> [Tableau]
go (Tableau -> String -> [Tableau]
tabs1 Tableau
t String
r) ([String] -> Tableau
Tableau [String]
rs) [Tableau] -> [Tableau] -> [Tableau]
forall a. [a] -> [a] -> [a]
++
                                                    [Tableau] -> Tableau -> [Tableau]
go [Tableau]
ts ([String] -> Tableau
Tableau (String
rString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rs))


elemrow :: String -> Int
elemrow :: String -> Int
elemrow = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length(String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
strip

sym :: String -> String
sym :: ShowS
sym String
xs = (String -> Char
forall a. [a] -> a
head(String -> Char) -> ShowS -> String -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
strip) String
xs Char -> ShowS
forall a. a -> [a] -> [a]
: String
" "

strip :: String -> String
strip :: ShowS
strip String
xs = [Char
x | Char
x <- String
xs, Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ', Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#']

-- | Read a string of letters from a given tableau to be checked
--    for admissibility.
readTab :: Tableau -> String
readTab :: Tableau -> String
readTab (Tableau []) = String
""
readTab (Tableau (String
l:[String]
ls)) = (ShowS
stripShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowS
forall a. [a] -> [a]
reverse) String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tableau -> String
readTab ([String] -> Tableau
Tableau [String]
ls)

admisTabs :: [Tableau] -> [Tableau]
admisTabs :: [Tableau] -> [Tableau]
admisTabs = (Tableau -> Bool) -> [Tableau] -> [Tableau]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
admis(String -> Bool) -> (Tableau -> String) -> Tableau -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tableau -> String
readTab)

-- | Remove duplicate tableaux but keep different tableaux with
--   even with equal labels.
noDoubs :: [Tableau] -> [Tableau]
noDoubs :: [Tableau] -> [Tableau]
noDoubs [] = []
noDoubs (Tableau
t:[Tableau]
ts) | Tableau
t Tableau -> [Tableau] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Tableau]
ts = [Tableau] -> [Tableau]
noDoubs [Tableau]
ts
               | Bool
otherwise   = Tableau
t Tableau -> [Tableau] -> [Tableau]
forall a. a -> [a] -> [a]
: [Tableau] -> [Tableau]
noDoubs [Tableau]
ts

-- | Produce multiplet structure from combining two SU(n) multiplets
(><) :: [Int] -> [Int] -> [[Int]]
>< :: [Int] -> [Int] -> [[Int]]
(><) [Int]
l [Int]
r | [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r = []
         | Bool
otherwise = [Tableau] -> [[Int]]
ytsNums ([Tableau] -> [[Int]]) -> [Tableau] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Tableau] -> [Tableau]
noDoubs([Tableau] -> [Tableau])
-> ([Tableau] -> [Tableau]) -> [Tableau] -> [Tableau]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Tableau] -> [Tableau]
admisTabs ([Tableau] -> [Tableau]) -> [Tableau] -> [Tableau]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Tableau]
allTs [Int]
l [Int]
r

-- | Produce multiplet structure from combining a list of multiplets with
--   another multiplet
(>><) :: [[Int]] -> [Int] -> [[Int]]
>>< :: [[Int]] -> [Int] -> [[Int]]
(>><) [[Int]]
ls [Int]
r | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) [[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
l | [Int]
l <- [[Int]]
ls] =
                [[[Int]]] -> [[Int]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Int]
l [Int] -> [Int] -> [[Int]]
>< [Int]
r | [Int]
l <- [[Int]]
ls ]
           | Bool
otherwise = []

-- | Produce multiplet structure by combining one multiplet repeatedly
(><^) :: [Int] -> Int -> [[Int]]
><^ :: [Int] -> Int -> [[Int]]
(><^) [Int]
t Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = []
(><^) [Int]
t Int
n = [[Int]] -> [Int] -> Int -> [[Int]]
pot [[]] [Int]
t Int
n
    where   pot :: [[Int]] -> [Int] -> Int -> [[Int]]
            pot :: [[Int]] -> [Int] -> Int -> [[Int]]
pot [[Int]]
l [Int]
r Int
1 = [[Int]
r]
            pot [[Int]]
l [Int]
r Int
n = [[Int]] -> [Int] -> Int -> [[Int]]
pot [[Int]]
l [Int]
r (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)  [[Int]] -> [Int] -> [[Int]]
>>< [Int]
r

-- ghci> [1,0] >< [1,0] >>< [1,0]
-- [[3,0],[1,1],[1,1],[0,0]]

-- | Calculate the multiplicity of a multiplet
multi :: [Int] -> Int
multi :: [Int] -> Int
multi [] = Int
0
multi [Int]
is = Ratio Int -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Ratio Int -> Int) -> Ratio Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> Ratio Int
multt ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is) [Int]
is

multt :: Int -> [Int] -> Ratio Int
multt :: Int -> [Int] -> Ratio Int
multt Int
0 [Int]
_ = Ratio Int
1
multt Int
l [Int]
is = Int -> [Int] -> Ratio Int
multl Int
l [Int]
is Ratio Int -> Ratio Int -> Ratio Int
forall a. Num a => a -> a -> a
* Int -> [Int] -> Ratio Int
multt (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Int]
is

multl ::  Int -> [Int] -> Ratio Int
multl :: Int -> [Int] -> Ratio Int
multl Int
_ [] = Ratio Int
1
multl Int
l (Int
i:[Int]
is) | [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l =
                        (([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
l (Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) Int -> Int -> Ratio Int
forall a. Integral a => a -> a -> Ratio a
% Int
l) Ratio Int -> Ratio Int -> Ratio Int
forall a. Num a => a -> a -> a
* Int -> [Int] -> Ratio Int
multl Int
l [Int]
is
               | Bool
otherwise = Ratio Int
1

-- | Calculate the multiplicities of a list of multiplets
multis :: [[Int]] -> [Int]
multis :: [[Int]] -> [Int]
multis = ([Int] -> Int) -> [[Int]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int] -> Int
multi