3

I am currently learning folds in the sense of structural recursion/catamorphisms. I implemented power and factorial using a fold for natural numbers. Please note that I barely know Haskell, so the code is probably awkward:

foldNat zero succ = go
  where
    go n = if (n <= 0) then zero else succ (go (n - 1))

pow n = foldNat 1 (n*)

fact n = foldNat 1 (n*) n

Next I wanted to adapt the fibonacci sequence:

fib n = go n (0,1)
  where
    go !n (!a, !b) | n==0      = a
                   | otherwise = go (n-1) (b, a+b)

With fib I have a pair as second argument whose fields are swapped at each recursive call. I am stuck at this point, because I don't understand the mechanics of the conversion process.

[EDIT]

As noted in the comments my fact function is wrong. Here is a new implementation based on a paramorphism (hopefully):

paraNat zero succ = go 
  where 
    go n = if (n <= 0) then zero else succ (go (n - 1), n)

fact = paraNat 1 (\(r, n) -> n * r)
  • What is the question? This function seems to work fine for me - except the exclamation marks are totally unnecessary (perhaps they are for very large arguments, I'm not great at understanding where strictness is beneficial), and you need to enable the `BangPatterns` GHC extension in order to be allowed to use them. – Robin Zigmond May 03 '19 at 21:37
  • @RobinZigmond I want to implement fib using `foldNat` –  May 03 '19 at 21:39
  • Oh right, I see. Well as a large hint, you can achieve this in a very similar way to your existing `fib` version, by having it work on pairs. You just need to extract the first element of the resulting pair. – Robin Zigmond May 03 '19 at 21:41
  • 4
    Your `fact` implementation is incorrect: it computes n^n. – amalloy May 03 '19 at 23:41
  • 2
    @RobinZigmond Unless GHC's strictness analyzer determines the equivalent to the `!`s (which is possible), then they are not unnecessary if you are concerned about efficiency. It doesn't depend so much on the size of the actual inputs as it does how many operations are performed on them (before the value is examined/forced). In this case, that *does* depend on the size of the argument, but the size of the argument is not, itself, the issue in general. – David Young May 04 '19 at 00:38
  • @amalloy I reimplemented `fact` using a paramorphism. –  May 04 '19 at 06:42
  • 1
    a side note: in your `fib` above the edit, the bang in `!n` isn't necessary since you use `| n==0` as a guard, and that necessarily forces `n` anyway. the forcing of `a` and `b` is good style (even though only one of them is strictly necessary, because of the shifting). --- re your new `fact`: good naming goes a long way towards ease of understanding, and your naming is nonexistent. see "boolean blindness". what is first field? what is second? better to use names, like `paraNat 1 (\(r, n) -> n*r)` with `r` the mnemonic for "Recursive partial Result". so now it is clear that it's correct. – Will Ness May 04 '19 at 07:18
  • 2
    btw `fact = snd . foldNat (0,1) (\(pred,r) -> (pred+1, (pred+1)*r))`. – Will Ness May 04 '19 at 07:39
  • that one emulated a paramorphism by recreating the input structure (number) on the way back, as `pred+1`. another way is `fact n = foldNat (const 1) (\r n -> n * r (n-1) ) n n`, by traversing the same structure twice at the same time, in a synchronized manner -- but manually so (i.e. calling the second `(n-1)` ourselves, in `n * r (n-1)`, *not* having it done *for us* by the `foldNat` definition). Some think it an abomination, apparently, so buyer beware. – Will Ness May 05 '19 at 13:06

1 Answers1

2

Let the types guide you. Here is your foldNat, but with a type signature:

import Numeric.Natural

foldNat :: b -> (b -> b) -> Natural -> b
foldNat zero succ = go
  where
    go n = if (n <= 0) then zero else succ (go (n - 1))

Having another look at the go helper in your implementation of fib, we can note the recursive case takes and returns a (Natural, Natural) pair. Comparing that with the successor argument to foldNat suggests we want b to be (Natural, Natural). That is a nice hint on how the pieces of go should fit:

fibAux = foldNat (0, 1) (\(a, b) -> (b, a + b))

(I am ignoring the matter of strictness for now, but I will get back to that.)

This is not quite fib yet, as can be seen by looking at the result type. Fixing that, though, is no problem, as Robin Zigmond notes:

fib :: Natural -> Natural
fib = fst . foldNat (0, 1) (\(a, b) -> (b, a + b))

At this point, you might want to work backwards and substitute the definition of foldNat to picture how this corresponds to an explicitly recursive solution.

While this is a perfectly good implementation of fib, there is one major difference between it and the one you had written: this one is a lazy right fold (as is the norm for Haskell catamorphisms), while yours was clearly meant as a strict left fold. (And yes, it does make sense to use a strict left fold here: in general, if what you are doing looks like arithmetic, you ideally want strict left, while if it looks like building a data structure, you want lazy right). The good news, though, is that we can use catamorphisms to define pretty much anything that consumes a value recursively... including strict left folds! Here I will use an adapted version of the foldl-from-foldr trick (see this question for a detailed explanation of that in the case of lists), which relies on a function like this:

lise :: (b -> b) -> ((b -> b) -> (b -> b))
lise suc = \g -> \n -> g (suc n)

The idea is that we take advantage of function composition (\n -> g (suc n) is the same as g . suc) to do things in the opposite order -- it is as if we swapped succ and go in the right hand side of your definition of go. lise suc can be used as the successor argument to foldNat. That means we will get a b -> b function in the end rather than a b, but that is not a problem because we can apply it to the zero value ourselves.

Since we want a strict left fold, we have to sneak in a ($!) to make sure suc n is eagerly evaluated:

lise' :: (b -> b) -> ((b -> b) -> (b -> b))
lise' suc = \g -> \n -> g $! suc n

Now we can define a strict left fold (it is to foldNat what foldl' from Data.List is to foldr):

foldNatL' :: b -> (b -> b) -> Natural -> b
foldNatL' zero suc n = foldNat id (lise' suc) n zero

There is a final, important detail to deal with: making the fold strict is of little use if we are lazily building a pair along the way, as the pair components will remain being built lazily. We could deal with that by using ($!) along with (,) for building the pair in the successor function. However, I believe it is nicer to use a strict pair type instead so that we don't have to worry with that:

data SP a b = SP !a !b 
    deriving (Eq, Ord, Show)

fstSP :: SP a b -> a
fstSP (SP a _) = a

sndSP :: SP a b -> b
sndSP (SP _ b) = b

The ! mark the fields as strict (note that you don't need to enable BangPatterns to use them).

With everything in place, we can at last have fib as a strict left fold:

fib' :: Natural -> Natural
fib' = fstSP . foldNatL' (SP 0 1) (\(SP a b) -> SP b (a + b))

P.S.: As amalloy notes, your fac calculates n^n rather than n!. That is probably a matter better left for a separate question; in any case, the gist of it is that factorial is more naturally expressed as a paramorphism on naturals, rather than as a plain catamorphism. (For more on that, see, for instance, the Practical Recursion Schemes blog post by Jared Tobin, more specifically the section about paramorphisms.)

duplode
  • 33,731
  • 7
  • 79
  • 150
  • This is a very comprehensible explanation, thank you. I also enjoyed your blog post on the topic (_What's in a fold_), but polymorphic cata-/anamorphisms etc. are still to advanced for me. I still have some ground work to do. If you feel like it, you can review my edit on the broken `fact` function. –  May 04 '19 at 06:58
  • 1
    @bob Your paramorphism-based `fact` is correct. (If you compare it to other implementations out there, you'll note the pair components in `paraFact` are usually swapped around -- that is `(structure, result)` rather than `(result, structure)` -- but that is just by convention.) – duplode May 04 '19 at 13:04