From 6134f1f3b075376bdb6a9a086191c2bd35028877 Mon Sep 17 00:00:00 2001
From: Jeshiba <baconp@gmail.com>
Date: Fri, 23 Jun 2017 16:16:15 -0400
Subject: added SSYT and Wrd datatypes; added comments.

---
 Math/Combinatorics/.YoungTableaux.hs.swp | Bin 12288 -> 0 bytes
 Math/Combinatorics/YoungTableaux.hs      |  60 +++++++++++++++++++------------
 2 files changed, 38 insertions(+), 22 deletions(-)
 delete mode 100644 Math/Combinatorics/.YoungTableaux.hs.swp

diff --git a/Math/Combinatorics/.YoungTableaux.hs.swp b/Math/Combinatorics/.YoungTableaux.hs.swp
deleted file mode 100644
index 0e4e515..0000000
Binary files a/Math/Combinatorics/.YoungTableaux.hs.swp and /dev/null differ
diff --git a/Math/Combinatorics/YoungTableaux.hs b/Math/Combinatorics/YoungTableaux.hs
index 8964469..ada2da1 100644
--- a/Math/Combinatorics/YoungTableaux.hs
+++ b/Math/Combinatorics/YoungTableaux.hs
@@ -1,36 +1,52 @@
-type Tableau a = [[a]]
---data SSYT a = S [[a]]
-type SSYT a = [[a]]
-type GT a = [[a]]
+--import Data.Monoid ((<>))
 
---instance Show a => Show (SSYT a)
-  --where show (S xs) = show $ fst $ break null xs
+data SSYT a = S [[a]]
+data Wrd a = W [a] deriving Show
 
+-- |Knuth equivalence
+instance Ord a => Eq (Wrd a)
+  where (W xs) == (W ys) = (reduceWord xs) == (reduceWord ys)
+
+-- |Show a tableau
+instance Show a => Show (SSYT a)
+  where show (S xs) = "S " ++ (show $ truncList xs)
+
+-- |Plactic monoid
+instance Ord a => Monoid (SSYT a)
+  where
+    mempty = S $ repeat []
+    mappend s1 s2 = foldl rowInsert s1 (toRowWord s2)
+
+-- |Convert a nested list to an SSYT
+toSSYT :: [[a]] -> SSYT a
+toSSYT t = S $ (truncList t) ++ (repeat [])
+
+-- |Row insertion algorithm
 rowInsert :: Ord a => SSYT a -> a -> SSYT a
-rowInsert t = truncInfList . rowInsert' (t ++ (repeat []))
+rowInsert (S t) = S . rowInsert' t
 
-rowInsert' :: Ord a => SSYT a -> a -> SSYT a
+-- |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))
 
+-- |The Robinson-Schensted algorithm
 robinsonSchensted :: Ord a => [a] -> SSYT a
-robinsonSchensted = truncInfList . foldl rowInsert' (repeat [])
+robinsonSchensted = foldl rowInsert mempty
 
-truncInfList :: [[a]] -> [[a]]
-truncInfList = fst . break null
+-- |Truncate a nested list (tableau) by disgarding empty rows
+truncList :: [[a]] -> [[a]]
+truncList = fst . break null
 
+-- |Convert an SSYT to a row word
 toRowWord :: Ord a => SSYT a -> [a]
-toRowWord = concat . reverse
+toRowWord (S t) = concat $ reverse $ truncList t
 
-{--
-rowInsert :: Ord a => SSYT a -> a -> SSYT a
-rowInsert (S t) x = 
-  case break (>x) (head t) of
-    (r, []) -> S $ (r ++ [x]):(tail t)
-    (r1, r2) -> let S s = rowInsert (S (tail t)) (head r2) in S $ (r1 ++ x:(tail r2)):s
-    --}
+-- |Whether a word is a row word
+isRowWord :: Ord a => [a] -> Bool
+isRowWord = isRowWord' [] []
 
 isRowWord' :: Ord a => [a] -> [a] -> [a] -> Bool
 isRowWord' _  ys [] = ys == []
@@ -41,9 +57,7 @@ isRowWord' xs ys zs =
     then head ys > head zs && (isRowWord' (xs ++ [head zs]) (tail ys) (tail zs))
     else ys == [] && isRowWord' [] xs zs
 
-isRowWord :: Ord a => [a] -> Bool
-isRowWord = isRowWord' [] []
-
+-- |Reduce a word to a row word
 reduceWord :: Ord a => [a] -> [a]
 reduceWord xs
   | length xs <= 2 = xs
@@ -68,6 +82,7 @@ reduceWord' xs (u, v, w) ys =
                     else reduceWord' (init xs) (last xs, v, u) (w:ys)
       else reduceWord' (init xs) (last xs, u, v) (w:ys)
 
+-- |QuickCheck properties
 prop_ReduceWord :: [Int] -> Bool
 prop_ReduceWord = isRowWord . reduceWord
 
@@ -77,6 +92,7 @@ prop_ReduceWord' xs = (length xs) == (length $ reduceWord xs)
 prop_ReduceWord_RobinsonSchensted :: [Int] -> Bool
 prop_ReduceWord_RobinsonSchensted xs = (toRowWord $ robinsonSchensted xs) == (reduceWord xs)
 
+-- |Another implementation of reduceWord' in case of performance difference.
 reduceWord'' :: Ord a => [a] -> [a] -> [a]
 reduceWord'' [] (u:v:w:ys) =
   if isRowWord (u:v:w:ys)
-- 
cgit v1.2.3