module type ITER = sig
type t
type collection
type elt
val init : collection -> t
val next : t -> (elt*t) option
val eval : elt -> int
val pp : Format.formatter -> elt -> unit
val test : collection
end
let rec pp_list pp ch = function
| [] -> ()
| [a] -> pp ch a
| a::b::more -> Format.printf "%a, %a" pp a (pp_list pp) (b::more)
module Elements : ITER with type collection = int list and type elt = int = struct
type t = int list
type collection = int list
type elt = int
let init l = l
let next = function
| [] -> None
| x::l -> Some (x,l)
let eval i = i
let pp ch i = Format.fprintf ch "%d" i
let test = [41;9;12;13;42;8;55;25;3]
end
module Find (E:ITER) = struct
open E
let rec iter t f =
let rec aux it cur target =
if target = 0 then
f cur
else
match next it with
| None -> ()
| Some (t,it) ->
let e = eval t in
aux it cur target ;
if e > 0 && e <= target then
aux it (t::cur) (target-e)
in
aux (E.init t) [] 100
let () =
let count = ref 0 in
Format.printf "Solutions à somme 100:\n" ;
iter test
(fun t ->
incr count ;
Format.printf " %03d: %a\n" !count (pp_list pp) t)
end
module F1 = Find(Elements)
type op = char * (int -> int -> int)
let plus = '+',(+)
let times = '*',( * )
let minus = '-',(-)
type expr =
| I of int
| Op of op * expr * expr
let t0 =
Op (plus,
Op (minus,
Op (plus, Op (times, I 2, I 12), I 7),
I 42),
Op (plus, I 11, I 5))
let rec eval = function
| I i -> i
| Op (o,a,b) -> (snd o) (eval a) (eval b)
let rec pp_expr ch = function
| I i -> Format.fprintf ch "%d" i
| Op (o,a,b) -> Format.fprintf ch "(%a%c%a)" pp_expr a (fst o) pp_expr b
let () = Format.printf "Exemple:\n %a\n" (pp_list pp_expr) [t0]
let () = assert (eval t0 = 5)
let t1 =
Op (plus, I 41,
Op (plus, I 9,
Op (plus, I 12,
Op (plus, I 8,
Op (plus, I 25, I 55)))))
let t2 =
Op (times, I 41,
Op (times, I 9,
Op (plus, I 12,
Op (times, I 8,
Op (times, I 25, I 55)))))
let t3 =
Op (times, I 16,
Op (minus, I 64,
Op (plus, I 42, I 12)))
let t4 = Op (plus, I 25, t1)
let t = t1
module Trois = struct
let rec subtree t f =
match t with
| I i -> f (I i)
| Op (o,a,b) ->
f t ;
subtree a f ;
subtree b f
let count iter =
let n = ref 0 in
iter (fun _ -> incr n) ;
!n
let until_nth iter f n =
let n = ref n in
try
iter (fun i -> decr n ; f i ; if !n = 0 then raise Exit)
with Exit -> ()
let () = Format.printf "Nombre de sous-expr: %d\n" (count (subtree t))
let () = until_nth (subtree t) (Format.printf " %a\n" pp_expr) 7
end
module Subtrees : ITER with type collection = expr = struct
type t = expr list
type elt = expr
type collection = expr
let init expr = [expr]
let next = function
| I i :: more -> Some (I i, more)
| Op (o,a,b) as t :: more -> Some (t, a::b::more)
| [] -> None
let eval = eval
let pp = pp_expr
let test = t
end
module F2 = Find(Subtrees)