finalmente

This commit is contained in:
Francesco Mecca 2019-08-14 15:03:00 +02:00
parent 62e5ceed17
commit 663fcefb86
4 changed files with 311 additions and 85 deletions

View file

@ -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
View file

@ -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
View file

@ -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

View file

@ -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 |>