Wednesday, June 18, 2014

Look and say sequence

If I don't already have the Haskell subreddit link over on the right, I'll add it ASAP.

This evening a Haskell beginner posted about some trouble he was having writing code to generate a particular sequence. I didn't catch on to the sequence he was going for, but I should have from a comment in his code:

enunBlock :: [Int] -> [Int] -- [2,2,2] -> [3,2] | [3] -> [1,3]  

Someone did catch on, though, and asked "Are you trying to make a look and say sequence?" The poster said yes... and off to Wikipedia I went.

Said sequence starts 1, 11, 21, 1211, 111221, ... and the way you get the next term is to take the current one and sort of run-length encode it. The first term would be "one one", i.e. a run of ones of length one, so the second term is 11. That in turn would be described as "two ones", hence the third term is 21, or "one two, one one", giving 1211, and so on.

If each digit were on its own line, you could get the next term of the sequence by piping it through uniq -c and playing some sed games to pull out some whitespace. (Hey, wait; will we ever have a run length needing two digits? Actually, you can bound it even more tightly than that, unless you pick a starting value that forces the issue. The result, and a reference, is in the Wikipedia article.)

We'll go along with the poster--as you can see from that declaration, he's using a [Int] for a term of the sequence, saving some hassle. If we can just write a function that takes a term and generates the next, then, if you've read much here or done much Haskell at all, then you know where we're headed for the sequence, namely iterate.

lookAndSay :: [Int] -> [[Int]]
lookAndSay xs = iterate nextTerm xs
     where nextTerm xs = ...

So, how to define nextTerm (that's what we're calling what the original poster called enunBlock)? Clearly our base case is

nextTerm [] = []

the more interesting one is

nextTerm (x:xs) = ....

and for it we're going to take advantage of span from Data.List:

nextTerm (x:xs) = length run  + 1 : x : (nextTerm leftovers)
      where (run, leftovers) = span (== x)  xs

put it all together after a pass through hlint, and you have

import Data.List

lookAndSay :: [Int] -> [[Int]]
lookAndSay = iterate nextTerm
    where nextTerm []     = []
          nextTerm (x:xs) = length run + 1 : x : nextTerm leftovers
                            where (run, leftovers) = span (== x) xs


UPDATE: Aha! Should've looked closer at what the poster was trying to do. He or she was looking to use group which takes a list and chops it up into a list of lists made up of the runs of equal elements; for example, if you hand it "balloon", you get back ["b", "a", "ll", "oo", "n"]. That does come closer to what we want, but we need the counts and to get rid of the duplicates where they exist, something like

nextTerm xs = concat [[length ys, head ys] | ys <- group xs]

or, if you're feeling pointless--er, pointfree,

nextTerm = concat . (map (\xs -> [length xs, head xs]) . group

and sure enough, that does the trick.

UPDATE: Darn it! You'd think that after having found and used sequence, I'd remember it. Make that

nextTerm = concat . map (sequence [length, head]) . group

and we'll be that much more concise. Ah, even better is

nextTerm = concatMap (sequence [length, head]) . group

and once you have it boiled down this far, why bother giving it a name? Once the smoke clears, the whole thing is just

import Data.List

lookAndSay :: [Int] -> [[Int]]
lookAndSay = iterate $ concatMap (sequence [length, head]) . group

Clearly I need to spend some time just rummaging through the available functions... and now I'll have Cream's "I Feel Free" stuck in my head until I take a stab at a filk, working title "I'm Pointfree".

1 comment:

Chris Gulley said...

Nice solution. It inspired to me to create a similar solution in Swift at http://iosdevstuff.blogspot.com/2015/10/improved-look-and-say-implementing-span.html

Riddler Classic, May 23, 2020—Holy Mackerel!

Another one using Peter Norvig's word list . It turns out that the word "mackerel" has a curious property: there is exactly ...