Instantly share code, notes, and snippets. sellout/metamorphism.hs Last active Mar 18, 2018

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]
Owner 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.
Owner Author

sellout commented Oct 7, 2017

 I think afstream might be what we want all the time.
Owner 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.
Owner Author

sellout commented Oct 7, 2017

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

sellout commented Oct 7, 2017 • edited

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. "]
Owner 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).
Owner 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.
Owner Author

sellout commented Oct 7, 2017 • edited

 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.
Owner 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.
to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.