Zipping Half of a List with Its Reversal

I found this note with one page of Haskell code, without comments, when I was cleaning up my files. It took me quite a while to figure out what it might probably be about: given a list, zip its first half with the reverse of its second half, in only “one and a half” traversals of the list. It gives us a fast algorithm to, for example, check whether a list is a palindrome. I thought it was probably something we discussed in AoP, but it turns out that I must have taken the note when people in IPL were studying There and Back Again of Danvy and Goldberg. Recorded in the note was my attempt to understand it.

Let convolute (xs,ys) = zip xs (reverse ys) and half be a function cutting a list in half, the problem is simply specified by revzip = convolute . half. The first trick is that convolute can be expressed in terms of its generalisation:

> convolute :: ([a],[b]) -> [(a,b)]
> convolute = fstn . uncurry walk
>   where fstn (xs,[]) = xs

where walk is defined by:

  walk xs ys = (zip xs (reverse (take n ys)), drop n ys)
      where n = length xs

The reason introducing walk is that it can be defined as a fold:

> walk = foldr ((.).shift) (split (nil, id))
> shift x (zs,y:ys) = ((x,y):zs, ys)
> nil _ = []

But the definition below is probably a lot more comprehensible:

  walk [] ys = ([],ys)
  walk (x:xs) ys = shift x (walk xs ys)

Some of these auxiliary functions should be part of the Haskell Prelude:

> prod (f,g) (a,b) = (f a, g b)
> split (f,g) a = (f a, g a)

The following implementation of half splits a list into two halfs using two pointers:

> half :: [a] -> ([a],[a])
> half = race . dup 
> race (xs,[]) = ([],xs)
> race (_:xs,[_]) = ([],xs)
> race (x:xs,_:_:ys) = cross ((x:),id) (race (xs,ys))
> dup a = (a,a)

Furthermore, uncurry f = apply . prod (f,id) where

> apply (f,a) = f a

Therefore the specification has become:

  revzip = fstn . apply . prod (walk,id) . race . dup

Now we try to fuse prod (walk,id) . race and get

> wrace (xs,[]) = (split (nil, id), xs)
> wrace (_:xs, [_]) = (split (nil, id), xs)
> wrace (x:xs, _:_:ys) = prod ((shift x .), id) (wrace (xs,ys))

Hence the result:

> revzip = fstn . apply . wrace . dup