Wednesday 30 September 2015

Heavy lifting: Mountains out of molehills

Small post today on some lovely stuff, time to strut that elegant Haskell plumage;

The specific task:
I represent a grid: `type Grid = (Int -> Info, Int -> Info)`
where the two functions are: `row index -> row information, col index -> col information`.

I have a function that updates a particular location (row, index) in the grid that manifests with an update to the row/column information (the update may fail):
`update :: Info -> Maybe Info`

However if the update fails, the entire grid becomes inconsistent so I want to propagate that inconsistency up.
Thus the problem is to create a function `liftInfoEdit: (Int, Int) -> (Info -> Maybe Info) -> Grid -> Maybe Grid`
That's the outline, the corner pieces.

This is a pretty cool theme pervasive in Haskell: leverage existing machinery to raise a function editing a piece of information up through the layers of the structure containing that information.

The first thing to note is that the edit is identical and independent w.r.t. the row and column of the grid; therefore we split our ed `t` into two separate streams and then finally join them together:

`t :: (Int -> Info) -> Maybe (Int -> Info)
trans :: Grid -> Maybe Grid
trans = (liftA2 . liftA2) (uncurry (,)) (t***t) $ grid`

Now we need to define `t`.
So what we could do is go down the following path:
Turn `(Int -> Info)` to `(Int -> Maybe Info)`. What we would like to do at this point is `(Int -> Maybe Info) -> Maybe (Int -> Info)` however the tires simply squeal in the mud. We want a change on a small portion of the function to be reflected on the entirety of the function.

What we could do instead is, split our function up and then glue it back together. Before we go further, one abstraction for a function `a -> b` is a `set(a, b)`.
Splitting a function up ~ split up its domain into 'a' and the rest.
`splitUpF :: a -> (a -> b) -> ((a, b), a -> b)
splitUpF a f = ((a, f a), f)

mergeF :: Eq a => ((a, b), a -> b) -> a -> b
mergeF ((a, b), g) a' | a == a' = b
                      | otherwise = g a'`


We now have all the pieces, its time to put them together; its time to do the dance: the jig-saw.

setG (r, c) v = updateLine (Row r) c v >=> updateLine (Col c) r v

updateLine :: Line -> Ind -> Maybe Value -> Grid -> Maybe Grid
updateLine l j v grid = dimap isom1 (uncurry (liftA2 (curry isom2)))
                        (finalFunc *** Just)
                        $ grid
    where
      isom1 = view (from iso1)
      isom2 = view iso1
      (info, cond) = grid l
      finalFunc :: (Line -> Info) -> Maybe (Line -> Info)
      finalFunc = splitUpF l >>>
                  (g *** Just) >>>
                  uncurry (liftA2 (curry mergeF))
      g = second h >>> uncurry (fmap . (,))
      h info = if cond info'
               then Just info
               else Nothing
          where
            info' = info & rep %~ f
            f :: Digs -> Digs
            f p i | i == j = v
                  | otherwise = p i


No comments:

Post a Comment