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}