---------------------------------------------------------------------------- -- -- Copyright : (C) 2017 Yuchen Pei -- License : GPLv3+ -- -- Maintainer : Yuchen Pei -- Stability : experimental -- Portability : non-portable -- ---------------------------------------------------------------------------- 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 xs where W xs = toRowWord s2 -- |Row insertion algorithm rowInsert :: Ord a => SSYT a -> a -> SSYT a rowInsert (S t) = toSSYT . (rowInsert' t) -- |Row insertion algorithm on an SSYT as a nested list rowInsert' :: Ord a => [[a]] -> a -> [[a]] rowInsert' t x = case break (>x) (head t) of (r, []) -> (r ++ [x]):(tail t) (r1, r2) -> (r1 ++ x:(tail r2)):(rowInsert' (tail t) (head r2)) colInsert :: Ord a => SSYT a -> a -> SSYT a colInsert st = transpose . (colInsert' (transpose st)) colInsert' :: Ord a => SSYT a -> a -> SSYT a colInsert' (S t) = toSSYT . (colInsert'' t) 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)):(colInsert'' (tail t) (head r2)) -- |The Robinson-Schensted algorithm robinsonSchensted :: Ord a => Word a -> SSYT a robinsonSchensted (W xs) = foldl rowInsert mempty xs -- |The Robinson-Schensted algorithm with column insertion robinsonSchensted' :: Ord a => Word a -> SSYT a robinsonSchensted' (W xs) = foldl colInsert mempty xs prop_ReduceWord_RobinsonSchensted :: Word Int -> Bool prop_ReduceWord_RobinsonSchensted w = (toRowWord $ robinsonSchensted w) == (reduceWord w)