----------------------------------------------------------------------------
-- 
-- Copyright   :  (C) 2017 Yuchen Pei
-- License     :  GPLv3+
--
-- Maintainer  :  Yuchen Pei
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module RobinsonSchensted where
import YoungTableaux

-- |Plactic monoid
instance Ord a => Monoid (SSYT a)
  where
    mempty = S $ repeat []
    mappend s1 s2 = foldl rowInsert s1 (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)):(rowInsert' (tail t) (head r2))

-- |The Robinson-Schensted algorithm
robinsonSchensted :: Ord a => [a] -> SSYT a
robinsonSchensted = foldl rowInsert mempty

-- |The Robinson-Schensted algorithm with column insertion
robinsonSchensted' :: Ord a => [a] -> SSYT a
robinsonSchensted' = foldl colInsert mempty

prop_ReduceWord_RobinsonSchensted :: [Int] -> Bool
prop_ReduceWord_RobinsonSchensted xs = (toRowWord $ robinsonSchensted xs) == (reduceWord xs)