blob: 0379bcea851cadf627975e2ba51235a22d0ec9d1 (
plain) (
tree)
|
|
----------------------------------------------------------------------------
--
-- Copyright : (C) 2017 Yuchen Pei
-- License : GPLv3+
--
-- Maintainer : Yuchen Pei
-- Stability : experimental
-- Portability : non-portable
--
----------------------------------------------------------------------------
--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 Test.QuickCheck
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 []) = []
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
pitmanA :: [[Q]] -> [[Q]]
pitmanA [] = []
pitmanA xs =
let n = length $ head xs in
if n == 1 then xs else pitman A (n - 1) xs
pitmanAShape :: [[Q]] -> [Q]
pitmanAShape = last . pitmanA
pitmanAGTP :: [[Q]] -> GTP Q
pitmanAGTP = GTP . (pitmanAGTP' []) where
pitmanAGTP' :: [[Q]] -> [[Q]] -> [[Q]]
pitmanAGTP' xs [] = xs
pitmanAGTP' xs ys = pitmanAGTP' ((pitmanAShape ys):xs) (L.transpose $ init $ L.transpose ys)
prop_Pitman_RobinsonSchensted :: [Int] -> Bool
prop_Pitman_RobinsonSchensted xs =
let w = prop_Pitman_RobinsonSchensted_sanitise xs in
(pitmanAGTP $ word2Path w) == (gTPFromInt $ sSYT2GTP $ robinsonSchensted' w)
gTPFromInt :: GTP Int -> GTP Q
gTPFromInt (GTP xs) = GTP $ fmap (fmap fromIntegral) xs
prop_Pitman_RobinsonSchensted_sanitise :: [Int] -> Word Int
prop_Pitman_RobinsonSchensted_sanitise = W . (fmap (\t -> abs t + 1))
randomQMatrix :: Int -> Gen [[Q]]
randomQMatrix n = vectorOf 20 (vector n)
prop_Pitman_WeylChamber :: Int -> Property
prop_Pitman_WeylChamber m = let (t, n) = int2TypeInt m in
forAll (randomQMatrix $ dimensionOfHostSpace t n) (\xs -> isInWeylChamber $ pitman t n xs)
|