(** Le Compte est bon **)


type code = Entier of int | Plus | Moins | Mult | Div ;;
type nombre = { valeur: int ; code: code list };;

let donnée n  = { valeur=n; code=[Entier n] };;
let plus {valeur=x;code=l1} {valeur=y;code=l2} = { valeur=x+y; code=l1@l2@[Plus] };;
let moins {valeur=x;code=l1} {valeur=y;code=l2} = { valeur=x-y; code=l1@l2@[Moins] };;
let mult {valeur=x;code=l1} {valeur=y;code=l2} = { valeur=x*y; code=l1@l2@[Mult] };;
let divi {valeur=x;code=l1} {valeur=y;code=l2} = { valeur=x/y; code=l1@l2@[Div] };;

let rec filtrer predicat = function
	|[]	-> []
	|t::q -> if (predicat t) then t::(filtrer predicat q) else filtrer predicat q
;;

let rec allpaires liste = 
	let rec associe x = function
		|[] -> []
		|t::q -> (x,t)::(associe x q)
in	match liste with
		|[]	-> []
		|t::q -> (associe t q)@(allpaires q)
;;

let rec enlever x = function
	|[]	-> []
	|t::q -> if t=x then q else t::(enlever x q)
;;

let fistons_xy nombres (x,y) = let l=enlever x (enlever y nombres) in
		(if (x.valeur<>0 & y.valeur<>0) then [(plus x y)::l] else [])
	@	(if (x.valeur<>1 & x.valeur<>(-1) & y.valeur<>1 & y.valeur<>(-1)) then [(mult x y)::l] else [])
	@	(if y.valeur<>0 then [(moins x y)::l] else [])
	@	(if x.valeur<>0 then [(moins y x)::l] else [])
	@	(if (y.valeur<>0 & y.valeur<>1 & y.valeur<>(-1) & x.valeur<>0 & x.valeur mod y.valeur=0) then [(divi x y)::l] else [])
	@	(if (x.valeur<>0 & x.valeur<>1 & x.valeur<>(-1) & y.valeur<>0 & y.valeur mod x.valeur=0) then [(divi y x)::l] else [])
;;

let rec flat_map f = function
	|[] -> []
	|t::q -> (f t) @ (flat_map f q)
;;

let fistons nombres = flat_map (fistons_xy nombres) (allpaires nombres);;

let present_solutions nombres goal = filtrer (function nbre -> nbre.valeur=goal) nombres;;

let rec explorer1 b etat =
	match (present_solutions etat b) with
		|[] -> explorern b (fistons etat)
		|sol -> sol
and explorern b etats= match etats with
	|[] -> []
	|t::q -> match (explorer1 b t) with
					|[] -> explorern b q
					|sol -> sol
;;
let find_first=explorer1;;

(* Exemple : donne la première solution trouvée
find_first 265 [donnée 25; donnée 10; donnée 4; donnée 3; donnée 1];;
*)

let rec trouver b etat =
	match (present_solutions etat b) with
		|[] -> trouverliste b (fistons etat)
		|sol -> sol
and trouverliste b etats= match etats with
	|[] -> []
	|t::q -> (trouver b t)@(trouverliste b q)
;;

(* Exemple : trouve toutes les solutions, parcours en profondeur
trouver 265 [donnée 25; donnée 10; donnée 4; donnée 3; donnée 1];;
*)

let rec largeur_aux goal states =
	if states=[]
	then []
	else match (flat_map (function state -> present_solutions state goal) states) with
		     |[] -> largeur_aux goal (flat_map fistons states)
		     |solutions -> solutions
;;
let largeur goal state = largeur_aux goal [state];;

(* Exemple : parcours en largeur, on rend ttes les solutions au 1er niveau où il y a des solutions
largeur 265 [donnée 25; donnée 10; donnée 4; donnée 3; donnée 1];;
*)

(* rend le meilleur de 2 nombres *)
let best2 goal a b =
	if abs(a.valeur-goal) < abs(b.valeur-goal)
	then a else b;;
(* rend le meilleur dans une liste de nombres *)
open List;;
let bestn goal nombres = fold_left (best2 goal) (hd nombres) nombres;;

let rec resoudre1 goal state best_known =
	match (present_solutions state goal) with
		|[] -> resoudren goal (fistons state) (bestn goal (best_known::state))
		|sol1::_ -> sol1
and resoudren goal states best_known =
	match states with
		|[] -> best_known
		|state1::others -> let sol1=resoudre1 goal state1 best_known in
			if sol1.valeur=goal
			then sol1
			else resoudren goal others (best2 goal sol1 best_known);;
let resoudre goal nombres = resoudre1 goal nombres (hd nombres);;

(* Exemple : rend la premiére solution trouvée, sinon rend la plus proche
resoudre 265 [donnée 25; donnée 10; donnée 4; donnée 3; donnée 1];;
resoudre 264 [donnée 25; donnée 10; donnée 3; donnée 1];;
*)