From 513bc5e8933d4e16fe8eeb2d2f997a12a6a96a4a Mon Sep 17 00:00:00 2001
From: Jeshiba
Date: Thu, 13 Jul 2017 12:27:51 -0400
Subject: Checkpoint
---
Math/Combinatorics/PitmanTransform.hs | 29 +++++++++++++++++++++++++++++
1 file changed, 29 insertions(+)
create mode 100644 Math/Combinatorics/PitmanTransform.hs
(limited to 'Math/Combinatorics/PitmanTransform.hs')
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
--
cgit v1.2.1