Nested List Haskell Iteration

Question

I need to implement a nested list operation in Haskell.

f :: [[String]] -> [[String]]

My input is a 2d array

[ [ ”A” , ”A” , ”A” ]  
, [ ”B” , ”B” , ”A” ]
, [ ”A” , ”A” , ”B” ] ]

I arbitrarily generated that list.

A A A
B B A 
A A B

So in my implementation I need to do the following.

• If a position has A, and it has 2 or more than 2 "B" neighbors, it will turn to B.
• If a position has B, and it has 2 or more than 2 "B" neighbors, it stays like as it is.
• If a position has B, and it has less than 2 "B" neighbors, it will turn to A.

So after 1st step my table will look like this.

B B A
A B B
B B A

If I were going to use C or C++, my algorithm would like this:

1. Make a copy of my input.

2. Traverse both list in 2for loops, check if statements to make a change in the location and whenever I'm going to make a change, I will change the second list not the first, so that traversing the first list won't effect the other "A"'s and "B"'s.

3. Return second list.

The problem is, in Haskell, I cannot use iteration. How can I solve this problem?

Answer 1

As I stated in a comment, recursion is the looping primitive in Haskell. However, Haskell gives us a lot of power to build more user-friendly abstractions instead of using recursion directly. As @Lazersmoke mentioned, Comonad is a good abstraction when you're updating each individual value of a collection based on other values in the collection, such as the neighbors of the value.

There are quite a few examples of the Comonad class on the web, but it is sadly eclipsed by Monad. So here's my attempt to even the score a bit.

This is going to be a long post, so let me begin with the results. This is from GHCi:

λ display example
[[A,A,A],[B,B,A],[A,A,B]]
λ display (transition example)
[[B,B,A],[A,B,B],[B,B,A]]

Ok, now let's get down to business. First a few administrative things:

module Main where
import Control.Comonad -- from the comonad package

I'm going to try explaining each piece carefully, but it may take a while before the bigger picture becomes apparent. First, we're going to create an interesting data structure often called a zipper and implement an instance of Functor for it.

data U x = U [x] x [x] deriving Functor

instance Functor U where
  fmap f (U as x bs) = U (fmap f as) (f x) (fmap f bs)

This data structure doesn't seem so special. It's how we use U that makes it cool. Because Haskell is lazy, we can use infinite lists with the U constructor. For example, i1 = U [-1,-2..] 0 [1,2..] represents all integers. That's not all, though. There's another piece of information: a center point at 0. We could have also represented all integers as i2' = U [0,-1..] 1 [2,3..]. These values are almost the same; they are just shifted by one. We can, in fact, create functions that will transform one into the other.

rightU (U a b (c:cs)) = U (b:a) c cs
leftU  (U (a:as) b c) = U as a (b:c)

As you can see, we can slide a U to the left or the right just by rearranging elements. Let's make a Show instance for U and then verify that rightU and leftU work. We obviously can't print infinite lists, so we'll just take 3 elements from each side.

instance Show x => Show (U x) where
  show (U as x bs) = (show . reverse . take 3) as ++ (show x) ++ (show . take 3) bs

λ i1
[-3,-2,-1]0[1,2,3]
λ leftU i2
[-3,-2,-1]0[1,2,3]
λ i2
[-2,-1,0]1[2,3,4]
λ rightU i1
[-2,-1,0]1[2,3,4]

Let's review our ultimate goal. We want to have a data structure where we can update each value based on all of its neighbors. Let's see how to do that with our U data structure. Suppose we want to replace each number with the sum of its neighbors. First, let's write a function that calculates the neighbors of the current position of a U:

sumOfNeighbors :: U Int -> Int
sumOfNeighbors (U (a:_) _ (b:_)) = a + b

And just to verify that it works:

λ sumOfNeighbors i1
0
λ sumOfNeighbors i2
2

Unfortunately, this only gives us a single result. We want to apply this function to every possible position. Well U has a Functor instance, so we can fmap a function over it. That would work great if our function had a type like Int -> Int, but it's actually U Int -> Int. But what if we could turn our U Int into a U (U Int)? Then fmap sumOfNeighbors would do exactly what we want!

Get ready for some inception-level data structuring. We're going to take our U Int and create a U (U Int) that will look like this:

-- not real Haskell. just for illustration
U [leftU u, (leftU . leftU) u, (leftU . leftU . leftU) u..] u [rightU u, (rightU . rightU) u, (rightU . rightU . rightU) u..]

This center of this new U (U a) is the original U a. When we slide left, we get original U a slid left, and likewise sliding right. In other words, the new U (U a) contains all the left and right slides of the original U a Here's how we do it:

duplicate :: U a -> U (U a)
duplicate u = U lefts u rights
  where lefts  = tail $ iterate leftU u
        rights = tail $ iterate rightU u

We can use duplicate to write the function that we want:

extend :: (U a -> b) -> U a -> U b
extend f = fmap f . duplicate

Let's try it out.

λ extend sumOfNeighbors i1
[-6,-4,-2]0[2,4,6]

Looks like it works. These function names, duplicate and extend weren't chosen arbitrarily (by me, at least). These functions are part of the Comonad type class. We've been implementing it for our U data type.

class Functor w => Comonad w where
  extract :: w a -> a
  duplicate :: w a -> w (w a)
  extend :: (w a -> b) -> w a -> w b

The only thing missing is extract which is trivial for U:

extract (U _ x _) = x

It's probably not apparent how useful this class is yet. Let's move on and look at how to handle the 2-dimensional case. We can do 2-dimensions with a zipper of zippers. That is, U (U a) where moving left and right shifts the inner zippers, and moving up and down shifts the outer zipper.

newtype V a = V { getV :: U (U a) }

instance Functor V where
  fmap f = V . (fmap . fmap) f . getV

-- shift the 'outer' zipper
up :: V a -> V a
up = V . leftU . getV

down :: V a -> V a
down = V . rightU . getV

-- shift the 'inner' zippers
left :: V a -> V a
left = V . fmap leftU .getV

right :: V a -> V a
right = V . fmap rightU . getV

Here's what Comonad looks like for V:

instance Comonad V where
  extract = extract . extract . getV
  duplicate = fmap V . V . dup . dup . getV
    where dup u = U (lefts u) r (right u)
          lefts u  = tail $ iterate (fmap leftU) u
          rights u = tail $ iterate (fmap rightU) u

The extract function is fairly straightforward; it just digs through two layers of zippers to grab the current value. On the other hand, duplicate is sort of a monster. Ignoring the newtype V, its type would be duplicate :: U (U a) -> U (U (U (U a))). The purpose of thedup helper function is to add a U layer. It gets invoked twice. Then we wrap that in V to get a V (U (U a)). Then fmap V wraps the inner U (U a) to make the result V (V a).

Oh by the way, if you're wondering where extend is, we don't actually have to write it. The definition given above is its default.

That was a lot of work, but now we'll be able to easily tackle the original problem! Check this out. I'm going to make a data structure that includes your A and B values, and also a value that we don't care about, C:

data Token = A | B | C deriving (Eq,Show)

And here's some stuff to make building and displaying a V easier.

-- a list of U's containing nothing but x's
filled x = repeat $ U (repeat x) x (repeat x)

type Triple a = (a,a,a)

-- create a U with the middle values a, b, and c, and all the other values the defaulted to d
toU :: a -> Triple a -> U a
toU d (a,b,c) = U (a : repeat d) b (c : repeat d)

-- create a V centered on the 9 given values and default all other values to d
toV :: a -> Triple (Triple a) -> V a
toV d (as, bs, cs) = V (U x y z)
  where x = (toU d as) : filled d
        y = toU d bs
        z = (toU d cs) : filled d

display :: Show a => V a -> [[a]]
display v = fmap g [ [up . left, up, up . right]
                   , [left, id, right]
                   , [down . left, down , down . right] ]
  where g = fmap (extract . ($ v))

Here's what the example looks like:

example = toV C ((A,A,A)
                ,(B,B,A)
                ,(A,A,B))

And the rule is implemented by:

-- move into each neighboring position and get the value in that position
neighbors :: V a -> [a]
neighbors v = fmap (extract . ($ v)) positions
  where positions = [ up . left
                    , up
                    , up . right
                    , left
                    , right
                    , down . left
                    , down
                    , down . right ]

numberOfBs :: V Token -> Int
numberOfBs = length . filter (==B) . neighbors

rule :: V Token -> Token
rule v = case extract v of
  C -> C  -- C's remain C's forever
  _ -> if numberOfBs v >= 2 then B else A

Finally, we can apply rule to every value using extend:

transition = extend rule

λ display (transition example)
[[B,B,A],[A,B,B],[B,B,A]]

This rule is kind of boring though. Everything quickly becomes B's.

λ take 10 $ fmap display (iterate transition example)
[[[A,A,A],[B,B,A],[A,A,B]],[[B,B,A],[A,B,B],[B,B,A]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,B,B],[B,B,B],[B,B,B]]]

Creating a different rule is easy.

rule2 :: V Token -> Token
rule2 v = case extract v of
  C -> C
  A -> if numberOfBs v >= 2 then B else A
  B -> if numberOfBs v >= 4 then A else B

λ take 10 $ fmap display (iterate (extend rule2) example)
[[[A,A,A],[B,B,A],[A,A,B]],[[B,B,A],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]],[[B,A,B],[A,A,A],[B,A,B]],[[B,B,B],[B,B,B],[B,B,B]]]

Cool, right? One final thing I want to mention. Did you notice that we didn't write any special cases to handle the edges? Since the data structure is infinite, we just filled the stuff out of the range which we don't care about with the value C and ignored it when considering the neighbors.