[Haskell-beginners] Sankey Diagram with monads

[Adrian May]

Well I figured out that I should be using the State monad, but it seems not
to be behaving like most of the tutorials on the web. Did the syntax
change? ....

type SankeyState = (P2,CircleFrac,Double)
type SankeyPic = (Trail R2, Trail R2)

type Sankey = State SankeyState SankeyPic

saBlank :: Sankey
saBlank = return (mempty, mempty)

saVia :: Double -> Sankey
saVia l = state (
  \(p,a,w) ->
    (
      ( hrule l    # translateX 0.5 # translateY (w/2)  # rotate a
      , hrule (-l) # translateX 0.5 # translateY (-w/2) # rotate a
      )
      , (p .+^ (unitX # scale l # rotate a),a,w)
    )
  )

saTo :: Sankey
saTo = state (
  \(p,a,w) ->
    (
      ( 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)
    )
  )

x :: SankeyPic
x = evalState ( saTo )              (origin, 0, 5) -- works and looks nice
--x = evalState ( saVia 10 )          (origin, 0, 5) -- works but not much
to see
--x = evalState ( saVia 10 >>= saTo ) (origin, 0, 5) -- barfs with
something unintelligible

pic3 = strokeT ( close ( fst x <> snd x)) # fc red

The unintelligible bit is:

    Couldn't match expected type `SankeyPic
                                  -> StateT SankeyState
Data.Functor.Identity.Identity SankeyPic'
                with actual type `Sankey'
    In the second argument of `(>>=)', namely `saTo'
    In the first argument of `evalState', namely `(saVia 10 >>= saTo)'
    In the expression: evalState (saVia 10 >>= saTo) (origin, 0, 5)

TIA,
Adrian.




On 31 May 2013 21:16, Adrian May <adrian.alexander.may at gmail.com> wrote:

> 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?
>
>
>
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130531/352e2fe1/attachment-0001.htm>