Sankey Diagram with monads

31 May 2013

      Hi all,

Take a look at this disaster area, or just scroll down to where I come to
the point...

=======================

type SankeyBrain = (P2,CircleFrac,Double) -- like a turtle plus width
data SankeyWorld tb = SankeyWorld ((Trail R2,Trail R2),tb) --outgoing and
returning trails, plus brain

emptySankey :: SankeyWorld SankeyBrain
emptySankey = SankeyWorld ((mempty,mempty),(origin,0,0))

sankeyFrom:: CircleFrac -> Double -> SankeyWorld SankeyBrain
sankeyFrom a w = SankeyWorld ((mempty,mempty),(p2 (0,0),a,w)) -- kick off
with an angle and width

instance Monad SankeyWorld where
  return a = SankeyWorld ((mempty,mempty), a) --never use this
  (SankeyWorld l) >>= f = let (SankeyWorld r) = f (snd l) in -- out = left
then right, return = right then left
 SankeyWorld ( (((fst.fst) l <> (fst.fst) r),((snd.fst) r <> (snd.fst)
l)),(snd r)   )

sankeyVia :: Double -> SankeyBrain -> SankeyWorld SankeyBrain
sankeyVia d (p,a,w) =
  let -- draw parallel lines and move them into place
    l1 = hrule 1 # scaleX d    # translateX (d/2) # translateY (w/2)  #
rotate a # translate (origin .-. p)
    l2 = hrule 1 # scaleX (-d) # translateX (d/2) # translateY (-w/2) #
rotate a # translate (origin .-. p)
  in SankeyWorld ( ( l1 , l2 ) , ( p .+^ (unitX # scale d # rotate a), a,
w) )

sankeyTo :: SankeyBrain -> SankeyWorld SankeyBrain
sankeyTo (p,a,w) = SankeyWorld ( --arrow at the end of the flow
  ( hrule w    # translateX (w/2) # translateY (w/2)  # rotate
(-1/8::CircleFrac) #  scale (0.7071) # rotate a # translate (origin .-. p)
  , hrule (-w) # translateX (w/2) # translateY (-w/2) # rotate
 (1/8::CircleFrac) #  scale (0.7071) # rotate a # translate (origin .-. p)
  ), (p,a,w))

sankeyTurn r a' (p,a,w) = let (outr, inr, qu) = if a'>=0 then (r, -w-r,
-0.25::CircleFrac) else (-w-r, r, 0.25::CircleFrac) in
  SankeyWorld ( -- turn a corner with nice round edges
( arc' outr (a+qu) (a+a'+qu)  # translate (unitY # rotate (a+a' )# scale w)
  , arc' inr  (a+a'+qu) (a+qu) # translate (unitY # rotate (a+a' )# scale w)
  ),(p,a+a',w))

-- bump...
sankeySplit :: [(Double, SankeyBrain -> SankeyWorld SankeyBrain)] ->
SankeyBrain -> SankeyWorld SankeyBrain
sankeySplit fs (p,a,w) = let (placed,_) = ( foldl ( \(l,t) -> \(i,c) -> (
l++[( ( p .+^ (unitY # rotate a # scale (((t+i/2)-0.5)*w)), a, w*i) ,c
)],t+i) ) ([],0) fs ) in
 foldl (\(SankeyWorld ((lo,lr),lb)) -> \(SankeyWorld ((ro,rr),rb)) ->
SankeyWorld ( ( lo <> ro , rr <> lr ), rb )  ) emptySankey $ map (\(b,f)->
f b) placed

SankeyWorld ((turtb,turta),_) =
{- This is the bit that fails:
sankeyFrom 0 5 >>= sankeyVia 5 >>=
sankeySplit
 [ (0.3, sankeyVia 10 )
, (0.7, sankeyVia 15 )
]
 -}
sankeyFrom 0 5 >>= sankeyVia 5 >>= sankeyTurn 1 (-0.125) >>= sankeyVia 10
...
...
= sankeyTurn 1 (0.25) >>= sankeyTo -- >>= turn 0.25 >>= forward 10 >>=
turn 0.25 >>= forward 20 >>= turn 0.25 >>= forward 10
pic3 = (strokeT (close ( turtb<>turta) )) # fc red

======================

The idea is that SankeyWorld is a monad containing two trails (outbound and
inbound) and a turtle-like state. I bind it onto functions like SankeyBrain
-> SankeyWorld, whereby >>= passes the state across. >>= draws the left
hand outward trail, then the right hand outward trail, then the right hand
inward trail, then the left hand inward trail, so it all makes a nice
polygon and I can colour it in.

sankeyFrom angle width is already a monad, sankeyVia length is such a
function and I could have sankeyTo contain () in place of the brain (i.e.
state) cos you're not supposed to continue from it.

The tricky bit is splitting the flow. I want a function that takes the
brain, splits the width according to named shares and shoves each share
into a function SankeyBrain -> SankeyWorld that might have lots more stages
and splits downwind.

It was all going fine until I discovered that if I can say m >>= f, then I
can't say f >>= f. So I don't know how to write the bits after the split.
Silly me. But what should I do instead to model Sankey diagrams splitting?
Is MonadPlus the trick? If so, am I gonna have to make [SankeyWorld] a
monad as well?

TIA,
Adrian.

PS: I rarely have any use for the polymorphism of the parameter to Monad.
In this case, it's a SankeyBrain, end of story. Is there a simpler kind of
monad that doesn't throw this complication at me?

Adrian May

Adrian May

Brandon Allbery

Adrian May

Adrian May

Brandon Allbery

tags

participants (2)