Skip to content

Instantly share code, notes, and snippets.

@sellout
Last active January 3, 2023 16:06
Show Gist options
  • Save sellout/4709e723cb649110af00217486c4466b to your computer and use it in GitHub Desktop.
Save sellout/4709e723cb649110af00217486c4466b to your computer and use it in GitHub Desktop.
Trying to generalize [metamorphisms](http://www.cs.ox.ac.uk/jeremy.gibbons/publications/metamorphisms-scp.pdf) away from lists.
-- | A “flushing” 'stream', with an additional coalgebra for flushing the
-- remaining values after the input has been consumed. This also allows us to
-- generalize the output away from lists.
fstream
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Traversable f)
=> Coalgebra f b -> (b -> a -> b) -> Coalgebra f b -> b -> t -> u
fstream ψ g ψ' = go
where
go c x =
let fb = ψ c
in if 0 < length fb
then embed $ fmap (flip go x) fb
else case project x of
Both a x' -> go (g c a) x'
None -> ana ψ' c
-- | Like 'fstream', but rather than using the 'length' of the 'f' from the
-- 'Coalgebra', we use a 'CoalgebraM' (but this makes it impossible to write
-- 'afstream''). It also reduces the 'Traversable' constraint to 'Functor'.
-- The 'CoalgebraM' also allows us to distinguish between cases where we just
-- want to stop processing input ('Just None') and the case when we need to
-- acquire more input ('Nothing'), which becomes more interesting when 'u'
-- isn’t a list and may have multiple leaf nodes.
fstream'
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Functor f)
=> CoalgebraM Maybe f b -> (b -> a -> b) -> Coalgebra f b -> b -> t -> u
fstream' ψ g ψ' = go
where
go c x =
maybe (case project x of
Both a x' -> go (g c a) x'
None -> ana ψ' c)
(embed . fmap (flip go x))
$ ψ c
-- | An “auto-flushing” stream – uses the same coalgebra for streaming
-- generation and flushing. It gives us the original signature of 'stream',
-- but still generalized away from lists.
afstream
:: (Cursive t (XNor a), Cursive u f, Corecursive u f, Traversable f)
=> Coalgebra f b -> (b -> a -> b) -> b -> t -> u
afstream ψ g = fstream ψ g ψ
-- | A stream for truly infinite inputs.
sstream
:: (Cursive t ((,) a), Cursive u f, Traversable f)
=> Coalgebra f b -> (b -> a -> b) -> b -> t -> u
sstream ψ g = go
where
go c x =
let fb = ψ c
in if 0 < length fb
then embed $ fmap (flip go x) fb
else case project x of
(a, x') -> go (g c a) x'
-- | This is to 'sstream' as 'fstream'' is to 'fstream'.
sstream'
:: (Cursive t ((,) a), Cursive u f, Functor f)
=> CoalgebraM Maybe f b -> (b -> a -> b) -> b -> t -> u
sstream' ψ g = go
where
go c x =
maybe (case project x of (a, x') -> go (g c a) x')
(embed . fmap (flip go x))
$ ψ c
-- | Streaming representation-changers – a.k.a., metamorphism.
stream :: Coalgebra (XNor c) b -> (b -> a -> b) -> b -> [a] -> [c]
stream ψ g = fstream ψ g (const None)
snoc :: [a] -> a -> [a]
snoc x a = x ++ [a]
x :: [Int]
x = stream project snoc [] [1, 2, 3, 4, 5]
@sellout
Copy link
Author

sellout commented Oct 7, 2017

So, what am I trying to do with them? Basically generalize them in the same way as other recursion schemes. fstream' and sstream' manage to generalize somewhat nicely over arbitrary output types, but the inputs are still restricted to lists (and streams).

@sellout
Copy link
Author

sellout commented Oct 7, 2017

Some more (questionable) generalization

-- | Generalizes the input to any 0/1-tailed functor ('XNor', '(,)', 'Maybe',
--  'Const', …).
fstream''
  :: (Cursive t e, Cursive u f, Corecursive u f, Functor f)
  => CoalgebraM Maybe f b
  -> (e t -> Maybe (b -> b, t))
  -> Coalgebra f b
  -> b
  -> t
  -> u
fstream'' ψ g ψ' = go
  where
    go c x =
      maybe (maybe (ana ψ' c) (uncurry go . ((&) c *** id)) . g $ project x)
            (embed . fmap (flip go x))
            $ ψ c

-- | Using 'fstream''' for '(,)', we don’t need the end-of-input case (and
--   flushing 'Coalgebra'). Would be nice to eliminate them without 'error'.
sstream''
  :: (Cursive t ((,) a), Cursive u f, Corecursive u f, Functor f)
  => CoalgebraM Maybe f b -> (b -> a -> b) -> b -> t -> u
sstream'' ψ g = fstream'' ψ (\(a, t) -> Just (flip g a, t)) (error "This doesn’t seem good.")

I think fstream'' generalizes about as much as possible without somehow handling branching. The new g isn’t quite an Algebra[†]. Should work for either simple functors as mentioned in the comment, or if there’s like a Semigroup t so the “algebra” can combine the branches.

[†]: I guess if there’s a Monoid b, it’s an AlgebraM (WriterT (b -> b) Maybe) e t.

@sellout
Copy link
Author

sellout commented Oct 7, 2017

fstream' :: CoalgebraM f b -> (b -> a -> b) -> Coalgebra f b -> b -> [a] -> Fix f

The second Coalgebra makes the unfold half look like a elgotGApo … instead of returning Nothing when it can’t produce any more from the seed, it can return the remaining seed – but we only actually apply the “helper” coalgebra if we can no longer add to the seed either.

I wonder if we can take advantage of a distributive law, so that in the case of list we could use distGApo flush and in the case of a stream, we could use distAna.

@sellout
Copy link
Author

sellout commented Oct 7, 2017

Ok, with the GApo insight, I’ve rewritten it in a way that I think obsoletes all the previous stuff:

stream'
  :: (Cursive t e, Cursive u f, Functor f)
  => CoalgebraM Maybe f b
  -> (b -> ((b -> b, t) -> u) -> e t -> u)
  -> b
  -> t
  -> u
stream' ψ f = go
  where
    go c x =
      maybe (f c (uncurry go . ((&) c *** id)) $ project x)
            (embed . fmap (flip go x))
            $ ψ c

-- | Handles cases like infinite streams that can’t terminate, and therefore never need to flush.
streamAna
  :: (Cursive t e, Cursive u f, Functor f)
  => CoalgebraM Maybe f b
  -> AlgebraM ((,) (b -> b)) e t
  -> b
  -> t
  -> u
streamAna ψ φ = stream' ψ $ \c f -> f . φ

-- | Handles streams that need to flush.
streamGApo
  :: (Cursive t e, Cursive u f, Corecursive u f, Functor f)
  => Coalgebra f b
  -> CoalgebraM Maybe f b
  -> (e t -> Maybe (b -> b, t)) -- maybe an 'AlgebraM'
  -> b
  -> t
  -> u
streamGApo ψ' ψ φ = stream' ψ $ \c f -> maybe (ana ψ' c) f . φ

streamAna is like the original stream/sstream formulations, and streamGApo is like the fstream ones. With both defined in terms of stream' that expects some extra-complicated function that handles the foldl aspect.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment