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

Some other useful stuff:

data XNor a b = None | Both a b -- the pattern functor for lists

and (a, b) (sectioned as ((,) a)) is the pattern functor for infinite streams.

@sellout
Copy link
Author

sellout commented Oct 7, 2017

I think afstream might be what we want all the time.

@sellout
Copy link
Author

sellout commented Oct 7, 2017

And sstream, because that eliminates the need for flushing by eliminating input termination.

To unify afstream and sstream, we’ll need to solve the foldl problem.

@sellout
Copy link
Author

sellout commented Oct 7, 2017

Oh, and Cursive is a class with just project/embed.

@sellout
Copy link
Author

sellout commented Oct 7, 2017

What do these functions do? Generally, all the same thing with slight variations. Here’s a slightly-specialized definition to clarify it a bit.

fstream' :: CoalgebraM f b -> (b -> a -> b) -> Coalgebra f b -> b -> [a] -> Fix f
fstream' expand accumulate flush seed input = _

So, first it tries to expand the seed as much as possible, when it can’t get any more output from the seed, it accumulates more values from the input until it can expand more. When the input is finally exhausted, it flushes the remaining accumulated values.

The purpose is streaming transformations – one simple example is [String] ->[String], where the input represents lines of text of unknown length and we want the output to never have more than 30 characters per line, and to only break the lines on whitespace.

["This is a ",
 "simple example of very ragged lines ",
 "of text that we want to normalize to always approach 30 characters per line. ",
 "and this document may go on forever as "
 "far "
 "as we’re con",
 "cerned. ",
 ...]

The seed is a String, and accumulate is ++. expand makes sure the string is at least 30 characters, splits it after the last space before the 30th char, adding the first part to the output and making the rest of the string the new seed. flush should just add the remaining seed to the output.

After processing that much of the text, the accumulated output is

["This is a simple example of ",
 "very ragged lines of text ",
 "that we want to normalize to ",
 "always approach 30 characters ",
 "per line. and this document ",
 "may go on forever as far as "]

With "we’re concerned. " stored in the seed. As long as we never try to display more than those first six lines, we’ll never try to format the rest of the lines. And if we do and "we’re concerned. " is the end of the input, then that will get flushed and the list will terminate.

To break it into a few steps:

action seed output
initial "" []
accumulate "This is a " same
accumulate "This is a simple example of very ragged lines " same
expand "very ragged lines " , "This is a simple example of "]
accumulate "very ragged lines of text that we want to normalize to always approach 30 characters per line. " same
expand "that we want to normalize to always approach 30 characters per line. " , "very ragged lines of text "]
expand "always approach 30 characters per line. " , "that we want to normalize to "]
expand "per line. " , "always approach 30 characters "]
accumulate "per line. and this document may go on forever as " same
expand "may go on forever as " , "per line. and this document "]
accumulate "may go on forever as far " same
accumulate "may go on forever as far as we’re con" same
expand "we’re con" , "may go on forever as far as "]
accumulate "we’re concerned. " same
flush , "we’re concerned. "]

@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