signature STREAM =
    sig 
        (* Type stream *)
        type 'a seq

        (* Exception levée lors de la tentative d'accès à un stream vide *)
        exception Stream_vide

        (* Stream vide *)
        val vide : 'a seq 

        (* Continuation d'un stream *)
        val cons : 'a * (unit -> 'a seq) -> 'a seq 

        (* Teste si un stream est vide *)
        val est_vide : 'a seq -> bool 

        (* Accès à la tête d'un stream *)
        val tete : 'a seq -> 'a   

        (* Appel de la fonction associée à la queue d'un stream *)
        val queue : 'a seq -> 'a seq

        (* Produit la liste des n premiers éléments d'un stream *)
        val prendre : int -> 'a seq -> 'a list

        (* Keme élément d'un stream *)
        val kieme : int -> 'a seq -> 'a

        (* Filtre/transforme un stream *)
        val filtre_app : ('a -> bool) -> ('a -> 'b) -> 'a seq -> 'b seq

        (* Produit, pour une fonction f et un x donnés, *)
        (* le stream associé à x, f(x), f(f(x)), ....   *)
        val iterer : ('a -> 'a) -> 'a -> 'a seq

        (* Transforme une liste en stream *)
        val liste_stream : 'a list -> 'a seq
    end;

structure Stream :> STREAM =
    struct
        datatype 'a seq =
            Nil
          | Cons of 'a * (unit -> 'a seq);

        exception Stream_vide;

        val vide     = Nil;

        val cons     = Cons;

        fun est_vide Nil = true
          | est_vide _   = false;

        fun tete (Cons (x, xf)) = x
          | tete Nil            = raise Stream_vide;

        fun queue (Cons (x, xf)) = xf()
          | queue Nil            = raise Stream_vide;

        fun prendre 0 xq             = []
          | prendre n Nil            = raise Stream_vide
          | prendre n (Cons (x, xf)) = x::(prendre (n-1) (xf()));


        fun kieme n Nil = raise Stream_vide
          | kieme n (Cons (x,xf)) =
            if n=1 then x
            else kieme (n-1) (xf());
            
        fun filtre_app p f Nil            = Nil
          | filtre_app p f (Cons (x, xf)) = 
            if (p x) then Cons (f x, fn () => filtre_app p f (xf()))
            else filtre_app p f (xf());
                
        fun iterer f x = Cons (x, fn () => iterer f (f x));
            
        fun liste_stream [] = Nil
      | liste_stream (x::xs) = Cons (x, fn () => liste_stream xs);
    end;

open Stream;

(*----------------------------------------------------------------------------*)
(*                                 EXERCICE 1                                 *)
(*----------------------------------------------------------------------------*)

(* [Question 1] *)

fun DFC f k =
    let
        fun dfc_aux 0 res = res
          | dfc_aux d res = dfc_aux (d-1) ((real (f d)) + (1.0/res))
    in
        dfc_aux (k-1) (real (f k))
    end;

(*----------------------------------------------------------------------------*)

(* [Question 2] *)

load "String";
fun sturmien f =
    let 
        fun concatener 0 mot res = res
          | concatener k mot res = concatener (k-1) mot (concat [res,mot])
            
        and suivant k (m1, m2) = 
            cons((m1,m2), 
                 fn () => suivant (k+1) (m2, concat [concatener (f k) m2 "", m1]))
    in
        filtre_app (fn n => true) (fn (x,y) => y) (suivant 1 ("b", "a"))
    end;

(* Applications : le mot de Fibonacci : f(n)=1 quel que soit n. *)
(*                le mot f(n)=n.                                *)

fun f1 (n :int) = 1;
fun f2 (n :int) = n;

val sturmien1 = sturmien f1;
val sturmien2 = sturmien f2;

(*----------------------------------------------------------------------------*)

(* [Question 3] *)

fun pente f =
    let 
        fun distribution []      res   = res
          | distribution (x::xs) (a,b) = 
            if (x = #"a") then (distribution xs (a+1,b))
            else (distribution xs (a,b+1))
        and rapport (a, b) = 
            if (b=0) then 0.0
            else (real a) / (real b)
    in
        filtre_app 
        (fn n=>true) 
        (fn mot => rapport (distribution (explode mot) (0,0))) 
        (sturmien f)
    end;

val pente1 = pente f1;
val pente2 = pente f2;

[(DFC f1 1, kieme 2 pente1), (DFC f1 2, kieme 3 pente1), (DFC f1 3, kieme 4 pente1), 
(DFC f1 4, kieme 5 pente1), (DFC f1 5, kieme 6 pente1), (DFC f1 6, kieme 7 pente1), 
(DFC f1 7, kieme 8 pente1), (DFC f1 8, kieme 9 pente1), (DFC f1 9, kieme 10 pente1)];

[(DFC f2 1, kieme 2 pente2), (DFC f2 2, kieme 3 pente2), (DFC f2 3, kieme 4 pente2), 
(DFC f2 4, kieme 5 pente2), (DFC f2 5, kieme 6 pente2), (DFC f2 6, kieme 7 pente2), 
(DFC f2 7, kieme 8 pente2), (DFC f2 8, kieme 9 pente2), (DFC f2 9, kieme 10 pente2)];

(*----------------------------------------------------------------------------*)

(* [Question 4] *)

(* nb_fibonacci      : F_1, F_2, ...         *)
(* rapport_fibonacci : F_1/F_0, F_2/F_1, ... *)

local 
    fun fibo_aux (a,b) = cons((a,b), fn () => fibo_aux (b, a+b))
in
    val nb_fibonacci = 
        filtre_app (fn n => true) (fn (a,b) => b) (fibo_aux (1,1))
    and rapport_fibonacci = 
        filtre_app (fn n => true) (fn (a,b) => (real b) / (real a)) (fibo_aux (1,1))
end;

(*----------------------------------------------------------------------------*)

(* [Question 5] *)

fun comparer_fibonacci  k = 
    let fun comparer_aux i nombres mots = 
        if (i = k+1) 
            then NONE
        else 
            let 
                val mot = tete mots
            in
                if ((tete nombres) <> (size mot)) 
                    then SOME mot
                else
                    comparer_aux (i+1) (queue nombres) (queue mots)
            end
    in
        comparer_aux 1 nb_fibonacci sturmien1
    end;

comparer_fibonacci 30;

(* Fonction plus générale : comparaison de deux streams.                *)
(* comp : fonction de comparaison entre les éléments des streams.       *)
(* Cette fonction renvoie le premier couple dont la comparaison échoue. *)

fun comparer_streams stream1 stream2 comp k = 
    let fun comparer_aux i s1 s2 =
        if (i = k+1) 
            then NONE
        else 
            let 
                val tete1 = tete s1
                and tete2 = tete s2
            in
                if ((comp (tete1, tete2)) = false)
                    then SOME (tete1, tete2)
                else
                    comparer_aux (i+1) (queue s1) (queue s2)
            end
    in
        comparer_aux 1 stream1 stream2
    end;

val comparer_fibonacci2 = 
    comparer_streams nb_fibonacci sturmien1 (fn (x, y) => (x = size y));

(* La commande précédente est équivalente à : *)
(* fun comparer_fibonacci2 k = 
       comparer_streams nb_fibonacci sturmien1 (fn (x, y) => (x = size y)) k; *)

comparer_fibonacci2 30;

val comparer_pentes = 
    comparer_streams rapport_fibonacci (queue pente1) (fn (x,y) => x=y);

comparer_pentes 25;

(*----------------------------------------------------------------------------*)

(* [Question maison] *)

fun arreter s p =
    let 
        val stream_suivant = queue s
    in
        if (predicat(tete(s), tete(stream_suivant)) = true)
            then stream_suivant
        else
            arreter stream_suivant p
    end;

(* Coupler deux streams. *)

fun coupler s1 s2 = cons (((tete s1), (tete s2)),
			  fn () => 
			  coupler (queue s1) (queue s2));

fun precision f eps = 
    arreter (coupler (pente f) (sturmien f)) (fn ((p1, m1), (p2,m2)) => abs(p1-p2) < eps);

tete (precision (fn n => 1) 0.00005);

(*----------------------------------------------------------------------------*)
(*                                 EXERCICE 2                                 *)
(*----------------------------------------------------------------------------*)

fun largeur suivants x =
    let 
        fun bfs []      = vide
          | bfs (y::ys) = cons (y, fn () => bfs (ys @ (suivants y)))
    in
        bfs [x]
    end;

(* Application à la génération exhaustive des permutations. *)

load "List";
val permutations = 
    let 
        fun suivantes perm = 
        let 
            fun suivantes_aux n mg [] res = 
            (mg @ [n])::res
              | suivantes_aux n mg (md as (x::xs)) res = 
            suivantes_aux n (mg @ [x]) xs ((mg @ (n::md))::res)
        in
            suivantes_aux (1 + (List.length perm)) [] perm []
        end
    in
        largeur suivantes []
    end;

prendre 10 permutations;

(* Application à la génération exhaustive des palindromes sur {a,b,c}. *)
(* Première solution : engendrer tous les mots puis filtrer pour ne    *)
(* conserver que les palindromes.                                      *)

val palindromes =
    let 
        fun  suivants s   = [#"a"::s, #"b"::s, #"c"::s]
        and  palindrome m = (m = List.rev m)
    in
        filtre_app (palindrome) (fn n => implode n) (largeur suivants [])
    end;

prendre 10 palindromes;

(* Deuxième solution :                                             *)
(* on commence par considérer une "forêt" d'arbres de génération,  *)
(* c'est à dire plusieurs arbres, construits avec la même fonction *)
(* suivants, mais à partir de racines différentes (liste x::xs).   *)

fun largeur_foret suivants l =
    let 
        fun largeur_aux []      = vide
          | largeur_aux (y::ys) = cons (y, fn () => largeur_aux (ys @ (suivants y)))
        in
            largeur_aux l 
        end;

(* Fonction suivants : u => a.u.a, b.u.b, c.u.c *)

val palindromes2 = 
    let 
        fun suivants s = [(#"a"::s) @ [#"a"], (#"b"::s) @ [#"b"] , (#"c"::s) @ [#"c"]]
    in
        filtre_app (fn n => true) (fn m => implode m) (largeur_foret suivants [[],[#"a"],[#"b"],[#"c"]])
    end;

prendre 10 palindromes2;