The Ted Neward F# Folding Challenge

My friend, and fellow Professional F# 2.0 author, Ted Neward recently challenged me to a bit of a Code Kata.   Take a list of numbers and compress it in a particular simple way but without any mutable state.  What makes this problem interesting is that a tech interviewer mentioned that that he hadn’t seen a functional solution to this problem.  I also wanted to share this because I think it’s a great example of how to convert an imperative loop into a functional fold.

So, on to the problem.

Given a set of numbers like [4; 5; 5; 5; 3; 3], compress it to be an alternating list of  counts and numbers.

For example, the solution for [4; 5; 5; 5; 3; 3] would be [1; 4; 3; 5; 2; 3], as the list consists of one four, then three fives and finally two threes.  Ordering counts as the initial list must be reconstructable from the compressed list.  The answer to [4; 5; 4] would be [1; 4; 1; 5; 1; 4]

The imperative solution is rather simple, we use three variables outside of a loop:  a last value, a count and an accumulator list.

let clImp list =
    let mutable value = 0
    let mutable count = 0
    let output = new System.Collections.Generic.List<_>()
    for element in list do
        if element <> value && count > 0 then
            output.Add(count)
            output.Add(value)
            count <- 0
        value <- element
        count <- count + 1
    if count > 0 then
        output.Add(count)
        output.Add(value)
    output

Using the normal .NET mutable list type, this version works efficiently and produces the output we expect.

> let compressed = clImp numbers
   Seq.iter (fun e -> printf "%i " e) compressed;;

1 4 3 5 2 3

How might we convert this to a functional style?  In this example, the general type of operation could be thought of as the gradual building of a data structure while walking over a list.  F# just happens to have a list processing function designed just for this task.  This function is named fold and it is one of the most useful constructs in any functional programmer’s tool chest.

let clFold input =
    let (count, value, output) =
        List.fold
            (fun (count, value, output) element ->
                if element <> value && count > 0 then
                    1, element, output @ [count; value]
                else
                    count + 1, element, output)
            (0 , 0, [])
            input
    output @ [count; value]

Here, we are doing almost exactly the same thing as in the imperative version but with a fold instead of a loop.   The secret is that instead of putting variables outside of our loop and changing them with mutation, we have added them as elements in our accumulator tuple.  In this way, the values are updated when each element is visited with no mutation.

However, there is one serious problem with this example.  Appending to the end of a linked list requires recreating every node in that list.  This will make our algorithm grow exponentially slower approximately in proportion to the length of the input list.  To correct this we have two choices: do a head append with a normal fold and reverse the list when we are done, or use foldBack.  The foldBack version is a rather small step from here and looks much nicer, so let’s go in that direction.

let clFoldBack input =
    let (count, value, output) =
        List.foldBack
            (fun element (count, value, output) ->
                if element <> value && count > 0 then
                    1, element, [count; value] @ output
                else
                    count + 1, element, output)
            input
            (0, 0, [])
    [count; value] @ output

There are only two real changes here.  First, we are using foldBack instead of fold.  This change causes some argument reordering.  Second, we are appending to the head of the output list instead of the tail.  It works well, is rather fast and is easy to understand if you are comfortable with folds.

However, there is a bit of a dirty secret here.  Under the hood foldBack converts its input list into an array when the size is large.  As arrays have linear element look up time, they can be walked through backwards very quickly.  Does this make the solution not functional?  You’d never know unless you looked at the underlying implementation.  Anyway, however  you want to label it,  it sure works well.

If you liked this example and want to see more check out our book, Professional F# 2.0.   It’s just about to be done.  In fact, I better get back to editing.

Enjoy this post? Continue the conversation with me on twitter.

Tags: , , , , ,

23 comments

  1. The simplest thing I came up with using clojure:

    (flatten (map (fn [ns] [(count ns) (first ns)]) (partition-by identity [4 5 5 3 6 6 6 6 7 8 8])))

    • Christophe Grand pointed me to “mapcat” and so my example becomes…

      (mapcat (fn [ns] [(count ns) (first ns)]) (partition-by identity [4 5 5 3 6 6 6 6 7 8 8]))

      • Since you first posted I’ve been thinking about how to write a shorter version of this. Code Golf is always fun. However, F#’s partition is different from clojure’s (commutative), and so I can’t take that path.

        Ultimately, it seems to me like no combination of the supplied library functions can come close to just that simple fold. I’d love to be proven wrong though.

  2. // Playing with the Folding Challenge

    let test = [4; 5; 5; 5; 3; 3]
    let ans = [1; 4; 3; 5; 2; 3]
    printfn “Goal: %A” ans

    let compress l =
    let compressor acc aNum =
    match acc with
    | count, theNum, soFar when aNum = theNum -> (count + 1, theNum, soFar)
    | count, theNum, soFar when count > 0 -> (1, aNum, theNum :: count :: soFar)
    | _, _, soFar -> (1, aNum, soFar)
    let count, theNum, soFar = List.fold compressor (0, 0, []) l
    if count = 0 then
    List.rev soFar
    else
    List.rev (theNum :: count :: soFar)

    let a = compress test
    printfn “Res: %A” a
    printfn “%b” (a = ans)

    let partition_by (f : ‘a -> ‘b) (l : ‘a list) : ‘a list list =
    let rec divider (soFar : ‘a list list) (last : ‘b option) (part : ‘a list) rest =
    match rest, last with
    | [], None -> soFar
    | [], Some(b) -> part :: soFar
    | x::more, None -> divider soFar (Some(f x)) [x] more
    | x::more, Some(b) ->
    let b2 = f x
    if b = b2 then
    divider soFar last (x :: part) more
    else
    divider ((List.rev part) :: soFar) (Some(b2)) [x] more
    List.rev (divider [] None [] l)

    let identity a = a
    printfn “%A” (partition_by identity test)

    let compress2 l =
    l |>
    partition_by identity |>
    List.map (fun l -> [l.Length; l.Head]) |>
    List.concat

    printfn “%A” (compress2 test)

  3. This looks problem 10 from 99 Problems in Prolog (https://prof.ti.bfh.ch/hew1/informatik3/prolog/p-99/).

    Googling “99 problems in X” where X is a language tends to end up with a solution for most languages :)

  4. And a Haskell version for good measure:

    [code]
    import Data.List

    f xs = group xs >>= \x -> [length x, head x]

    main = print $ f [4,5,5,5,3,3] == [1,4,3,5,2,3]
    [/code]

  5. Scala version:

    val foldFunction = {(result:List[Int], value:Int) =>
    if (!result.isEmpty && value == result.head) {
    value :: result.tail.head + 1 :: result.tail.tail
    } else {
    value :: 1 :: result
    }
    }
    println(List(4,5,5,5,3,3).foldLeft(List[Int]())(foldFunction).reverse)

  6. Using Perl 6:

    my @in = 4, 5, 5, 5, 3, 3;
    my $count = 0;
    my @out = gather for @in Z [Mu, @in[0..@in.end-1]] -> $a, $b {
    if $b && $b != $a {
    take $count => $b;
    $count = 1;
    }
    else {
    $count++;
    }
    };

    @out.push($count => @in[@in.end]);

    @out.perl.say;

    I am quite certain there is a much more elegant way than this, but my Perl 6 knowledge is very little and this is the best I can come up with.

    • It’s been pointed to me that using stateful variable like $count isn’t functional. Here’s another approach (hopefully functional enough) in Perl 6:

      (
      reduce {
      $^a.elems
      ?? $^b != $^a[*-1]
      ?? [ $^a[*], 1, $^b ]
      !! [ $^a[0..$^a.elems-3], $^a[*-2]+1, $^b ]
      !! [ 1, $^b ]
      }, [], 4, 5, 5, 5, 3, 3
      ).perl.say;

  7. Here’s another Haskell solution, this time without group. It’s a bit naughty, because it does a lot of list con- and destruction.

    foldr (
    \(a, b) abs -> a:b:abs
    ) [] . foldr (
    \a ps ->
    case ps of
    (n, a'):rest | a == a' -> (n + 1, a):rest
    otherwise -> (1, a):ps
    ) []

  8. Here is a one-liner in Scala:

    Seq(4,5,5,5,3,3) groupBy identity flatMap { case (n, l) => Seq(l.size, n) }
    => List(1, 4, 2, 3, 3, 5)

    • Hi Eric, your one-liner is unfortunately incorrect since ‘groupBy’ produces groups irrespective of element sequencing.

      Here’s another Scala variation, similar to Tim Dalton’s above,

      def compress[T](l: List[T]) = l.foldLeft(List[(T, Int)]()) {
      case (Nil, x) => (x, 1) :: Nil
      case ((y, c) :: r, x) if (x == y) => (x, c+1) :: r
      case (l, x) => (x, 1) :: l
      }.reverse

      scala> compress(List(4,5,5,5,3,3))
      res0: List[(Int, Int)] = List((4,1), (5,3), (3,2))

  9. // scala

    def fold(list:List[Int]) = list.foldRight(List[Int]()){ (e, a) => a match {
    case num :: `e` :: rest => num + 1 :: e :: rest
    case _ => 1 :: e :: a
    }
    }

    def reconstruct(list:List[Int]):List[Int] = list match {
    case Nil => Nil
    case num :: e :: rest => Nil.padTo(num, e) ::: reconstruct(rest)
    }

    val challenge1 = List(4, 5, 5, 5, 3, 3)
    val result1 = List(1, 4, 3, 5, 2, 3)
    val challenge2 = List(4, 5 , 4)
    val result2 = List(1, 4, 1, 5, 1, 4)

    fold(challenge1) == result1
    fold(challenge2) == result2

    reconstruct(result1) == challenge1
    reconstruct(result2) == challenge2

  10. Blake Hegerle

    Here’s a solution that I think is more idiomatic of functional programming, with an added benefit of being slightly shorter and possibly easier to understand.

    let rle list =
    let push n list =
    match list with
    | c :: m :: t when m=n -> (c+1)::m::t
    | t -> 1::n::t
    List.foldBack push list []

  11. @Blake, your solution is the best listed here, concise and clear, thanks!

  12. The Ted Neward F# Folding Challenge « Inviting Epiphany…

    Thank you for submitting this cool story – Trackback from DotNetShoutout…

  13. [...] This post was mentioned on Twitter by dmohl, Richard Minerich. Richard Minerich said: Blogged: The Ted Neward F# Folding Challenge http://bit.ly/8ZXYLT #fsharp [...]

  14. [...] The Ted Neward F# Folding Challenge – Richard Minerich shares a Functional Programming Code Kata learning exercise from Ted Neward, looking at an easy imperative solution, and the more challenging functional solution. [...]

  15. [...] Rick Minerich’s The Ted Neward F# Folding Challenge [...]

  16. [...] route when generating sequence values by using the Seq.init function.  As I discussed in my Ted Neward’s Folding Challenge post, the contents of the folding function can be directly mapped to the imperative and recursive [...]

Leave a comment