From f1ad02cf7a29e3ad007bf58ac13ea8da96bfcd39 Mon Sep 17 00:00:00 2001 From: Jeshiba Date: Thu, 13 Jul 2017 15:10:58 -0400 Subject: added PitmanTransform and RobinsonSchensted. - Implemented Pitman's transforms, relying on RootSystem.hs - Tested by checking equality with Column insertion. - Moved row insertion from YoungTableaux to RobinsonSchensted - Implemented column insertion - Using Word where previously was [a] --- Math/Combinatorics/RobinsonSchensted.hs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) (limited to 'Math/Combinatorics/RobinsonSchensted.hs') diff --git a/Math/Combinatorics/RobinsonSchensted.hs b/Math/Combinatorics/RobinsonSchensted.hs index ffefc5a..a321708 100644 --- a/Math/Combinatorics/RobinsonSchensted.hs +++ b/Math/Combinatorics/RobinsonSchensted.hs @@ -10,12 +10,13 @@ ---------------------------------------------------------------------------- module RobinsonSchensted where import YoungTableaux +import Prelude hiding (Word) -- |Plactic monoid instance Ord a => Monoid (SSYT a) where mempty = S $ repeat [] - mappend s1 s2 = foldl rowInsert s1 (toRowWord s2) + mappend s1 s2 = foldl rowInsert s1 xs where W xs = toRowWord s2 -- |Row insertion algorithm rowInsert :: Ord a => SSYT a -> a -> SSYT a @@ -38,16 +39,16 @@ colInsert'' :: Ord a => [[a]] -> a -> [[a]] colInsert'' t x = case break (>=x) (head t) of (r, []) -> (r ++ [x]):(tail t) - (r1, r2) -> (r1 ++ x:(tail r2)):(rowInsert' (tail t) (head r2)) + (r1, r2) -> (r1 ++ x:(tail r2)):(colInsert'' (tail t) (head r2)) -- |The Robinson-Schensted algorithm -robinsonSchensted :: Ord a => [a] -> SSYT a -robinsonSchensted = foldl rowInsert mempty +robinsonSchensted :: Ord a => Word a -> SSYT a +robinsonSchensted (W xs) = foldl rowInsert mempty xs -- |The Robinson-Schensted algorithm with column insertion -robinsonSchensted' :: Ord a => [a] -> SSYT a -robinsonSchensted' = foldl colInsert mempty +robinsonSchensted' :: Ord a => Word a -> SSYT a +robinsonSchensted' (W xs) = foldl colInsert mempty xs -prop_ReduceWord_RobinsonSchensted :: [Int] -> Bool -prop_ReduceWord_RobinsonSchensted xs = (toRowWord $ robinsonSchensted xs) == (reduceWord xs) +prop_ReduceWord_RobinsonSchensted :: Word Int -> Bool +prop_ReduceWord_RobinsonSchensted w = (toRowWord $ robinsonSchensted w) == (reduceWord w) -- cgit v1.2.3