Llayland’s Food, Oracle, and Haskell

May 31, 2011

An example of circular programming

Filed under: Haskell — llayland @ 6:36 am

Something clicked the other day and I was able to get past the mental block I had with circular programming.

I was trying to optimize counting the transpositions between a sting and a permutation of that string. Earlier code left me at a nice starting point,where the pair of strings was represented as [[(Int,Int)]] with the first Int being the position of a character in the first string and the second being the position of the same character int the permutation. For example:

abcd_abcd = [ [(1,1)]
            , [(2,2)]
            , [(3,3)]
            , [(4,4)]
            ] :: [[(Int,Int)]]

abcd_acbd = [ [(1,1)]
            , [(2,3)]
            , [(3,2)]
            , [(4,4)]
            ] :: [[(Int,Int)]]

dcbaabcd_dbcaacbd = [ [(4,4),(5,5)]
                    , [(3,2),(6,7)]
                    , [(2,3),(7,6)]
                    , [(1,1),(8,8)]
                    ] :: [[(Int,Int)]]

One way to solve this is to concatenate the lists, sort by the first elements of the pairs, and then fold with a function that counts the changes in direction of the second elements of the pairs.

foldl' f (GT,0,0) . map snd . sort . concat
   where f (dir, cnt,n) n' = (dir',  if dir = dir' then cnt else cnt +1, n')
         dir' = compare n' n

This works, but I wanted a one pass solution. I also didn't need a full sort, just the ability to access the next and previous match. I got stuck for quite a while before deciding to start with a two pass solution. First I have a hashmap defined recursively in terms of itself. I did not realize it at the time, but this is actually very similar to the fold above. The base case of the first element corresponds loosely to the initializer and the recursive case corresponds to carrying of "dir" and "n" in the accumulating function

h :: [[(Int,Int)]] -> HM.HashMap Int (Ordering, Ordering, Int)
h ms =  foldl (foldr f) HM.empty ms
   where h' = h ms
         f (key, val) = case key of 
                          1 -> HM.insert 1 (GT, GT, val)
                          n -> let (old_dir, old_val) = find (n-1) in HM.insert n (old_dir, compare val old_val, val)
         find n = let (Just (dir, _, val)) = HM.lookup n h' in (dir, val)

Now I just need a second pass for the counting:

trans :: HM.HashMap Int (Ordering, Ordering, Int) -> Int
trans = HM.fold f 0
  where f (old_dir, dir, _) c = if dir == old_dir then c else c+1

This seems really easy in retrospect, but writing it involved a lot of false starts and felt like going down the rabbit hole. Once I got done celebrating, moving on to a one pass solution was easy. I already knew I could have a structure that would have the preceding element available by the time I needed it. I just need one that also has the next element available by the time I need it.

h2 :: [[(Int,Int)]] -> HM.HashMap Int (Ordering, Ordering, Int, Int)
h2 ms = foldl (foldr f ) HM.empty ms
   where h2' = h2 ms
         f (key, val) = case key of 
                          1 ->  HM.insert key (GT, GT, val, 0)
                          n -> let (old_dir, old_val) = prev n 
                                   new_c = next n
                                   dir = compare val old_val
                                   in HM.insert n (old_dir, dir, val, if old_dir == dir then new_c else new_c+1)
         prev n = let (Just (dir, _, val, _)) = HM.lookup (n-1) h2' in (dir, val)
         next n = case HM.lookup (n+1) h2' of
                       Nothing -> 0
                       Just (_, _, _, c) -> c 

trans2 ms = let (Just (_, _, _, c)) = HM.lookup 2 (h2 ms) in c

The correspondence to my original fold has broken down. The base case is still the same, but now it looks like my recursive case is recursing in both directions at once. So why do I need to go both ways? If I accumulated upwards, I would not know where to look for the answer. Accumulating downwards lets me always look at element 2. Similarly, I can't calculate the direction changes downwards because I wouldn't know where to start.

My takeaways from this exercise are:

  1. Just pretend like you already have the structure you need
  2. don't get caught up in how magical it seems.
  3. don't overthink it. Assume it will work and do it

Blog at WordPress.com.