cleaned up the code.

- removed useless comments
- added documentation, mainly in PitmanTransform.hs

3 files changed, 15 insertions, 39 deletions

diff --git a/Math/Combinatorics/PitmanTransform.hs b/Math/Combinatorics/PitmanTransform.hs
index fa979d7..1f17571 100644
--- a/Math/Combinatorics/PitmanTransform.hs
+++ b/Math/Combinatorics/PitmanTransform.hs
@@ -12,14 +12,13 @@
 import RootSystem hiding (s)
 import YoungTableaux
 import RobinsonSchensted
---import Math.Algebra.Field.Base (Q)-- for Q
 import Math.Algebra.LinearAlgebra
 import Prelude hiding ( (*>), Word )
 import Test.QuickCheck
 import qualified Data.List as L
 import Data.Ratio
 
---pitman :: (Fractional a, Ord a) => Type -> Int -> [a] -> [a]
+-- |pitman t n xs is the Pitman's transform of type t_n acting on path xs. It pre-processes xs by prepending a row of zeros to the input and post-processes by removing the first row of the output
 pitman :: Type -> Int -> [[Q]] -> [[Q]]
 pitman t n xs = tail $ foldr s (prependWithZero xs) (longestElement $ simpleSystem t n)
 
@@ -27,25 +26,29 @@ prependWithZero :: [[Q]] -> [[Q]]
 prependWithZero [] = []
 prependWithZero xs = (replicate (length $ head xs) 0) : xs
 
+-- |s alpha f: the cumulative infimum of twice the projection of path f on root alpha
 s :: [Q] -> [[Q]] -> [[Q]]
---s :: (Fractional a, Ord a) => [a] -> [a] -> [a]
 s alpha f = f <<->> fmap (*> alpha) (cumMin $ dynkinIndex alpha <$> f) 
 
---cumMin :: Ord a => [a] -> [a]
 cumMin :: [Q] -> [Q]
 cumMin = scanl1 min
 
 cumSum :: [Q] -> [Q]
 cumSum = scanl1 (+)
 
+
+-- |transform a word to a path
 word2Path :: Word Int -> [[Q]]
 word2Path (W []) = []
---word2Path (W xs) = L.transpose $ cumSum <$> [0:(indicator (==k) xs) | k <- [1..maximum xs]]
 word2Path (W xs) = L.transpose $ cumSum <$> [indicator (==k) xs | k <- [1..maximum xs]]
 
+
+-- |indicator function
 indicator :: (a -> Bool) -> [a] -> [Q]
 indicator f xs = (\x -> if f x then 1 else 0) <$> xs
 
+
+-- |Pitman's transform of type A
 pitmanA :: [[Q]] -> [[Q]]
 pitmanA [] = []
 pitmanA xs = 
@@ -55,6 +58,8 @@ pitmanA xs =
 pitmanAShape :: [[Q]] -> [Q]
 pitmanAShape = last . pitmanA
 
+
+-- |RS via Pitman's transform of type A
 pitmanAGTP :: [[Q]] -> GTP Q
 pitmanAGTP = GTP . (pitmanAGTP' []) where 
     pitmanAGTP' :: [[Q]] -> [[Q]] -> [[Q]]
@@ -62,6 +67,7 @@ pitmanAGTP = GTP . (pitmanAGTP' []) where
     pitmanAGTP' xs ys = pitmanAGTP' ((pitmanAShape ys):xs) (L.transpose $ init $ L.transpose ys)
 
 
+-- |QuickCheck property that the Pitman's transform of type A coincides with RS algorithm
 prop_Pitman_RobinsonSchensted :: [Int] -> Bool
 prop_Pitman_RobinsonSchensted xs = 
     let w = prop_Pitman_RobinsonSchensted_sanitise xs in
@@ -74,6 +80,7 @@ prop_Pitman_RobinsonSchensted_sanitise :: [Int] -> Word Int
 prop_Pitman_RobinsonSchensted_sanitise = W . (fmap (\t -> abs t + 1))
 
 
+-- |QuickCheck generator that generates rational numbers with small numerators and denominators
 smallRational :: Gen Q
 smallRational = do
     x <- smallInt
@@ -82,16 +89,6 @@ smallRational = do
     --return $ (toInteger x) / (toInteger (abs y + 1)) -- this line does not work for Q = Math.Algebra.Field.Base.Q - Couldn't match type ‘Integer’ with ‘Q’
 
 
---smallRational :: Gen Q
---smallRational = getSmall <$> (arbitrary :: Gen (Small Q))
-
---mediumInt :: Gen Int
---mediumInt = do
-    --x <- smallInt
-    --y <- smallInt
-    --return $ x * y
-
-
 smallInt :: Gen Int
 smallInt = getSmall <$> (arbitrary :: Gen (Small Int))
 
@@ -101,14 +98,7 @@ arbRational = arbitrary
 randomQMatrix :: Int -> Gen [[Q]]
 randomQMatrix n = vectorOf 20 $ vectorOf n smallRational
 
+-- |QuickCheck property that the output of the Pitman's transform is in the Weyl Chamber, for any type.
 prop_Pitman_WeylChamber :: Int -> Property
 prop_Pitman_WeylChamber m = let (t, n) = int2TypeInt m in
     forAll (randomQMatrix $ dimensionOfHostSpace t n) (\xs -> isInWeylChamber (simpleSystem t n) (last $ pitman t n xs))
-
-prop_PitmanA_WeylChamber :: Int -> Property
-prop_PitmanA_WeylChamber n = let m = (n `mod` 2) + 1 in
-    forAll (randomQMatrix $ m + 1) (\xs -> isInWeylChamber (simpleSystem A m) (last $ pitman A m xs))
-
---prop_PitmanA_WeylChamber :: Property
---prop_PitmanA_WeylChamber = let m = (1 `mod` 2) + 1 in
-    --forAll (randomQMatrix $ m + 1) (\xs -> isInWeylChamber (simpleSystem A m) (last $ pitman A m xs))
diff --git a/Math/Combinatorics/RootSystem.hs b/Math/Combinatorics/RootSystem.hs
index a1674b7..9ed7c89 100644
--- a/Math/Combinatorics/RootSystem.hs
+++ b/Math/Combinatorics/RootSystem.hs
@@ -9,15 +9,9 @@ import Prelude hiding ( (*>) )
 import Data.Ratio

 import Data.List

 import Data.Maybe

---import qualified Data.List as L

 import qualified Data.Set as S

 

 import Math.Algebra.LinearAlgebra

---import Math.Algebra.Group.PermutationGroup hiding (elts, order, closure)

---import Math.Algebra.Group.SchreierSims as SS

---import Math.Algebra.Group.StringRewriting as SG

-

---import Math.Algebra.Field.Base (Q)-- for Q

 

 type Q = Rational

 data Type = A | B | C | D | E | F | G deriving Show

@@ -64,11 +58,9 @@ simpleSystem t n = error $ "Invalid root system of type " ++ (show t) ++ " and r
 

 dimensionOfHostSpace :: Type -> Int -> Int

 dimensionOfHostSpace t n = length $ head $ simpleSystem t n

--- ROOT SYSTEMS

--- Calculating the full root system from the fundamental roots

 

 -- Humphreys p3

--- Weyl group element corresponding to a root

+-- Reflection corresponding to a root

 -- s alpha beta = s_\alpha \beta

 s :: [Q] -> [Q] -> [Q]

 s alpha beta = beta <-> (dynkinIndex alpha beta) *> alpha

@@ -90,9 +82,6 @@ longestElement ss = longestElement' [] posRoots
                 else let alpha = (head (S.toList ys)) in

                          longestElement' (alpha:xs) (s alpha <$> rs)

         

---negateM :: Num a => [[a]] -> [[a]]

---negateM = fmap (fmap negate)

-

 

 -- |all positive roots

 positiveRoots :: SimpleSystem -> [[Q]]

@@ -207,7 +196,7 @@ 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'

 

-

+-- Old code in HaskellForMaths

 {--

 -- WEYL GROUP

 -- The finite reflection group generated by the root system

diff --git a/Math/Combinatorics/YoungTableaux.hs b/Math/Combinatorics/YoungTableaux.hs
index 683519f..357927c 100644
--- a/Math/Combinatorics/YoungTableaux.hs
+++ b/Math/Combinatorics/YoungTableaux.hs
@@ -73,9 +73,6 @@ reduceWord'' :: Ord a => [a] -> [a]
 reduceWord'' xs
   | length xs <= 2 = xs
   | otherwise      = let ys = reduceWord'' $ init xs in reduceWord' (init $ init ys) (last $ init ys, last ys, last xs) []
-  {-- | otherwise      = let ys = reduceWord $ init xs in 
-                     let (zs, ws) = splitAt (length ys - 2) ys in
-                       reduceWord'' zs (ws ++ [last xs]) --}
 
 reduceWord' :: Ord a => [a] -> (a, a, a) -> [a] -> [a]
 reduceWord' [] (u, v, w) ys =