diff options
Diffstat (limited to 'Math')
| -rw-r--r-- | Math/Combinatorics/RootSystem.hs | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/Math/Combinatorics/RootSystem.hs b/Math/Combinatorics/RootSystem.hs index 9ed7c89..716819c 100644 --- a/Math/Combinatorics/RootSystem.hs +++ b/Math/Combinatorics/RootSystem.hs @@ -66,10 +66,12 @@ s :: [Q] -> [Q] -> [Q] s alpha beta = beta <-> (dynkinIndex alpha beta) *> alpha
+-- |The indices of the simple roots in the reduced decomposition of the longest elements
longestElementIndex :: SimpleSystem -> [Int]
longestElementIndex ss = (+1) <$> fromJust <$> flip elemIndex ss <$> longestElement ss
+-- |The reduced decomposition of the longest elements
longestElement :: SimpleSystem -> [[Q]]
longestElement ss = longestElement' [] posRoots
where
@@ -95,6 +97,8 @@ positiveRoots' cm = positiveRoots'' [] (iMx $ length cm) | null npr = pr
| otherwise = positiveRoots'' (pr ++ npr) (S.toList . S.fromList $ mconcat $ zipWith newRootIndices npr (pIndex pr cm <$> npr))
+-- |calculate the successors of ri in the simple string
+-- |given root index ri and its p-vector pi
newRootIndices :: [Q] -> [Q] -> [[Q]]
newRootIndices ri pi = (ri <+>) <$> (go pi [] 1)
where go :: [Q] -> [Int] -> Int -> [[Q]]
@@ -102,9 +106,12 @@ newRootIndices ri pi = (ri <+>) <$> (go pi [] 1) go (x:xs) ys k = go xs (if x == 0 then ys else ys ++ [k]) (k + 1)
+-- |given the already-found positive roots allRootIndices,
+-- |the transposed Cartan Matrix cm and the root index, calculate its p-vector
pIndex :: [[Q]] -> [[Q]] -> [Q] -> [Q]
pIndex allRootIndices cm rootIndex = (mIndex rootIndex allRootIndices) <-> (dynkinIndex' rootIndex cm)
+-- |given the root index and all already-found positive roots, calculate its m-vector
mIndex :: [Q] -> [[Q]] -> [Q]
mIndex rootIndex allRootIndices =
if isMultBasis rootIndex
@@ -151,6 +158,7 @@ numRoots F 4 = 48 numRoots G 2 = 12
+-- |Auxilieary function to transform an Int to a Root system for quick check
int2TypeInt :: Int -> (Type, Int)
int2TypeInt n
| n > 108 = int2TypeInt (n `mod` 108 + 1)
@@ -196,6 +204,11 @@ allRoots ss = S.toList $ closure S.empty (S.fromList ss) where boundary' = S.fromList [s alpha beta | alpha <- ss, beta <- S.toList boundary] S.\\ interior'
in closure interior' boundary'
+-- | Test that the length of the longest element is half of the number of roots
+prop_longestElement :: Int -> Bool
+prop_longestElement n = let (t, m) = int2TypeInt n in
+ numRoots t m == 2 * (length $ longestElement $ simpleSystem t m)
+
-- Old code in HaskellForMaths
{--
-- WEYL GROUP
|