**diff options**

Diffstat (limited to 'Math/Combinatorics/PitmanTransform.hs')

-rw-r--r-- | Math/Combinatorics/PitmanTransform.hs | 29 |

1 files changed, 29 insertions, 0 deletions

diff --git a/Math/Combinatorics/PitmanTransform.hs b/Math/Combinatorics/PitmanTransform.hs new file mode 100644 index 0000000..19a437f --- /dev/null +++ b/Math/Combinatorics/PitmanTransform.hs @@ -0,0 +1,29 @@ +--import Math.Combinatorics.RootSystem hiding (s) +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 qualified Data.List as L + +--pitman :: (Fractional a, Ord a) => Type -> Int -> [a] -> [a] +pitman :: Type -> Int -> [[Q]] -> [[Q]] +pitman t n xs = foldr s xs (longestElement $ simpleSystem t n) + +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 (+) + +word2Path :: Word Int -> [[Q]] +word2Path (W xs) = L.transpose $ cumSum <$> [0:(indicator (==k) xs) | k <- [1..maximum xs]] + +indicator :: (a -> Bool) -> [a] -> [Q] +indicator f xs = (\x -> if f x then 1 else 0) <$> xs |