-- Dijkstras Dutch Flag Problem
-- ============================
-- Eine Liste mit rot, weiss oder blau gefaerbten Objekten 
-- soll so umsortiert werden, dass zunaechst alle roten,
-- dann alle weissen und schliesslich alle blauen Objekte
-- auftreten. Dabei soll die relative Ordnung der gleichfarbigen
-- Objekte untereinander erhalten bleiben.
import DifferenceLists

data Dutch a = Red a |  White a | Blue a 
               deriving (Eq, Show) 

dutch :: [Dutch a] -> [Dutch a]
dutch ds = rs ++ ws ++ bs
  where (rs, ws, bs) = distribute ds ([],[],[])
  
distribute :: [Dutch a] -> ([Dutch a], [Dutch a], [Dutch a])
                        -> ([Dutch a], [Dutch a], [Dutch a])
distribute []             (rs,ws,bs) = (rs, ws, bs)
distribute (d:ds)   (rs,ws,bs) = add d (distribute ds (rs,ws,bs))

add :: Dutch a -> ([Dutch a], [Dutch a], [Dutch a])
               -> ([Dutch a], [Dutch a], [Dutch a])
add (Red x)   (rs,ws,bs) = ((Red x):rs, ws, bs)
add (White x) (rs,ws,bs) = (rs, (White x):ws, bs)
add (Blue x)  (rs,ws,bs) = (rs, ws, (Blue x):bs)

bspliste len = zipWith ($) 
               (cycle [Blue, White, Red, Blue, White, Red, Red, Blue, White]) 
               [1..len]

--
-- Version mit Differenzlisten
--
--

dutch2 :: [Dutch a] -> [Dutch a]
dutch2 ds = toList (dutchDL ds)



dutchDL :: [Dutch a] -> DL (Dutch a)
dutchDL ds = (append rs (append ws bs))
  where (rs,ws,bs) = distributeDL ds (empty, empty, empty)

distributeDL :: [Dutch a] -> (DL (Dutch a), DL (Dutch a), DL (Dutch a)) 
                          -> (DL (Dutch a), DL (Dutch a), DL (Dutch a))
distributeDL []       (rs,ws,bs) = (rs, ws, bs)
distributeDL (d:ds)   (rs,ws,bs) = addDL d (distributeDL ds (rs,ws,bs))

addDL :: Dutch a -> (DL (Dutch a), DL (Dutch a), DL (Dutch a))
                 -> (DL (Dutch a), DL (Dutch a), DL (Dutch a))
addDL (Red x)   (rs,ws,bs) = ((Red x) `cons` rs, ws, bs)
addDL (White x) (rs,ws,bs) = (rs, (White x)`cons` ws, bs)
addDL (Blue x)  (rs,ws,bs) = (rs, ws, (Blue x)`cons` bs)