finalmente
This commit is contained in:
Francesco Mecca
parent
62e5ceed17
commit
663fcefb86
4 changed files with 311 additions and 85 deletions
8
cards.ml
8
cards.ml
|
|
@ -73,11 +73,15 @@ let is_straight _cards =
|
|||
if (not (no_double_value _cards && is_only_one_seed _cards)) then
|
||||
false
|
||||
else
|
||||
let last = List.rev _cards |> hd in
|
||||
let cards = List.map (fun c -> c.value) _cards (* use only values *) in
|
||||
let ocards = List.sort value_cmp _cards in
|
||||
let last = List.rev ocards |> hd in
|
||||
let cards = List.map (fun c -> c.value) ocards (* use only values *) in
|
||||
if last.value = 13 && (hd cards) = 1 then (* circolare *)
|
||||
let fst, snd = split cards [] in (_is_straight fst) && (_is_straight snd)
|
||||
else
|
||||
(* let res = _is_straight cards in
|
||||
* List.iter (fun c -> Printf.printf "%d:%s - " c.value (card_type_to_string c.seed)) _cards ; Printf.printf "%b\n" res;
|
||||
* res *) (* TODO : remove *)
|
||||
_is_straight cards
|
||||
|
||||
let is_valid _cards =
|
||||
|
|
|
|||
237
main.ml
237
main.ml
|
|
@ -36,18 +36,206 @@ let card, _ = draw deck;;
|
|||
considerata una carta giocabile in mano, considera le carte "prossime", bruteforce;
|
||||
*)
|
||||
|
||||
let printer n score table =
|
||||
Printf.printf "****%d:%d****\n%a\n********\n" n score print_table table;;
|
||||
let void_printer n score table = ();;
|
||||
(* TESTS TODO: *)
|
||||
let printer table =
|
||||
Printf.printf "********\n%a\n********\n" print_table table;;
|
||||
|
||||
(*
|
||||
assert ([
|
||||
Cards.make Hearts 6;
|
||||
Cards.make Hearts 7;
|
||||
Cards.make Hearts 8;
|
||||
Cards.make Hearts 9;
|
||||
Cards.make Hearts 10;]
|
||||
|> Cards.is_straight) ;;
|
||||
|
||||
(* let rec alg table original_table n (scores:int list) best max_score (dbg: table -> unit) = *)
|
||||
open Hashtbl;;
|
||||
let table = Table.make [
|
||||
assert ([
|
||||
Cards.make Hearts 1;
|
||||
Cards.make Hearts 12;
|
||||
Cards.make Hearts 2;
|
||||
Cards.make Hearts 13;]
|
||||
|> Cards.is_straight) ;;
|
||||
|
||||
let ttable = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 7;
|
||||
Cards.make Clovers 8;
|
||||
Cards.make Clovers 9;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 7;
|
||||
Cards.make Pikes 8;
|
||||
Cards.make Pikes 9;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 7;
|
||||
Cards.make Hearts 8;
|
||||
Cards.make Hearts 9;
|
||||
Cards.make Hearts 10;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 6;
|
||||
]
|
||||
]
|
||||
in
|
||||
let neighs = neighbors
|
||||
(Tcards.make [
|
||||
Cards.make Hearts 7;
|
||||
Cards.make Hearts 8;
|
||||
Cards.make Hearts 9;
|
||||
Cards.make Hearts 10;
|
||||
]) ttable in
|
||||
assert (neighs = [Cards.make Hearts 6]) ;;
|
||||
|
||||
let ttable = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Hearts 1;
|
||||
Cards.make Hearts 2;
|
||||
Cards.make Hearts 13;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 1;
|
||||
Cards.make Pikes 2;
|
||||
Cards.make Pikes 3;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 2;
|
||||
Cards.make Clovers 3;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 1;
|
||||
Cards.make Tiles 1;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 12;
|
||||
Cards.make Tiles 12;
|
||||
];
|
||||
]
|
||||
in
|
||||
let neighs = neighbors
|
||||
(Tcards.make [
|
||||
Cards.make Hearts 1;
|
||||
Cards.make Hearts 2;
|
||||
Cards.make Hearts 13;
|
||||
]) ttable in
|
||||
assert (neighs = [Cards.make Hearts 12]) ;;
|
||||
*)
|
||||
|
||||
let table1 = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 2;
|
||||
Cards.make Pikes 2;
|
||||
Cards.make Hearts 2;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 1;
|
||||
Cards.make Tiles 1;
|
||||
Cards.make Pikes 1;
|
||||
Cards.make Hearts 1;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Tiles 13;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Tiles 12;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 13;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 12;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 3;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 3;
|
||||
]
|
||||
] in
|
||||
let table1x = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 2;
|
||||
Cards.make Pikes 2;
|
||||
Cards.make Hearts 2;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 1;
|
||||
Cards.make Tiles 1;
|
||||
Cards.make Pikes 1;
|
||||
Cards.make Hearts 1;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Tiles 13;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Tiles 12;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 13;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 12;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 12;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 3;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 3;
|
||||
]
|
||||
] in
|
||||
let table2 = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 2;
|
||||
Cards.make Tiles 2;
|
||||
Cards.make Pikes 2;
|
||||
Cards.make Hearts 2;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 1;
|
||||
Cards.make Tiles 1;
|
||||
Cards.make Pikes 1;
|
||||
Cards.make Hearts 1;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 3;
|
||||
]
|
||||
] in
|
||||
let table3 = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 7;
|
||||
Cards.make Clovers 8;
|
||||
Cards.make Clovers 9;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 7;
|
||||
Cards.make Hearts 8;
|
||||
Cards.make Hearts 9;
|
||||
Cards.make Hearts 10;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 7;
|
||||
Cards.make Pikes 8;
|
||||
Cards.make Pikes 9;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Tiles 7;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 11;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Hearts 12;
|
||||
];
|
||||
] in
|
||||
let table4 = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 7;
|
||||
Cards.make Clovers 8;
|
||||
Cards.make Clovers 9;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Pikes 7;
|
||||
|
|
@ -67,7 +255,40 @@ let table = Table.make [
|
|||
Cards.make Hearts 8;
|
||||
]
|
||||
] in
|
||||
let new_tables = Table.alg table 0 [] in
|
||||
(* List.iter ~f:(fun (t,_,_) -> printer t) new_table *)
|
||||
let table5 = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 7;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 6;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 8;
|
||||
];
|
||||
] in
|
||||
let table5x = Table.make [
|
||||
Tcards.make [
|
||||
Cards.make Clovers 7;
|
||||
Cards.make Clovers 8;
|
||||
Cards.make Clovers 9;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 10;
|
||||
];
|
||||
Tcards.make [
|
||||
Cards.make Clovers 10;
|
||||
];
|
||||
] in
|
||||
|
||||
Table.prova table [] [] (-1000) printer new_tables []
|
||||
assert (alg table1 void_printer |> snd = 4);
|
||||
assert (alg table2 void_printer |> snd = 3);
|
||||
assert (alg table3 void_printer |> snd = 4);
|
||||
assert (alg table4 void_printer |> snd = 4);
|
||||
assert (alg table5 void_printer |> snd = 1);
|
||||
assert (alg table5x void_printer |> snd = 0);
|
||||
assert (alg table1x void_printer |> snd = 2);
|
||||
assert (alg ~maxiter:21 table1x void_printer |> snd = 3);
|
||||
assert (alg ~maxiter:14 table1x void_printer |> snd = 2);
|
||||
let table = table1x in
|
||||
let res = alg ~maxiter:14 table printer in
|
||||
Printf.printf "Best result: %d\n%a\n" (res |> snd) print_table (res |> fst)
|
||||
|
|
|
|||
115
table.ml
115
table.ml
|
|
@ -1,4 +1,5 @@
|
|||
open List;;
|
||||
open Hashtbl;;
|
||||
|
||||
open Cards;;
|
||||
open Tcards;;
|
||||
|
|
@ -8,7 +9,7 @@ let sum a b = a + b (* TODO: investigate why list.fold doesn't accept + *)
|
|||
type table = { cards: tcards list}
|
||||
|
||||
let make tcards =
|
||||
{ cards=tcards }
|
||||
{ cards=(List.sort Tcards.cmp tcards) }
|
||||
|
||||
let empty =
|
||||
{ cards = [] }
|
||||
|
|
@ -32,95 +33,89 @@ let size table =
|
|||
|
||||
let flatten table : card list=
|
||||
List.map (fun (ts:tcards) -> ts.cards) table.cards |>
|
||||
List.concat ;;
|
||||
List.concat |> List.sort Cards.value_cmp ;;
|
||||
|
||||
let contains tc table =
|
||||
List.mem tc table.cards
|
||||
|
||||
let neighbors tcs table : card list=
|
||||
let neighbors (tcs:tcards) table : card list=
|
||||
let all = flatten table in
|
||||
match tcs.strategy with
|
||||
let res =
|
||||
(match tcs.strategy with
|
||||
| Tris -> List.filter (fun x -> tcs.cards@[x] |> Cards.is_tris) all
|
||||
| Straight -> List.filter (fun x -> tcs.cards@[x] |> Cards.is_straight) all
|
||||
| Single -> all |>
|
||||
List.filter (fun x -> let cs = tcs.cards@[x] in
|
||||
Cards.is_straight cs || Cards.is_tris cs)
|
||||
|
||||
)|> List.sort_uniq (fun a b -> if a = b then 0 else 1)
|
||||
in (
|
||||
(* List.iter (fun c -> Printf.printf "%d:%s - " c.value (card_type_to_string c.seed)) tcs.cards; *)
|
||||
(* Printf.printf "\n"; *)
|
||||
(* List.iter (fun c -> Printf.printf "%d:%s - " c.value (card_type_to_string c.seed)) res ; Printf.printf "\n" ; *)
|
||||
res )
|
||||
|
||||
let constraints start eend =
|
||||
let hand = List.filter (fun ts -> ts.strategy == Single) start.cards in
|
||||
let res = List.filter (fun (e:tcards) -> e.strategy == Single && not (List.mem e hand)) eend.cards in
|
||||
(List.length res) == 0;; (* investigate why not = nstead of == (TODO) *)
|
||||
|
||||
let doesnt_improve scores =
|
||||
if List.length scores < 7 then
|
||||
let doesnt_improve n scores =
|
||||
if List.length scores < n then
|
||||
false
|
||||
else
|
||||
let max = List.fold_left max (-1000) scores in
|
||||
let min = List.fold_left min 1000 scores in
|
||||
abs (max - min) < 2
|
||||
abs (max - min) < (n/7)
|
||||
|
||||
let play table in_play to_move =
|
||||
let rec _play table_cards in_play to_move accum =
|
||||
let play table in_play to_move : table =
|
||||
let rec _play table_cards in_play to_move accum played_already moved_already =
|
||||
match table_cards with
|
||||
(* put new combination on the table *)
|
||||
| hd::tl when hd = in_play -> _play tl in_play to_move ((Tcards.make (to_move::in_play.cards))::accum)
|
||||
| [] -> accum (* generate a new table *)
|
||||
| hd::tl -> if hd |> Tcards.contains to_move then
|
||||
| [] -> accum (* return a new table *)
|
||||
| hd::tl -> (* put new combination on the table *)
|
||||
if not played_already && eq hd in_play then
|
||||
_play tl in_play to_move ((Tcards.make (to_move::in_play.cards))::accum) true moved_already
|
||||
else if not moved_already && hd |> Tcards.contains to_move then
|
||||
match (Tcards.remove to_move hd) with
|
||||
| None -> _play tl in_play to_move accum
|
||||
| Some x -> _play tl in_play to_move (x::accum)
|
||||
| None -> _play tl in_play to_move accum played_already true
|
||||
| Some x -> _play tl in_play to_move (x::accum) played_already true
|
||||
else
|
||||
_play tl in_play to_move (hd::accum)
|
||||
_play tl in_play to_move (hd::accum) played_already moved_already
|
||||
|
||||
in
|
||||
assert (table |> contains in_play) ;
|
||||
_play table.cards in_play to_move [] |> make
|
||||
_play table.cards in_play to_move [] false false |> make
|
||||
;;
|
||||
|
||||
let update best max_score original newt score =
|
||||
if score > max_score && (constraints original newt) then
|
||||
score, newt
|
||||
else
|
||||
max_score, best
|
||||
|
||||
let is_best_outcome table =
|
||||
(invalids table |> List.length) == 0
|
||||
|
||||
(* let rec alg table original_table n (scores:int list) best max_score (dbg: table -> unit) =
|
||||
* dbg table ;
|
||||
* let ascore = score table in
|
||||
* (\* if Hashset.has (hash table) then () *\)
|
||||
* (\* else ( *\)
|
||||
* (\* Hashset.add (hash table) ; *\)
|
||||
* let mmax, bbest = update best max_score original_table table ascore in
|
||||
* if is_best_outcome table || n > 14 || doesnt_improve (scores@[ascore]) then
|
||||
* ()
|
||||
* else
|
||||
* table.cards |>
|
||||
* List.map (fun tcs -> neighbors tcs table |> List.map (fun v -> (tcs,v))) |> (\* lista di carta:vicini *\)
|
||||
* List.concat |> (\* flatten *\)
|
||||
* List.map (fun (card, neigh) -> play table card neigh) |> (\* list of new_tables *\)
|
||||
* List.iter (fun new_table -> alg new_table original_table (n+1) (scores@[ascore]) bbest mmax dbg)
|
||||
* (\* ) *\) *)
|
||||
|
||||
let alg table n (scores:int list) : (table * int * int list) list =
|
||||
table.cards |>
|
||||
List.map (fun tcs -> neighbors tcs table |> List.map (fun v -> (tcs,v))) |> (* lista di carta:vicini *)
|
||||
List.concat |> (* flatten *)
|
||||
List.map (fun (card, neigh) -> (play table card neigh), (n+1), (scores@[score table]) )
|
||||
let alg ?maxiter original (dbg: int -> int -> table -> unit) =
|
||||
let set = Hashtbl.create 1024 in
|
||||
let should_exit = ref false in
|
||||
let best = ref original in
|
||||
let max_score = ref (score !best) in
|
||||
|
||||
let condizioni table n scores set =
|
||||
if List.mem (hash table) set || doesnt_improve scores ||
|
||||
is_best_outcome table || n > 14 then
|
||||
true
|
||||
else false
|
||||
|
||||
let rec prova original_table set best max_score (dbg: table -> unit) (accum: (table*int*int list) list)
|
||||
(sols: (table*int*int list) list) =
|
||||
match accum with
|
||||
| [] -> sols
|
||||
| (table, n, scores)::tl -> dbg table ;
|
||||
if condizioni table n scores set then
|
||||
prova original_table ((hash table)::set) best max_score dbg tl ([table, n, scores]@sols)
|
||||
else
|
||||
prova original_table ((hash table)::set) best max_score dbg ((alg table n scores)@tl) sols
|
||||
let rec _alg table n scores maxiter =
|
||||
if !should_exit || Hashtbl.mem set (hash table) then
|
||||
()
|
||||
else (
|
||||
should_exit := is_best_outcome table;
|
||||
Hashtbl.add set (hash table) ();
|
||||
dbg n (score table) table ;
|
||||
if constraints original table && (score table) > !max_score then
|
||||
(max_score := (score table) ; best := table ) ;
|
||||
|
||||
if !should_exit || n > maxiter || doesnt_improve (maxiter/2) (scores@[score table]) then
|
||||
()
|
||||
else (
|
||||
table.cards |>
|
||||
List.map (fun tcs -> neighbors tcs table |> List.map (fun v -> (tcs,v))) |> (* lista di carta:vicini *)
|
||||
List.concat |> (* flatten *)
|
||||
List.map (fun (card, neigh) -> (play table card neigh)) |>
|
||||
List.iter (fun new_table -> _alg new_table (n+1) (scores@[score table]) maxiter)
|
||||
)
|
||||
)
|
||||
in
|
||||
let maxiter = match maxiter with None -> 14 | Some x -> x in
|
||||
_alg original 0 [] maxiter ; !best, !max_score
|
||||
|
|
|
|||
36
tcards.ml
36
tcards.ml
|
|
@ -28,31 +28,37 @@ type tcards = { cards: card list ; tag: card_tag ; strategy: game_strategy }
|
|||
let make cards =
|
||||
let strategy = if List.length cards = 1 then Single else
|
||||
if Cards.is_tris cards then Tris else Straight in
|
||||
{ cards=cards ; tag=if Cards.is_valid cards then Valid else Invalid; strategy=strategy }
|
||||
{ cards=cards |> List.sort value_cmp ; tag=if Cards.is_valid cards then Valid else Invalid; strategy=strategy }
|
||||
|
||||
let contains needle haystack = List.mem needle haystack.cards
|
||||
|
||||
let (=) a b =
|
||||
let eq a b =
|
||||
if List.length a.cards <> List.length b.cards || a.tag != b.tag || a.strategy != b.strategy then
|
||||
false
|
||||
else
|
||||
a.cards = b.cards
|
||||
|
||||
let length ts = List.length ts.cards
|
||||
let cmp a b =
|
||||
(* TODO: improve *)
|
||||
if a.strategy == Tris && List.length a.cards == 4 then -1
|
||||
else if b.strategy == Tris && List.length b.cards == 4 then 1
|
||||
else if a.strategy != Single && b.strategy == Single then 1
|
||||
else if a.strategy == Single && b.strategy != Single then -1
|
||||
else if a.tag == Invalid && b.tag == Valid then 1
|
||||
else -1 ;;
|
||||
|
||||
(* TODO tests *)
|
||||
assert (make [Cards.make Pikes 2] |>
|
||||
cmp (make [Cards.make Pikes 2 ; Cards.make Clovers 2]) == 1);; (* less than *)
|
||||
assert (make [Cards.make Pikes 2] |>
|
||||
cmp (make [Cards.make Pikes 2 ; Cards.make Clovers 2 ; Cards.make Tiles 2; Cards.make Hearts 2]) == -1)
|
||||
let cmp (a:tcards) (b:tcards) =
|
||||
let tup = (a.strategy, length a, b.strategy, length b, a.tag, b.tag) in
|
||||
match tup with
|
||||
| Straight, al, Straight, bl, _, _ -> if al < bl then 1 else -1
|
||||
| Tris, 4, _, _, _, _ -> -1
|
||||
| _, _, Tris, 4, _, _ -> 1
|
||||
| Tris, 3, _, _, _, _ -> -1
|
||||
| _, _, Tris, 3, _, _ -> 1
|
||||
| Straight, 3, _, _, _, _ -> -1
|
||||
| _, _, Straight, 3, _, _ -> 1
|
||||
| Straight, al, _, _, _, _ when al > 3 -> -1
|
||||
| _, _, Straight, bl, _, _ when bl > 3 -> 1
|
||||
| Single, _, Single, _, _, _ -> -1 (* avoid ordering by card value here *)
|
||||
| (Straight|Tris), _, Single, _, _, _ -> 1
|
||||
| Single, _, (Straight|Tris), _, _, _ -> -1
|
||||
| _, _, _, _, Invalid, Valid -> 1
|
||||
| _, _, _, _, Valid, Invalid -> -1
|
||||
| _ -> -1 (* doesn't matter if -1 or 1, just don't discriminate otherwise can't try all possible combinations *);;
|
||||
|
||||
|
||||
let hash ts =
|
||||
ts.cards |>
|
||||
|
|
|
|||
Loading…
Reference in a new issue