[Haskell-cafe] How to implement a source-sink pattern

[Roland Lutz]

On Wed, 1 Apr 2015, Frank Staals wrote:
> So essentially you want a data structure for some kind of bipartite 
> graph.

Yes, with the additional constraint that the vertices in one partite set 
(the "sinks") each connect to exactly one edge.

> The most haskelly way to do that would probably to define the graph to 
> be simply define the Bipartite graph to be a pair of Maps, and define 
> functions to add/delete nodes and edges to the graph that make sure that 
> the two maps keep in sync.

This was actually my first approach, but I couldn't find appropriate key 
and value types to be stored in the map.  Since the vertices are 
well-known global objects, it doesn't make much sense to store more than a 
handle here.  But how do I connect the handle back to the data structure?

> In this model you cannot direclty mix the sources and sinks from
> different modules. I.e. a 'BiGraph MySource MySink' cannot be used to
> also store a (MySecondSource,MySecondSink) pairs. If you do want that,
> you would need some wrapper type that distinguishes between the various
> 'MySink', 'MySecondSink', versions.

That's one of the points that trouble me.  How would such a wrapper look 
like?

I experimented a bit with your code (see below).  I noticed that I have to 
specify "Ord src =>" and "Ord snk =>" in multiple places.  Is there a way 
to state that type arguments for BiGraph always have to be instances of 
Ord?

Roland



import qualified Data.List as L
import qualified Data.Map as M

data BiGraph src snk = BiGraph {
     sourceToSinkMap :: M.Map src [snk],
     sinkToSourceMap :: M.Map snk src
} deriving Show

collectKeys :: Eq a => a -> M.Map k a -> [k]
collectKeys a = M.keys . M.filter (== a)

applyToPair :: (k -> a) -> k -> (k, a)
applyToPair f a = (a, f a)

initializeGraph :: Ord src => [src] -> M.Map snk src -> BiGraph src snk
initializeGraph srcs m2 =
     BiGraph (M.fromList $ map (applyToPair $ (flip collectKeys) m2) srcs) m2

updateEdge :: Ord src => Ord snk =>
               (src, snk) -> BiGraph src snk -> BiGraph src snk
updateEdge (src, snk) (BiGraph m1 m2) =
     if M.notMember src m1 then error "updateEdge: invalid source" else
     if M.notMember snk m2 then error "updateEdge: invalid sink" else
     let oldsrc = m2 M.! snk in
         BiGraph (M.adjust (snk :) src $ M.adjust (L.delete snk) oldsrc m1)
                 (M.insert snk src m2)

sinksForSource :: Ord src => src -> BiGraph src snk -> [snk]
sinksForSource src = (M.! src) . sourceToSinkMap