khi’s life with an ech

In my recent posts I’ve played with Euler problem 2 and hylomorphism: here I use the hylomorphism concept to solve the Euler problem 2 using Ocaml 🙂

(* Given a hylomorphism implementation ...*)
let rec hylo_impl step till col inj v s =
    if till s
    then v
    else
        let ns = step s in
        let nv = inj (col s) v in
        hylo_impl step till col inj nv ns
;;

(* ... solving Euler problem 2 is quite easy! *)
let eul2 n =
    hylo_impl
        (fun (n0, n1) -> (n1, n0 + n1))
        (fun (n0, n1) -> n0 > n)
        (fun (n0, n1) -> if n0 mod 2 == 0 then n0 else 0)
        (fun x a -> x + a)
        0
        (1, 1)
;;

This time I tried to add default value with labels notation of Ocaml. But I have a problem with type inference: if the given default function has a type, all function I pass as parameter must have the same type as the default one … still have to learn a bit more about polymorphism in ocaml I presume ;). The following code may work in some case, but it forces the type of the functions, which is really bad! Any advice to solve this problem?

let hylo
        ?(step = fun x -> x + 1)
        ?(till = fun x -> true)
        ?(col = fun x -> x)
        ?(inj = ((fun x a -> x :: a), []))
        s
    =
    let (injf, injv) = inj in
    hylo_impl step till col injf injv s
;;

This blogpost present a good F# solution to Euler problem 2. The code make use of infinite sequence. I’ve written other solutions to this same problem. The first one is a code specialized to solve this problem: it computes the fibonacci sequence while checking the problem conditions and computing the problem answer.

#light

let rec fib_filter_fold (n0,n1) filter folder acc m =
    if n0 <= m
    then fib_filter_fold (n1, n0 + n1) filter folder (if filter n0 then (folder acc n0) else acc) m
    else acc

let pb2 m = fib_filter_fold (1,1) (fun x -> x % 2 = 0) (fun acc x -> acc + x) 0 m

printf "euler problem 2 (1000000): %a\n" output_any (pb2 1000000)

I then wrote a second version, trying to make use of Seq functions. Idea is to start with the fibonacci sequence and apply some modification on it to solve the problem. I’m not so happy with the result!

let fibs =
    Seq.unfold
        (fun (n0, n1) -> Some(n0, (n1, n0 + n1)))
        (1, 1)

let reach_index s m =
    s
    |> Seq.mapi (fun i x -> (i, x))
    |> Seq.find_index (fun x -> x > m)

let pb2seq n =
    Seq.truncate (reach_index fibs n) fibs
    |> Seq.filter (fun x -> x % 2 = 0)
    |> Seq.fold (fun acc x -> acc + x) 0

printf "euler problem with seq (1000000): %a\n" output_any (pb2seq 1000000)

Why don’t I like this? because I have to manipulate the sequence twice, first to find the index of the last element to take into account, and second to compute the problem answer.I would have like a method ‘take_while’ in Seq to write something in the line of:

let pb2_not_compilable n =
    fibs
    |> Seq.take_while (fun x -> x < n)
    |> Seq.filter (fun x -> x % 2 = 0)
    |> Seq.fold (fun acc x -> acc + x) 0

… am I missing something?Btw, how to implement this “take_while” function? I’ve try, but Seq has a ‘hd’ function but no ‘tail’ … what am I missing here? I’m sure this is possible to implement …

The previous blogpost implements a hylomorphism in Erlang.

Following is again the same in F#: but this is part of my exercices to learn F#, and I just begin to learn … so the code is … ergh, whatever.

And I have no idea how to implement default values. Any advice?

#light
open Microsoft.FSharp.Collections.List;

let rec hylo step till col inj v s =
    if till s
    then
        v
    else
        let ns = step s in
        let nv = inj v (col s) in
        hylo step till col inj nv ns;

let fact =
    let step = fun x -> x - 1 in
    let till = fun x -> x <= 1 in
    let col = fun x -> x in
    let inj = fun a x -> a * x in
    hylo step till col inj 1;

let evens n =
    let step = fun x -> x + 2 in
    let till = fun x -> x >= n in
    let col = fun x -> x in
    let inj = fun a x -> x :: a in
    rev (hylo step till col inj [] 0);

let to_bin n =
    let step = fun x -> x / 2 in
    let till = fun x -> x <= 0 in
    let col = fun x -> x % 2 in
    let inj = fun a x -> x :: a in
    hylo step till col inj [] n;

let expand l =
    let rec duplicate c n a =
        if n > 0
        then duplicate c (n - 1) (c::a)
        else a
        in
    let step = fun li -> tl li in
    let till = fun li -> match li with |[] -> true |_ -> false in
    let col = fun li -> match hd(li) with |(c,n) -> duplicate c n [] in
    let inj = fun a x -> (x :: a) in
    rev (hylo step till col inj [] l);

do printf "fact(5)=%a\n" output_any (fact 5);
do printf "evens(10)=%a\n" output_any (evens 10);
do printf "to_bin(10)=%a\n" output_any (to_bin 10);
do printf "expand([(1,2); (4,7)])=%a\n" output_any (expand [(1, 2); (4,7)]); 

Read some introductions to theory of categories (a very good introduction to the theory, or this one more programmer oriented). As I also stumble upon this thread, I discover a new concept: “hylomorphism is a composite of an anamorphism (unfold) and an catamorphism (fold/inject) [1], [2]“, along with a ruby code to implement it in some way (this the googlegroup thread above).

Just for fun (and be sure to understand it), I translated the code in Erlang. I’ve used the property list module to implement some kind of default value, but it’s not really elegant. Anyway, code is here.

-module(hylo).
-export([
    % hylomorphism API
    new/1,
    % examples/toys
    evens/1,
    fact/1,
    to_bin/1,
    expand/1
]).

% internal declarations

-record(hylo, {
    do,
    till,
    collecting,
    injecting
}).

% API

new(PL) when is_list(PL) ->
    H = #hylo{
        do = proplists:get_value(
            do,
            PL,
            fun(X) -> X + 1 end
        ),
        till = proplists:get_value(
            till,
            PL,
            fun(X) -> X =:= undefined end
        ),
        collecting = proplists:get_value(
            collecting,
            PL,
            fun(X) -> X end
        ),
        injecting = proplists:get_value(
            injecting,
            PL,
            {   [],
                fun(A,E) -> [E|A] end,
                fun lists:reverse/1
            }
        )
    },
    fun(S) -> eval(H, S, element(1,H#hylo.injecting)) end.

% internal implementation

eval(H, S1, R) ->
    {_, InjF, InjR} = H#hylo.injecting,
    case (H#hylo.till)(S1) of
        false ->
            V = (H#hylo.collecting)(S1),
            S2 = (H#hylo.do)(S1),
            eval(H, S2, InjF(R, V));
        _ ->
            InjR(R)
    end.

% examples

evens(N) ->
    H = new([
        {do, fun(X) -> X + 2 end},
        {till, fun(X) -> X >= N end}
    ]),
    H(0).

fact(N) when N > 0 ->
    H = new([
        {do, fun(X) -> X - 1 end},
        {till, fun(X) -> X =< 1 end},
        {injecting, {1, fun(A,E) -> A * E end, fun(A) -> A end}}
    ]),
    H(N).

to_bin(N) when N > 0 ->
    H = new([
        {do, fun(X) -> X div 2 end},
        {till, fun(X) -> X =< 0 end},
        {collecting, fun(X) -> (X rem 2) end},
        {injecting, {[], fun(A,E) -> [E|A] end, fun(A) -> A end}}
    ]),
    H(N).

expand(L) ->
    H = new([
        {do, fun ([_|T]) -> T; ([]) -> [] end},
        {till, fun ([]) -> true; (_) -> false end},
        {collecting, fun([{C,N}|_]) -> lists:duplicate(N, C) end}
    ]),
    H(L).

-ifdef(EUNIT).
-include_lib("eunit/include/eunit.hrl").

evens_test() ->
    ?assert(evens(10) =:= [0,2,4,6,8]).

fact_test() ->
    ?assert(fact(5) =:= 120).

to_bin_test() ->
    ?assert(to_bin(10) =:= [1,0,1,0]).

expand_test() ->
    ?assert(expand([{$a,2},{$b,3},{$c,4}]) =:= ["aa", "bbb", "cccc"]).

-endif.