blob: a321708acd2d2b1c4c596d32acb37a63c10d668c (
plain) (
tree)
|
|
----------------------------------------------------------------------------
--
-- 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)
|