MultipletCombiner (empty) → 0.0.1
raw patch · 6 files changed
+481/−0 lines, 6 filesdep +basebinary-added
Dependencies added: base
Files
- LICENSE +29/−0
- MultipletCombiner.cabal +48/−0
- README +23/−0
- multiplets.pdf binary
- src/Physics/MultipletCombiner.hs +349/−0
- tests/MultipletCombinerTests.hs +32/−0
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2023, Michael Dressel+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ MultipletCombiner.cabal view
@@ -0,0 +1,48 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name: MultipletCombiner+version: 0.0.1+synopsis: A Haskell implementation for combining SU(n) multiplets.+description: See README at <https://github.com/mdrslmr/MultipletCombiner>+category: physics,library,science,math,groups+homepage: https://github.com/mdrslmr/MultipletCombiner#readme+bug-reports: https://github.com/mdrslmr/MultipletCombiner/issues+maintainer: Michael Dressel <michael.dressel@kloenplatz.de>+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README+ multiplets.pdf++source-repository head+ type: git+ location: https://github.com/mdrslmr/MultipletCombiner++library+ exposed-modules:+ Physics.MultipletCombiner+ other-modules:+ Paths_MultipletCombiner+ hs-source-dirs:+ src+ build-depends:+ base ==4.15.*+ default-language: Haskell2010++test-suite spec+ type: exitcode-stdio-1.0+ main-is: MultipletCombinerTests.hs+ other-modules:+ Physics.MultipletCombiner+ Paths_MultipletCombiner+ hs-source-dirs:+ src+ tests+ build-depends:+ base ==4.15.*+ default-language: Haskell2010
+ README view
@@ -0,0 +1,23 @@++ MultipletCombiner+ =================++A Haskell implementation for combining SU(n) multiplets according+to the algorithm described in the particle data book (2021) section 48, see++ https://pdg.lbl.gov/2022/reviews/rpp2022-rev-young-diagrams.pdf+.++See LICENSE.++Description:+ https://github.com/mdrslmr/MultipletCombiner/blob/main/multiplets.pdf++Subdirectories:++src:+ The Haskell source code of the algorithm to be used e.g. within ghci.++tests:+ Some tests using HUnit.+
+ multiplets.pdf view
binary file changed (absent → 172685 bytes)
+ src/Physics/MultipletCombiner.hs view
@@ -0,0 +1,349 @@+{- |+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 combinaing 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+ (+ -- * Kroneker product like operators+ (><),+ (>><),+ -- * Multiplicitiy 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 (Eq)+instance Show Tableau where+ show (Tableau t) = unlines t++-- | Show like function to display a list of tableaux.+showt :: [Tableau] -> String+showt [] = "----"+showt [t] = show t ++ "----"+showt (t:ts) = show t ++ "----\n" ++ showt 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 [] = Tableau []+ytSymbols is = go (reverse is) (Tableau ["# "])+ where+ go :: [Int] -> Tableau -> Tableau+ go [] t = t+ go (i:is) (Tableau (r:rs)) = go is $ Tableau $+ concat (r : replicate i "# ") : r : rs+-- | Build multiple tableaux from multiple labels.+ytsSymbols :: [[Int]] -> [Tableau]+ytsSymbols = map ytSymbols+++-- | Calculate the number representation from a tableau.+ytNums :: Tableau -> [Int]+ytNums (Tableau []) = []+ytNums (Tableau [l]) = []+ytNums (Tableau (l:m:ns)) = length l' - length m' : ytNums (Tableau (m:ns))+ where l' = noBlank l+ m' = noBlank m+ noBlank :: String -> String+ noBlank xs = [ x | x <- xs, x /= ' ']++-- | Calculate the list of labels fro a list of tableaux.+ytsNums :: [Tableau] -> [[Int]]+ytsNums [] = []+ytsNums (t:ts) = case ytNums t of+ [] -> ytsNums ts+ is -> is : ytsNums ts++-- | Check for the string for being composed of admissible letters.+-- | Admissible and not admissible examples:+--+-- @+--+-- admis "aabacdaebbcbd" = True+--+-- last letter not admissable+-- admis "abacae" = False+-- admis "abacdec" = False+--+-- @++admis :: String -> Bool+admis xs = case unchain 'a' xs of+ Nothing -> False+ Just [] -> True+ Just cs -> admis cs++-- | Extract one strictly ordered chain from the given string, starting+-- at the given character.+unchain :: Char -> String -> Maybe String+unchain _ [] = Just []+unchain x (c:cs) | x==c = unchain (chr (ord x +1)) cs+ | c<x = case unchain x cs of+ Nothing -> Nothing+ Just cs'-> Just (c:cs')+ | c>x = Nothing++-- | Convert a tableau of symbols into a tableau of letters+sym2letter :: Tableau -> Tableau+sym2letter (Tableau xss) = Tableau $+ zipWith line2let xss ['a'..]+ where line2let :: String -> Char -> String+ line2let [] _ = []+ line2let (x:xs) c | x == '#' = c:line2let xs c+ | x == ' ' = x:line2let xs c+++-- | Append a string to the i'th line of a tableau.+appendAt :: Int -> String -> Tableau -> Tableau+appendAt _ _ (Tableau []) = Tableau []+appendAt _ [] t = t+appendAt i s (Tableau ts) | i > length ts || i < 1 = Tableau []+ | otherwise = Tableau $ take (i-1) ts ++ [(ts !! (i-1)) ++ s]+ ++ drop i 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 t c = go t c [[]]+ where+ go :: Int -> Int -> [[Int]] -> [[Int]]+ go _ 0 is = is+ go 0 _ is = is+ go t c is = go t (c-1) (extend t is)++extend :: Int -> [[Int]] -> [[Int]]+extend p is = [ x:y | x <- [1..p], y <- 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 _ t [] = t+newtab s t (i:is) = newtab s (appendAt i s t) 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 t r = go t s (combis j k)+ where+ go :: Tableau -> String -> [[Int]] -> [Tableau]+ go _ _ [] = []+ go t s (is:iss) | rowsOK t' && colsOK t' = t' : go t s iss+ | otherwise = go t s iss+ where+ t' = newtab s t is+ s = sym r+ j = nlines t+ k = elemrow r++nlines :: Tableau -> Int+nlines (Tableau ts) = length ts++rowsOK :: Tableau -> Bool+rowsOK (Tableau []) = True+rowsOK (Tableau [x]) = True+rowsOK (Tableau (x:y:zs)) = length x >= length y && rowsOK (Tableau (y:zs))++colsOK :: Tableau -> Bool+colsOK (Tableau []) = True+colsOK (Tableau [s]) = True+colsOK (Tableau (x:y:zs)) = col2OK x y && colsOK (Tableau (y:zs))++col2OK :: String -> String -> Bool+col2OK _ [] = True+col2OK [] _ = True+col2OK (l:ls) (r:rs) | l == ' ' || r == ' ' = col2OK ls rs+ | l == '#' || r == '#' = col2OK ls rs+ | l == r = False+ | otherwise = col2OK ls 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 lt rt | length lt /= length rt = []+ | otherwise = allTsFromSyms (ytSymbols lt)+ ((sym2letter.ytSymbols) rt)++-- | Create all tableaux from two given tableaux.+allTsFromSyms :: Tableau -> Tableau -> [Tableau]+allTsFromSyms lts rts | nlines lts /= nlines rts = []+ | otherwise = go [lts] rts+ where+ go :: [Tableau] -> Tableau-> [Tableau]+ go ts (Tableau []) = ts+ go [] _ = []+ go (t:ts) (Tableau (r:rs)) =+ go (tabs1 t r) (Tableau rs) +++ go ts (Tableau (r:rs))+++elemrow :: String -> Int+elemrow = length.strip++sym :: String -> String+sym xs = (head.strip) xs : " "++strip :: String -> String+strip xs = [x | x <- xs, x /= ' ', x /= '#']++-- | Read a string of letters from a given tableau to be checked+-- for admissibility.+readTab :: Tableau -> String+readTab (Tableau []) = ""+readTab (Tableau (l:ls)) = (strip.reverse) l ++ readTab (Tableau ls)++admisTabs :: [Tableau] -> [Tableau]+admisTabs = filter (admis.readTab)++-- | Remove duplicate tableaux but keep different tableaux with+-- even with equal labels.+noDoubs :: [Tableau] -> [Tableau]+noDoubs [] = []+noDoubs (t:ts) | t `elem` ts = noDoubs ts+ | otherwise = t : noDoubs ts++-- | Produce multiplet structure from combining two SU(n) multiplets+(><) :: [Int] -> [Int] -> [[Int]]+(><) l r | length l /= length r = []+ | otherwise = ytsNums $ noDoubs.admisTabs $ allTs l r++-- | Produce multiplet structure from combining a list of multiplets with+-- another multiplet+(>><) :: [[Int]] -> [Int] -> [[Int]]+(>><) ls r | all (length r ==) [length l | l <- ls] =+ concat [ l >< r | l <- ls ]+ | otherwise = []++-- 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 is = round $ multt (length is) is++multt :: Int -> [Int] -> Ratio Int+multt 0 _ = 1+multt l is = multl l is * multt (l-1) is++multl :: Int -> [Int] -> Ratio Int+multl _ [] = 1+multl l (i:is) | length (i:is) >= l =+ ((sum (take l (i:is)) + l) % l) * multl l is+ | otherwise = 1++-- | Calculate the multiplicities of a list of multiplets+multis :: [[Int]] -> [Int]+multis = fmap multi
+ tests/MultipletCombinerTests.hs view
@@ -0,0 +1,32 @@+import Test.HUnit+import Physics.MultipletCombiner++comb1 = TestCase (assertEqual "[1] >< [1], " [[2],[0]] ([1] >< [1]))+comb2 = TestCase (assertEqual "[1,0] >< [0,1], " [[1,1],[0,0]] ([1,0] >< [0,1]))++multi1 = TestCase (assertEqual "n in [2], " 3 (multi [2]))+multi2 = TestCase (assertEqual "n in octet [1,1], " 8 (multi [1,1]))+multi3 = TestCase (assertEqual "n in decuplet [3,0], " 10 (multi [3,0]))++yt1 = TestCase (assertEqual "yt [0], " "# \n# \n"+ (show $ ytSymbols [0]))+yt2 = TestCase (assertEqual "yt [1], " "# # \n# \n"+ (show $ ytSymbols [1]))+yt3 = TestCase (assertEqual "yt [0,0], " "# \n# \n# \n"+ (show $ ytSymbols [0,0]))+yt4 = TestCase (assertEqual "yt [1,0], " "# # \n# \n# \n"+ (show $ ytSymbols [1,0]))+yt5 = TestCase (assertEqual "yt [2,1], " "# # # # \n# # \n# \n"+ (show $ ytSymbols [2,1]))++tests = TestList [TestLabel "comb1" comb1,+ TestLabel "comb2" comb2,+ TestLabel "multi1" multi1,+ TestLabel "multi2" multi2,+ TestLabel "multi3" multi3,+ TestLabel "yt1" yt1,+ TestLabel "yt2" yt2,+ TestLabel "yt3" yt3,+ TestLabel "yt4" yt4,+ TestLabel "yt5" yt5]+