Comonadically finding all the ways to focus on a grid [duplicate]

Question

{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
import Control.Comonad
import Data.Functor.Reverse
import Data.List (unfoldr)

First some context (ha ha). I have a zipper over non-empty lists.

data LZipper a = LZipper (Reverse [] a) a [a]
    deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)

mkZipper :: a -> [a] -> LZipper a
mkZipper = LZipper (Reverse [])

You can step in either direction along the zipper, but you might fall off the end.

fwd, bwd :: LZipper a -> Maybe (LZipper a)
fwd (LZipper _ _ []) = Nothing
fwd (LZipper (Reverse xs) e (y:ys)) = Just $ LZipper (Reverse (e:xs)) y ys
bwd (LZipper (Reverse []) _ _) = Nothing
bwd (LZipper (Reverse (x:xs)) e ys) = Just $ LZipper (Reverse xs) x (e:ys)

Duplicating a zipper shows you all the ways you could look at it, with the focus on the way you're looking at it currently.

instance Comonad LZipper where
    extract (LZipper _ x _) = x
    duplicate z = LZipper (Reverse $ unfoldr (step bwd) z) z (unfoldr (step fwd) z)
        where step move = fmap (\y -> (y, y)) . move

For example:

ghci> duplicate (mkZipper 'a' "bc")
LZipper (Reverse [])
        (LZipper (Reverse "") 'a' "bc")
        [LZipper (Reverse "a") 'b' "c",LZipper (Reverse "ba") 'c' ""]
-- Abc -> *Abc* aBc abC

ghci> fmap duplicate (fwd $ mkZipper 'a' "bc")
Just (LZipper (Reverse [LZipper (Reverse "") 'a' "bc"])
              (LZipper (Reverse "a") 'b' "c")
              [LZipper (Reverse "ba") 'c' ""])
-- aBc -> Abc *aBc* abC

(I'm using capitals and asterisks to indicate the focal point of the zipper.)

---

I'm trying to work with two-dimensional grids with a focus, represented as a zipper of zippers. Each inner zipper is a row of the grid. My end goal is to find paths through a grid by hopping from neighbour to neighbour.

Moving through the grid maintains the invariant that all the rows are focused on the same index. This makes it easy to focus on any of your neighbours.

type Grid a = LZipper (LZipper a)

up, down, left, right :: Grid a -> Maybe (Grid a)
up = bwd
down = fwd
left = traverse bwd
right = traverse fwd

extractGrid :: Grid a -> a
extractGrid = extract . extract
mkGrid :: (a, [a]) -> [(a, [a])] -> Grid a
mkGrid (x, xs) xss = mkZipper (mkZipper x xs) $ map (uncurry mkZipper) xss

Examples:

ghci> let myGrid = mkGrid ('a', "bc") [('d', "ef"), ('g', "hi")]
ghci> myGrid
LZipper (Reverse [])
        (LZipper (Reverse "") 'a' "bc")
        [LZipper (Reverse "") 'd' "ef",LZipper (Reverse "") 'g' "hi"]
-- +-------+ 
-- | A b c |
-- | d e f |
-- | g h i |
-- +-------+

ghci> return myGrid >>= right >>= down
Just (LZipper (Reverse [LZipper (Reverse "a") 'b' "c"])
              (LZipper (Reverse "d") 'e' "f")
              [LZipper (Reverse "g") 'h' "i"])
-- +-------+ 
-- | a b c |
-- | d E f |
-- | g h i |
-- +-------+

What I want is the equivalent of LZipper's duplicate for grids: a function that takes a grid and produces a grid of all the ways you could look at the grid, with the focus on the current way you're looking at it.

duplicateGrid :: Grid a -> Grid (Grid a)

What I'm expecting:

duplicateGrid myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | a B c | | a b C | |
| * d e f * | d e f | | d e f | |
| * g h i * | g h i | | g h i | |
| ********* +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | a b c | | a b c | | a b c | |
| | D e f | | d E f | | d e F | |
| | g h i | | g h i | | g h i | |
| +-------+ +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | a b c | | a b c | | a b c | |
| | d e f | | d e f | | d e f | |
| | G h i | | g H i | | g h I | |
| +-------+ +-------+ +-------+ |
+-------------------------------+

I tried duplicateGrid = duplicate . duplicate. This has the correct type, but (assuming that I interpreted the show output correctly, which I probably didn't) it only gives me grids focused somewhere on the first column:

(duplicate . duplicate) myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | a b c | | a b c | |
| * d e f * | D e f | | d e f | |
| * g h i * | g h i | | G h i | |
| ********* +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | A b c | | a b c | | a b c | |
| | d e f | | D e f | | d e f | |
| | g h i | | g h i | | G h i | |
| +-------+ +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | A b c | | a b c | | a b c | |
| | d e f | | D e f | | d e f | |
| | g h i | | g h i | | G h i | |
| +-------+ +-------+ +-------+ |
+-------------------------------+

I also tried duplicateGrid = duplicate . fmap duplicate. Assuming once again that I'm capable of interpreting the show output, this gave me something that both contained the wrong grids and had the focuses of the rows misaligned, such that moving down would also move you along:

(duplicate . fmap duplicate) myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | D e f | | G h i | |
| * a B c * | d E f | | g H i | |
| * a b C * | d e F | | g h I | |
| ********* +-------+ +-------+ |
| +-------+ ********* +-------+ |
| | A b c | * D e f * | G h i | |
| | a B c | * d E f * | g H i | |
| | a b C | * d e F * | g h I | |
| +-------+ ********* +-------+ |
| +-------+ +-------+ ********* |
| | A b c | | D e f | * G h i * |
| | a B c | | d E f | * g H i * |
| | a b C | | d e F | * g h I * |
| +-------+ +-------+ ********* |
+-------------------------------+

This feels like it'd be an easy question for those in the know, but it's making my head spin. I suppose I could hand-crank a function which calls up, down, left and right, but I feel like the comonadic machinery ought to be able to do it for me. What is the correct implementation of duplicateGrid?

Answer 1

It's a bit of an issue here that we're trying to compose Grid with itself, because this setup gives us way too many incorrect ways to implement a duplicate with the right type. It's useful to consider the general case where the composed comonads aren't necessarily the same.

Suppose we have f and g comonads. The type of duplicate becomes:

duplicate :: f (g a) -> f (g (f (g a)))

We can get the following solely using the Comonad instances:

duplicate . fmap duplicate :: f (g a) -> f (f (g (g a)))

From this it becomes apparent that we need to swap f and g in the middle.

There's a type class called Distributive that has the method we want.

class Functor g => Distributive g where
    distribute :: Functor f => f (g a) -> g (f a)

In particular, we need to implement Distributive g, and then duplicate for the composed comonad can be implemented as:

duplicate = fmap distribute . duplicate . fmap duplicate

However, the documentation in Distributive says that values of g must have the exact same shape, so we can zip together an arbitrary number of copies without loss of information.

To illustrate this, if Vec n a is an n-sized vector, then distribute :: [Vec n a] -> Vec n [a] is just matrix transposition. It's necessary to pin the down size of the inner vector beforehand, because transposition on a "ragged" matrix must drop some elements, and that's not lawful behavior. Infinite streams and zippers also distribute fine, as they too have just one possible size.

Zipper is not a lawful Distributive because Zipper contains values with differently sized contexts. Still, we can implement improper distribution that supposes uniform context sizes.

Below I'll implement duplicate for Grid in terms of improper distribution for the underlying lists.

Alternatively, one could just roll up their sleeves and implement a transposition function on Zipper (Zipper a) directly. I actually did this, but it gave me a headache and I'm far from being confident that it's correct. It's better to make the types as general as possible, in order to narrow down the space of possible implementations, so there's less room for errors.

I'm going to omit Reverse in order to reduce syntactic noise; I hope you excuse me.

{-# language DeriveFunctor #-}

import Control.Comonad
import Data.List
import Control.Monad

data Zipper a = Zipper [a] a [a] deriving (Eq, Show, Functor)

lefts, rights :: Zipper a -> [a]
lefts  (Zipper ls _ _) = ls
rights (Zipper _ _ rs) = rs

bwd :: Zipper a -> Maybe (Zipper a)
bwd (Zipper [] _ _) = Nothing
bwd (Zipper (l:ls) a rs) = Just $ Zipper ls l (a:rs)

fwd :: Zipper a -> Maybe (Zipper a)
fwd (Zipper _ _ []) = Nothing
fwd (Zipper ls a (r:rs)) = Just $ Zipper (a:ls) r rs

instance Comonad Zipper where
  extract (Zipper _ a _) = a
  duplicate z =
    Zipper (unfoldr (fmap (join (,)) . bwd) z) z (unfoldr (fmap (join (,)) . fwd) z)

We can distribute lists if we know their length beforehand. Since Haskell lists can be infinite, we should measure length with possibly infinite lazy naturals. An alternative solution to measuring length would be using a "guide" list along which we can zip other lists. However, I would rather not assume in the distribution functions that such a dummy list is always available.

data Nat = Z | S Nat

length' :: [a] -> Nat
length' = foldr (const S) Z

distList :: Functor f => Nat -> f [a] -> [f a]
distList Z     fas = []
distList (S n) fas = (head <$> fas) : distList n (tail <$> fas)

Of course, this fails with runtime exceptions if our length assumption is incorrect.

We can distribute Zippers by distributing their focuses and contexts, provided that we know the lengths of the contexts:

distZipper :: Functor f => Nat -> Nat -> f (Zipper a) -> Zipper (f a)
distZipper l r fz = Zipper
  (distList l (lefts <$> fz)) (extract <$> fz) (distList r (rights <$> fz))

Finally, we can duplicate Grids in the way we saw before, but first we have to determine the shape of the inner Zippers. Since we assume that all inner Zippers have the same shape, we only look at the Zipper in the focus:

duplicateGrid :: Grid a -> Grid (Grid a)
duplicateGrid grid@(Zipper _ (Zipper ls _ rs) _) = 
    fmap (distZipper (length' ls) (length' rs)) $ duplicate $ fmap duplicate grid

Testing this (as you must have already experienced) is pretty awful, and I haven't yet gotten around to check even a two-by-two case by hand.

Still, I'm fairly confident in the above implementation, since the definitions are highly constrained by the types.

Answer 2

The fundamental problem you're running into is that zippers don't natively support 2-d structures. The answer there is great (the other answer is basically exactly your definition of Grid) and I would encourage you to read it, but the gist is that zippers identify elements with paths to get there and in a 2-d space such an identification is problematic because there are many paths to get to a point.

Hence you'll notice that while your up and down functions for Grids was completely defined in terms of Zippers, you needed to use Traversable machinery to define left and right. This also means that left and right don't enjoy the same performance properties as up and down since you're "going against the grain" so to speak.

Since your Comonad instance was defined only using your zipper functions, it can only duplicate in the direction that is defined by your zipper, namely fwd and bwd (and by extension up and down).

Edit: After some more thought I think that your approach is going to be fundamentally problematic. I've preserved my original text below, but there's a more glaring problem.

If you're trying to traverse your zippers as if they were like any 2-d other structure, you're going to keep getting Nothing with your duplicate. Let's note what happens if you actually try to use your up, down, left, right functions on the ostensibly non-problematic duplicate (mkZipper 'a' "bc").

*Main> let allRows = duplicate $ mkZipper 'a' "bc"
*Main> down allRows -- This is fine since we're following the zipper normally
Just (LZipper (Backwards [LZipper (Backwards "") 'a' "bc"]) (LZipper (Backwards "a") 'b' "c") [LZipper (Backwards "ba") 'c' ""])
*Main> right allRows
Nothing -- That's bad...
*Main> down allRows >>= right
Nothing -- Still nothing

Moving right and left requires (as you duly note with your mention of the invariant) that every single one of your sub-zippers is homogeneous in structure, otherwise the traverse will fail out prematurely. This means that if you actually want to use left and right, the only way this is going to play nice with duplicate is if you use the most uniform duplicate possible.

duplicate z @ (LZipper left focus right) = 
    LZipper (fmap (const z) left) z (fmap (const z) right)

The alternative is to only use the functions that comes with the zipper. That means only using fwd and bwd, and then extracting the focus and continuing to use fwd and bwd to get the same thing as left and right. Of course that means giving up the ability to say both "right then down" and "down then right," but as we've already seen, zippers don't play with multiple paths well.

Now let's double-check your intuitions about how best to interpret what was going on with duplicate . duplicate $ myGrid. A nice square isn't really the best way of thinking about what's happening (and you'll see why if you restrict yourself to just extract and fwd and bwd).

*Main> let allRows = duplicate . duplicate $ myGrid
*Main> fwd $ extract allRows -- Makes sense
Just ...
-- This *should* be the bottom-left of the grid
*Main> let bottomLeft = extract <$> fwd allRows >>= fwd
*Main> bottomLeft >>= fwd
Nothing -- Nope!
*Main> bottomLeft >>= bwd
Just ... -- Wait a minute...

We've actually got a ragged structure.

+---------------------------------------------------+
|                     ********* +-------+ +-------+ |
|                     * A b c * | a b c | | a b c | |
|                     * d e f * | D e f | | d e f | |
|                     * g h i * | g h i | | G h i | |
|                     ********* +-------+ +-------+ |
|           +-------+ +-------+ +-------+           |
|           | A b c | | a b c | | a b c |           |
|           | d e f | | D e f | | d e f |           |
|           | g h i | | g h i | | G h i |           |
|           +-------+ +-------+ +-------+           |
| +-------+ +-------+ +-------+                     |
| | A b c | | a b c | | a b c |                     |
| | d e f | | D e f | | d e f |                     |
| | g h i | | g h i | | G h i |                     |
| +-------+ +-------+ +-------+                     |
+---------------------------------------------------+

The squares inside of this ragged structure aren't actually squares either, they'll be ragged as well. Equivalently you could think of fwd as going diagonally. Or just drop zippers for 2-d structures altogether.

In my experience, zippers really work best when paired with tree-like things. I wouldn't be surprised if a Haskell expert could come up with a way of using zippers and all the update / access goodness that comes with them for things like cyclic graphs or even just plain old DAGs, but I can't think of any off the top of my meager head :).

So moral of the story, zippers are quite a bit of a headache for 2-d structures. (Idle thought: maybe lenses might be interesting?)

For the curious, my approach below also only works if you keep in mind the raggedness of the structure we're dealing with; that is fwding twice and then extracting will get you the equivalent of what OP wants at the bottom-right-hand corner of his grid, not at the bottom left-hand side.

Original:

So what you need is some way to switch between your purely zipper-based duplicate and your Traversable-based duplicate. The easiest way is to take your duplicate function you've already written and simply add a traverse in the middle.

duplicateT :: Traversable t => t (LZipper a) -> LZipper (t (LZipper a))
duplicateT z = LZipper (Backwards $ unfoldr (step bwd) z) z (unfoldr (step fwd) z)
    -- Everything's the exact same except for that extra traverse
    where step move = fmap (\y -> (y, y)) . (traverse move)

Now that we have a more general duplicateT we can get rid of some nasty code duplication by redefining duplicate in your Comonad instance to be:

-- requires import Data.Functor.Identity
duplicate = fmap runIdentity (duplicate' (Identity z))

Then the following gets you what you want

duplicateGrid = duplicate . duplicateT

Or if you want to switch the order of the columns and rows, you can do the opposite.

Note: It would be even nicer if Haskell let you natively define type constraints on typeclasses so that you could have different instances of Comonad (all mediated with newtypes perhaps) for your LZipper that change the direction of your duplicate. The problem is that you would want something like instance Comonad LZipper (LZipper a) where ... or the equivalent newtype which you simply can't write in Haskell. You could conceivably do something like this with type families, but I suspect that that's probably overkill for this particular instance.

Edit: In fact you don't even need duplicateT if you give the appropriate Applicative instance for LZipper.

instance Applicative LZipper where
    pure x = LZipper (Backwards (repeat x)) x (repeat x)
    (LZipper leftF f rightF) <*> (LZipper left x right) = LZipper newLeft (f x) newRight
      where
        newLeft = (Backwards (zipWith ($) (forwards leftF) (forwards left)))
        newRight = (zipWith ($) rightF right)

Now simply take the original duplicate you had before and use traverse.

duplicateGrid = duplicate . (traverse duplicate)