[Haskell-cafe] Red-Blue Stack

Matthew Brecknell haskell at brecknell.org
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}



More information about the Haskell-Cafe mailing list