blob: 19a437ffc46e5c0cd9375370ad3fab35532bf8e9 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
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
|
