How to implement Factorial via Control.Arrow.loop?

Question

I wonder whether it is possible to implement factorial using Control.Arrow.loop.

loop :: ArrowLoop a => a (b, d) (c, d) -> a b c

One of the evident ideas is to implement a somehow terminating branch (a branch where the first element of the pair (type c) wouldn't depend on the second element of the pair (type d)). It seems to me that it can't be done since we can't apply any boolean function to the second element of the pair (type d) during the first iteration because it would cause infinite recursion, so it only leaves us with the argument (type b), but the result of any boolean function wouldn't differ depending on the iteration (the argument doesn't change), thus, it would either terminate instantly or never terminate at all. The other idea I had is to create an endless stream of factorials, but this doesn't seem real either, since, once again, the argument can't be changed. So, I have 3 questions:

1. Am I right about the points above?
2. Am I missing any other concept which would help to implement factorial via Control.Arrow.loop?
3. What is the correct idea behind this implementation?

Answer 1

I've never actually used ArrowLoop before, loop is pretty cool.

Here is a factorial implemented using loop:

fact :: Integer -> Integer
fact =
  loop $ \(n, f) ->
    ( f n 1
    , \i acc ->
        if i > 0
          then f (i - 1) (i * acc)
          else acc)

Let's give it a try:

λ> fact <$> [1..11]
[1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

I don't know if I can answer the first question you have, but for the 3rd one it's obviously possible. For the concepts that could help you, I think the fix point is the one you are looking for. For example you can start by trying this ;)

λ> import Data.Function
λ> fix error

Once you press enough Ctrl+C you can write factorial using fix point:

λ> let fact = fix $ \ f i -> if i > 1 then i * f (i - 1) else i
λ> fact <$> [1..11]
[1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

Edit

It seems like a bit of expansion on the answer could be helpful.

First of all let's look at an alternative and better (due to tail recursion) implementation of fact using fix, so we can see how it compares with our implementation using loop:

factFix :: Integer -> Integer
factFix n =
  fix
    (\f ->
       \i acc ->
         if i > 0
           then f (i - 1) (i * acc)
           else acc)
    n
    1

We can see it is not far off. In both cases we get f as an argument and we return back a function that uses that f, in fact, the returned non-recursive function is identical in both cases. Just for clarity let's extract it an reuse in both places:

factNoRec :: (Ord p, Num p) => (p -> p -> p) -> p -> p -> p
factNoRec f i acc =
  if i > 0
    then f (i - 1) (i * acc)
    else acc

factLoop :: Integer -> Integer
factLoop n = loop (\(k, f) -> (f k 1, factNoRec f)) n

factFix :: Integer -> Integer
factFix n = fix (\f -> factNoRec f) n 1

Hopefully now it is much more apparent that they are really related concepts.

Looking into implementations of fix and loop (at least for functions, cause there are also mfix and loop for Kleisli) provides even more insight into their relation:

λ> fix f = let x = f x in x
λ> loop f b = let (c,d) = f (b,d) in c

They are really close to each other.

How about type signatures:

λ> :t fix
fix :: (t -> t) -> t
λ> :t loop
loop :: ((b, d) -> (c, d)) -> b -> c

Those look different. But if you do a bit of unification in the fact case you'll see that fix and loop acquire types:

λ> :t fix :: ((a -> b -> c) -> (a -> b -> c)) -> a -> b -> c
λ> :t loop :: ((b, a -> b -> c) -> (c, a -> b -> c)) -> b -> c

All of a b and c become all Integer in the end, but looking at type variables instead gives a better insight into what's going on. And really what's going on is just recursion by the means of fixed point combinators.