17 October 2009

Suppose we want to find all two factors decompositions of a positive integer. We could try the following naive solution.

``````> let rec inf_seq n = seq { yield n; yield! inf_seq (n+1) };;

val inf_seq : int -> seq<int>

> let omega = inf_seq 1;;

val omega : seq<int>

> for i in omega do
for j in omega do
if (i*j=24) then printf "(%d,%d)" i j;;

- Interrupt
(1,24)

``````

This goes on ad infinitum and prints only one solution after interrupting the evaluation on the F# console.The reason is the following, not all pairs are treated fairly equal. Notice the generated output on the following expression:

``````> seq { for i in (inf_seq 1) do
for j in (inf_seq 1) do yield (i,j)};;
val it : seq<int * int> = seq [(1, 1); (1, 2); (1, 3); (1, 4); ...]

``````

The sequence only generates (1,x) pairs, because the first inner loop will never end iterating.

To address this issue we need a mechanism where the pairs are generated in a fair order. This mechanism is known as diagonalization (because of Cantor’s diagonalization proof). Our diagonalization process will take a lazy list of lazy lists and will rearrange its items following Cantor’s method. The implementation of the function diagonal is given at the end of the post.

``````> let x = diag (LazyList.of_list [omega;omega;omega]);;

val x : LazyList<LazyList<int>>

> x;;
val it : LazyList<LazyList<int>> =
seq [seq ; seq [2; 1]; seq [3; 2; 1]; seq [4; 3; 2]; ...]

``````

We can embed this process into a work-flow (monad)

``````type DiagBuilder () =
member b.Return(x)  = LazyList.of_list [x]
member b.Bind(x, rest) =  LazyList.concat (diag (LazyList.map rest x))
member b.Let(p, rest)  = rest p
member b.Delay(f ) = f ()
member b.Zero() = LazyList.empty()

let diagonal = new DiagBuilder ()

``````

Using the diagonal monad, our initial factorization problem can be solved like this

``````> let all_pairs = diagonal {
let! n = LazyList.of_seq(inf_seq 1)
let! m = LazyList.of_seq(inf_seq 1)
return (n,m)
} ;;

val all_pairs : LazyList<int * int>

> let factors = seq { for (n,m) in all_pairs do if (n*m=24) then yield (n,m) } ;;

val factors : seq<int * int>

> factors;;
val it : seq<int * int> = seq [(4, 6); (6, 4); (3, 8); (8, 3); ...]

``````

There is some small caveat thought, our algorithm does not stop. Also notice that diagonal is not a real monad because our bind operator is not associative.

Here is the function diagonal which completes the program.

``````let rec lzw f l1 l2 =
LazyList.delayed ( fun () ->
match l1,l2 with
|LazyList.Nil, _ -> l2
|_, LazyList.Nil -> l1
|LazyList.Cons(p1,tail1),LazyList.Cons(p2,tail2)
-> LazyList.consf (f p1 p2) (fun () -> lzw f tail1 tail2))

let rec diag input =
LazyList.delayed ( fun () ->
match input with
|LazyList.Nil -> LazyList.empty()
|LazyList.Cons(p,tail)
-> lzw (LazyList.append)
(LazyList.of_seq (seq {for x in p do yield LazyList.of_list [x]}))
(LazyList.consf (LazyList.empty()) (fun () -> diag tail)))

``````

References

• Combinators for logic programming, Michael Spivey and Silvija Seres
• Enumerating a context-free language, Luke Palmer