[Haskell-beginners] Sankey Diagram with monads

Adrian May adrian.alexander.may at gmail.com
Fri May 31 20:59:55 CEST 2013


It got a lot easier when I forgot all about the monads:


type SaState = ( P2, CircleFrac, Double )
type SaPic =   ( (Trail R2), (Trail R2) )
type SaWorld = ( SaPic, SaState )

type SaAct = SaState -> SaWorld

bigbang :: Double -> SaWorld
bigbang w = ((mempty,mempty), (origin,0,w))

(>%) :: SaWorld -> SaAct -> SaWorld
((t1,b1),s1) >% f = let ((t2,b2),s2) = f s1 in ((t1<>t2,b2<>b1),s2)

(>%=) :: SaAct -> SaAct -> SaAct
f >%= g = \s1 ->
  let ((t2,b2),s2) = f s1 in
  let ((t3,b3),s3) = g s2 in
  ((t2<>t3,b3<>b2),s3)

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

saTo :: SaAct
saTo (p,a,w) =
  (
    ( hrule   w  # translateX (-w/2) # rotate (-0.125 :: CircleFrac) #
scale 0.7071 # translateX (w/2) # rotate a # translate (origin .-. p)
    , hrule (-w) # translateX (-w/2) # rotate ( 0.125 :: CircleFrac) #
scale 0.7071 # translateX (w/2) # rotate a # translate (origin .-. p)
    )
    ,
    (p,a,0)
  )

saTurn :: Double -> CircleFrac -> SaAct
saTurn 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
  (
    ( 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)
  )

saSplit :: [(Double, SaAct)] -> SaAct
saSplit fs (p,a,w) =
let (placed,_) = ( foldl ( \(l,t) -> \(i,f) -> ( l++[( ( p .+^ (unitY #
rotate a # scale (((t+i/2)-0.5)*w)), a, w*i) ,f )],t+i) ) ([],0) fs ) in
let ws = map (\(b,f)-> f b) placed in
((foldl (<>) mempty (map (\((tt,bb),_)->tt<>bb) ws),mempty),(origin,0,0))

p3 = bigbang 5 >% (saVia 10 >%= (saSplit
[ (0.80,(saVia 10 >%= saTo))
, (0.20,saTurn 1 (-0.25) >%= (saVia 2 >%= (saSplit
[ (0.10,saTurn 1 (0.25) >%= (saVia 5 >%= saTo))
, (0.80,(saVia 3 >%= saTo))
, (0.10,saTurn 1 (-0.25) >%= (saVia 5 >%= saTo))
] )))
] ))

pic3 = let p = fst $ p3 in
(strokeT $ close $ (fst p) <> (snd p) ) # fc red


But still I feel I'm missing something.

Adrian.



On 1 June 2013 00:31, Adrian May <adrian.alexander.may at gmail.com> wrote:

> Thanks, but I still don't know how to fix it.
>
> In the meantime, I'm struggling with something more basic. I plan to write
> a basic monad that puts diagrams on top of each other, then I'll let State
> take care of pushing the origin and angle along (turtle style). But I'm
> already stuck on that basic monad.
>
> It's >>= has to explicitly use the fact that each monad has a journey
> there and a journey back. The thing on the right of >>= will be inserted in
> between them.  But I always get either "something is a rigidly bound type
> variable" or "Monad should have kind * -> *"
>
> I just don't know how this is supposed to work.
>
> I want the monad to contain two trails, in the sense of the Diagrams
> module. If I bind two of them together, for the time being, I'll just stick
> them on top of each other (at least I think the State monad will rescue me
> from that.) I have no particular reason to tell the thing on the right of
> >>= about the thing on the left. Neither do I have a reason for >>= to be
> polymorphic.
>
> Right now I'm thinking that I'll have to define a class for things that
> provide a journey there and a journey back. I'd rather not, because there's
> only one of them but I can't seem to restrict the game any other way, but
> this way isn't helping either.
>
> Ideally I'd be able to write something like this:
>
> data Sankey = Sankey {there, back :: Trail R2}
>
> instance Monad Sankey where
>   return t b = Sankey t b
>   l@(Sankey t b) >>= f = let (Sankey t' b') = f l in
>      Sankey (t <> t') (b <> b')
>
> although I have no reason to pass l to f. But the compiler barfs anyway. I
> feel that Haskell is more complicated than what I'm trying to do. Under
> duress I tried:
>
> class Pic a where
>   there :: a -> Trail R2
>   back  :: a -> Trail R2
>
> data Trails p = Trails p
>
> instance (Pic p) => Monad (Trails p) where
>   return = Trails
>   (Trails l) >>= f = let (Trails r) = f l in
>     ((there l <> there r),(back r <> back l))
>
>
> But it doesn't like that either. What am I missing?
>
> Adrian.
>
>
>
>
>
>
>
>
>
>
>
>
>
>
> On 31 May 2013 23:42, Brandon Allbery <allbery.b at gmail.com> wrote:
>
>> On Fri, May 31, 2013 at 11:06 AM, Adrian May <
>> adrian.alexander.may at gmail.com> wrote:
>>
>>> 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? ....
>>>
>>
>> mtl-2.x changed all the base monads (State, Reader, Writer, etc.) from
>> standalone to being transformers atop an Identity monad; this cleans up the
>> implementation considerably (since we don't have almost exactly the same
>> code for both the standalone and transformer versions, but means that all
>> uses of the standalone constructors must be replaced with functions that
>> build the appropriate transformer. (e.g. State becomes state, unless you
>> want to spell it out as StateT Identity.)
>>
>> --
>> brandon s allbery kf8nh                               sine nomine
>> associates
>> allbery.b at gmail.com
>> ballbery at sinenomine.net
>> unix, openafs, kerberos, infrastructure, xmonad
>> http://sinenomine.net
>>
>> _______________________________________________
>> Beginners mailing list
>> Beginners at haskell.org
>> http://www.haskell.org/mailman/listinfo/beginners
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130601/beb94f52/attachment-0001.htm>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: 3.png
Type: image/png
Size: 13507 bytes
Desc: not available
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130601/beb94f52/attachment-0001.png>


More information about the Beginners mailing list