aboutsummaryrefslogtreecommitdiff
path: root/Math/Combinatorics/PitmanTransform.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Math/Combinatorics/PitmanTransform.hs')
-rw-r--r--Math/Combinatorics/PitmanTransform.hs36
1 files changed, 13 insertions, 23 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))