Thu Sep 25 18:14:51 EDT 2008

Matthew Eastman said:
> i.e. popping Blue in [Red, Red, Blue, Red, Blue] would give [Red, Red,
> Blue]

Hmm, did you mean [Red,Blue] or [Red,Red,Red,Blue]? Judging by your
implementation of remUseless, I'm guessing the latter.

Here is a more straightforward approach than apfelmus'. I store colours
separately, but count insertions so that I can easily reconstruct the
overall ordering. To save myself some work, I've generalised to an
arbitrary set of colours, though for O(1) behaviour, I'm assuming the
set of colours is bounded finite.

Unfortunately, this is still not quite O(1), due to the use of an
Integer which can grow without bound. In practice, though, I don't think
any of us will live long enough to notice.

\begin{code}

import qualified Data.Map as M
import Data.List
import Data.Maybe
import Control.Arrow

data CStack c a = CStack !Integer (M.Map c [(Integer,a)])

empty :: CStack c a
empty = CStack 0 M.empty

push :: Ord c => c -> a -> CStack c a -> CStack c a
push c x (CStack i m) = CStack (i+1) (M.insertWith (++) c [(i,x)] m)

popc :: Ord c => c -> CStack c a -> Maybe (a, CStack c a)
popc c (CStack i m) = do
cs <- M.lookup c m
(_,x) <- listToMaybe cs
return (x, CStack i (M.adjust tail c m))

pop :: Ord c => CStack c a -> Maybe ((c,a), CStack c a)
pop = undefined -- left as an exercise :-)

toList :: CStack c a -> [(c,a)]
toList (CStack _ m) = map snd (foldr merge [] (map dist (M.toList m)))
where
dist (c,xs) = map (second ((,) c)) xs
merge (xxs@((i,x):xs)) (yys@((j,y):ys))
| i > j = (i,x) : merge xs yys
| i < j = (j,y) : merge xxs ys
merge xs [] = xs
merge [] ys = ys

instance (Eq a, Eq c) => Eq (CStack c a) where
x == y = toList x == toList y

instance (Show a, Show c) => Show (CStack c a) where
show = show . toList

data RBColour = Red | Blue deriving (Eq,Ord,Show)
type RedBlueStack a = CStack RBColour a

\end{code}