Suite Au Poker Valet Dame Roi As 2

|As
| Dame
| V ofint
type color =
| Pique
| Carreau
type carte = type_carte * color;;
type hand =
| Straight_flush of carte
| Full of carte * carte
| Staight of carte
| Two_pair of carte * carte * carte list
| Hight_card of carte list
let id a = a;;
(* Pour une liste l de k élements, take_drop n l renvoit (a, b) ou a est une liste constituée des n premiers élements de l, et b une liste consitituée des k - n derniers élements de l. *)
letrec take' acc n =function
| e::l ->
else take'(e::acc)(n-1) l
;;
module Eval =
let eval_type =function
| Roi ->13
| Valet ->11
let eval_carte (t,_)= eval_type t
let sort_main main =
let l =List.map (fun c ->(c, eval_carte c)) main in
List.map fst $ List.sort (fun(_,a)(_,b)->compare b a) l
(* Compare les élements d'une liste entre eux *)
letrec same' v =function
| c::l ->
else same' v l
let l =List.map f l in
(* Vérifie que les élements d'une liste sont bien consécutifs*)
letrec consecutive' c =function
| a::l ->
else
in
consecutive'(List.hd nl)(List.tl nl)
(* Fonction annexe : a partir d'une liste triée, cherche un sous ensemble l de n élements de cette liste pour lesquel f l est vérifiée. *)
let find_partition f n l =
|[]->([], List.rev ll)
let l,l'= take_drop n (e::list)in
if f l then(l, (List.rev $ ll)@l')
else
in find_partition'[] f n l
let full l =match find_partition (same fst)3 l with
|(l, l')->
|([], _)->([], [], [])
(l, pair, l')
let two_pair l =match find_partition (same fst)2 l with
|(p1, l)->
|([], _)->([], [], [])
(p1, p2, l')
(* Repère les mains dans une liste de 7 cartes, c'est à dire transforme une liste de 7 cartes en une main de poker *)
let main = sort_main m in
(* Quinte flush royale *)
|[(As,c0);(Roi,c1);(Dame,c2);(Valet,c3);(V 10, c4); _; _]when same id [c0;c1;c2;c3;c4]->
(* Quinte Flush *)
|[a;b;c;d;e;f;_]when consecutive [a;b;c;d;e]&& same snd[a;b;c;d;e]->
| l whenList.length l =7->
beginmatch find_partition (same fst)4 main with
Four_of_a_king(a, l')
(* Full *)
|(a::l, b::l', _)->
|(_, _, _)->
beginmatch find_partition (same snd)5 main with
Flush a
(* Straight*)
|(a::l, _)->
| _ ->
beginmatch find_partition (same fst)3 main with
Brelan(a, l)
(* Two pairs *)
|(a::_, b::_, l)->
| _ ->
beginmatch find_partition (same fst)2 main with
Pair(a, l)
(* Higth card *)
end
end
end
end
let compare_hand a b =
| Royal_flush ->9

Suite Poker Valet Dame Roi As 2