A couple of data flow exercises from Doaitse Swiestra (USCS 2016)

dataflow.hs

{-# language ScopedTypeVariables, ViewPatterns, DeriveFunctor #-}

import Data.Semigroup

data Bin a = Bin a (Bin a) (Bin a) | L a deriving (Eq,Functor, Show)


-- set everywhere the monoidal sum of the tree values, traversing once
setSum :: forall a. Semigroup a => Bin a -> Bin a
setSum t = r where
  -- shortcircuit the best down to the search
  (m, r) = trav m t

  trav :: a -> Bin a -> (a, Bin a)
  trav m (L v)  = (v, L m) -- set the m and return the v
  trav m (Bin v (trav m -> (vl,l)) (trav m -> (vr,r))) =  (vl <> v <> vr, Bin m l r)


-- compute an iso-shaped tree with the values at nodes
-- breadth first zipped to the given list
zipTreeWithBF :: forall a b c . (a -> b -> c) -> [a] -> Bin b -> Bin c
zipTreeWithBF f ys x = x' where
  -- label world , one list for each depth
  yss = ys:yss'
  -- short circuit the label creation/consumption
  (x' , yss') = rewrite yss x
  -- depth first traversal with label world as state
  rewrite :: [[a]] -> Bin b -> (Bin c, [[a]])
  rewrite (((f -> fy) : ys) : yss) = rewrite' where
    rewrite' (L x)  =  (L $ fy x, ys : yss)
    rewrite' (Bin x l r)  =  (Bin (fy x) l' r', ys : yss'') where
      (l',yss') = rewrite yss l -- consume a reduced label world
      (r',yss'') = rewrite yss' r -- with the head matching depth