restructured + tests

This commit is contained in:
Francesco Mecca 2019-08-15 10:24:53 +02:00
parent 663fcefb86
commit 936b99c7a6
18 changed files with 503 additions and 361 deletions

67
.merlin Normal file
View file

@ -0,0 +1,67 @@
B /home/user/.opam/system/lib/base
B /home/user/.opam/system/lib/base/caml
B /home/user/.opam/system/lib/base/md5
B /home/user/.opam/system/lib/base/shadow_stdlib
B /home/user/.opam/system/lib/bin_prot
B /home/user/.opam/system/lib/bin_prot/shape
B /home/user/.opam/system/lib/core
B /home/user/.opam/system/lib/core_kernel
B /home/user/.opam/system/lib/core_kernel/base_for_tests
B /home/user/.opam/system/lib/fieldslib
B /home/user/.opam/system/lib/jane-street-headers
B /home/user/.opam/system/lib/parsexp
B /home/user/.opam/system/lib/ppx_assert/runtime-lib
B /home/user/.opam/system/lib/ppx_bench/runtime-lib
B /home/user/.opam/system/lib/ppx_compare/runtime-lib
B /home/user/.opam/system/lib/ppx_expect/collector
B /home/user/.opam/system/lib/ppx_expect/common
B /home/user/.opam/system/lib/ppx_expect/config
B /home/user/.opam/system/lib/ppx_hash/runtime-lib
B /home/user/.opam/system/lib/ppx_inline_test/config
B /home/user/.opam/system/lib/ppx_inline_test/runtime-lib
B /home/user/.opam/system/lib/ppx_sexp_conv/runtime-lib
B /home/user/.opam/system/lib/sexplib
B /home/user/.opam/system/lib/sexplib/unix
B /home/user/.opam/system/lib/sexplib0
B /home/user/.opam/system/lib/spawn
B /home/user/.opam/system/lib/splittable_random
B /home/user/.opam/system/lib/stdio
B /home/user/.opam/system/lib/typerep
B /home/user/.opam/system/lib/variantslib
B /usr/lib64/ocaml
B /usr/lib64/ocaml/threads
B /tmp/default/.main.eobjs
S /home/user/.opam/system/lib/base
S /home/user/.opam/system/lib/base/caml
S /home/user/.opam/system/lib/base/md5
S /home/user/.opam/system/lib/base/shadow_stdlib
S /home/user/.opam/system/lib/bin_prot
S /home/user/.opam/system/lib/bin_prot/shape
S /home/user/.opam/system/lib/core
S /home/user/.opam/system/lib/core_kernel
S /home/user/.opam/system/lib/core_kernel/base_for_tests
S /home/user/.opam/system/lib/fieldslib
S /home/user/.opam/system/lib/jane-street-headers
S /home/user/.opam/system/lib/parsexp
S /home/user/.opam/system/lib/ppx_assert/runtime-lib
S /home/user/.opam/system/lib/ppx_bench/runtime-lib
S /home/user/.opam/system/lib/ppx_compare/runtime-lib
S /home/user/.opam/system/lib/ppx_expect/collector
S /home/user/.opam/system/lib/ppx_expect/common
S /home/user/.opam/system/lib/ppx_expect/config
S /home/user/.opam/system/lib/ppx_hash/runtime-lib
S /home/user/.opam/system/lib/ppx_inline_test/config
S /home/user/.opam/system/lib/ppx_inline_test/runtime-lib
S /home/user/.opam/system/lib/ppx_sexp_conv/runtime-lib
S /home/user/.opam/system/lib/sexplib
S /home/user/.opam/system/lib/sexplib/unix
S /home/user/.opam/system/lib/sexplib0
S /home/user/.opam/system/lib/spawn
S /home/user/.opam/system/lib/splittable_random
S /home/user/.opam/system/lib/stdio
S /home/user/.opam/system/lib/typerep
S /home/user/.opam/system/lib/variantslib
S /usr/lib64/ocaml
S /usr/lib64/ocaml/threads
S .
FLG -w @a-4-29-40-41-42-44-45-48-58-59-60-40 -strict-sequence -strict-formats -short-paths -keep-locs

67
hosaka/.merlin Normal file
View file

@ -0,0 +1,67 @@
B /home/user/.opam/system/lib/base
B /home/user/.opam/system/lib/base/caml
B /home/user/.opam/system/lib/base/md5
B /home/user/.opam/system/lib/base/shadow_stdlib
B /home/user/.opam/system/lib/bin_prot
B /home/user/.opam/system/lib/bin_prot/shape
B /home/user/.opam/system/lib/core
B /home/user/.opam/system/lib/core_kernel
B /home/user/.opam/system/lib/core_kernel/base_for_tests
B /home/user/.opam/system/lib/fieldslib
B /home/user/.opam/system/lib/jane-street-headers
B /home/user/.opam/system/lib/parsexp
B /home/user/.opam/system/lib/ppx_assert/runtime-lib
B /home/user/.opam/system/lib/ppx_bench/runtime-lib
B /home/user/.opam/system/lib/ppx_compare/runtime-lib
B /home/user/.opam/system/lib/ppx_expect/collector
B /home/user/.opam/system/lib/ppx_expect/common
B /home/user/.opam/system/lib/ppx_expect/config
B /home/user/.opam/system/lib/ppx_hash/runtime-lib
B /home/user/.opam/system/lib/ppx_inline_test/config
B /home/user/.opam/system/lib/ppx_inline_test/runtime-lib
B /home/user/.opam/system/lib/ppx_sexp_conv/runtime-lib
B /home/user/.opam/system/lib/sexplib
B /home/user/.opam/system/lib/sexplib/unix
B /home/user/.opam/system/lib/sexplib0
B /home/user/.opam/system/lib/spawn
B /home/user/.opam/system/lib/splittable_random
B /home/user/.opam/system/lib/stdio
B /home/user/.opam/system/lib/typerep
B /home/user/.opam/system/lib/variantslib
B /usr/lib64/ocaml
B /usr/lib64/ocaml/threads
B _build/default/.main.eobjs
S /home/user/.opam/system/lib/base
S /home/user/.opam/system/lib/base/caml
S /home/user/.opam/system/lib/base/md5
S /home/user/.opam/system/lib/base/shadow_stdlib
S /home/user/.opam/system/lib/bin_prot
S /home/user/.opam/system/lib/bin_prot/shape
S /home/user/.opam/system/lib/core
S /home/user/.opam/system/lib/core_kernel
S /home/user/.opam/system/lib/core_kernel/base_for_tests
S /home/user/.opam/system/lib/fieldslib
S /home/user/.opam/system/lib/jane-street-headers
S /home/user/.opam/system/lib/parsexp
S /home/user/.opam/system/lib/ppx_assert/runtime-lib
S /home/user/.opam/system/lib/ppx_bench/runtime-lib
S /home/user/.opam/system/lib/ppx_compare/runtime-lib
S /home/user/.opam/system/lib/ppx_expect/collector
S /home/user/.opam/system/lib/ppx_expect/common
S /home/user/.opam/system/lib/ppx_expect/config
S /home/user/.opam/system/lib/ppx_hash/runtime-lib
S /home/user/.opam/system/lib/ppx_inline_test/config
S /home/user/.opam/system/lib/ppx_inline_test/runtime-lib
S /home/user/.opam/system/lib/ppx_sexp_conv/runtime-lib
S /home/user/.opam/system/lib/sexplib
S /home/user/.opam/system/lib/sexplib/unix
S /home/user/.opam/system/lib/sexplib0
S /home/user/.opam/system/lib/spawn
S /home/user/.opam/system/lib/splittable_random
S /home/user/.opam/system/lib/stdio
S /home/user/.opam/system/lib/typerep
S /home/user/.opam/system/lib/variantslib
S /usr/lib64/ocaml
S /usr/lib64/ocaml/threads
S .
FLG -w @a-4-29-40-41-42-44-45-48-58-59-60-40 -strict-sequence -strict-formats -short-paths -keep-locs

View file

@ -1,7 +1,6 @@
open List;;
open String;;
Random.self_init ();;
(* Random.self_init ();; *)
type card_type =
| Hearts
@ -92,42 +91,3 @@ let is_valid _cards =
match cards with
| a::b::_ when value_cmp a b = 0 -> is_tris cards
| _ -> is_straight cards;;
(* TEST TODO *)
let cards = [{seed=Clovers; value=1}; {seed=Hearts; value=1}; {seed=Pikes; value=1}] in
assert (is_valid cards);;
let cards = [{seed=Tiles; value=1}; {seed=Clovers; value=1}; {seed=Hearts; value=1}; {seed=Pikes; value=1}] in
assert (is_valid cards);;
let cards = [{seed=Tiles; value=2}; {seed=Clovers; value=1}; {seed=Hearts; value=1}; {seed=Pikes; value=1}] in
assert (not (is_valid cards));;
let cards = [{seed=Hearts; value=2}; {seed=Hearts; value=2}; {seed=Hearts; value=4}]
in assert (not (no_double_value cards));;
let cards = [{seed=Hearts; value=2}; {seed=Hearts; value=2}; {seed=Hearts; value=4}]
in assert (not (no_double_seed cards));;
let cards = [{seed=Pikes; value=2}; {seed=Clovers; value=2}; {seed=Tiles; value=4}; {seed=Hearts; value=4}]
in assert (no_double_seed cards);;
let cards = [{seed=Hearts; value=4}; {seed=Hearts; value=3}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (is_valid cards);;
let cards = [{seed=Hearts; value=13}; {seed=Hearts; value=12}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (is_valid cards);;
let cards = [{seed=Pikes; value=13}; {seed=Hearts; value=12}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (not (is_valid cards));;
let cards = [{seed=Pikes; value=13}; {seed=Pikes; value=12}; {seed=Pikes; value=1}]
in assert (is_valid cards);;
let cards = [{seed=Hearts; value=12}; {seed=Pikes; value=12}; {seed=Pikes; value=1}]
in assert (not (is_valid cards));;
let cards = [{seed=Hearts; value=13}; {seed=Hearts; value=3}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (is_valid cards);;

4
hosaka/dune Normal file
View file

@ -0,0 +1,4 @@
(executable
(name main)
(libraries core)
)

1
hosaka/dune-project Normal file
View file

@ -0,0 +1 @@
(lang dune 1.2)

1
hosaka/j.ml Normal file
View file

@ -0,0 +1 @@
open Yojson;;

7
hosaka/main.ml Normal file
View file

@ -0,0 +1,7 @@
(* Mosse: Aggiunta, spostamento *)
(*
Triplette giocabili in mano, doppie usabili, singole usabili
una volta vista la mano, rimuovi le carte inusabili nel turno;
considerata una carta giocabile in mano, considera le carte "prossime", bruteforce;
*)

27
hosaka/printer.ml Normal file
View file

@ -0,0 +1,27 @@
open Cards;;
open Tcards;;
open Table;;
open Core;;
(* let card_to_string c = String.concat ["{ seed: "; card_type_to_string c.seed;
* "; value: "; string_of_int c.value; " }"] *)
let card_to_string c = String.concat ["{"; card_type_to_string c.seed;":"; string_of_int c.value; "}"]
let print_card chan card = Out_channel.output_string chan (card_to_string card);;
let tcards_to_string c = "TCards: <"::
Tcards.card_tag_to_string c.tag::":"::
Tcards.game_strategy_to_string c.strategy::
">["::
(List.map ~f:(fun c -> card_to_string c) c.cards |> String.concat)::
"]"::[] |> String.concat
let print_tcards chan tcards = Out_channel.output_string chan (tcards_to_string tcards);;
let table_to_string c = ""::
(List.map ~f:(fun c -> tcards_to_string c) c.cards |> String.concat ~sep:";\n")::
">"::[] |> String.concat ;;
let print_table chan table = Out_channel.output_string chan (table_to_string table);;
let printer n score table =
Printf.printf "****%d:%d****\n%a\n********\n" n score print_table table;;
let void_printer _ _ _ = ();;

View file

@ -1,5 +1,5 @@
open List;;
open Hashtbl;;
(* open List;;
* open Hashtbl;; *)
open Cards;;
open Tcards;;
@ -15,25 +15,25 @@ let empty =
{ cards = [] }
let valids table =
List.filter (fun ts -> ts.tag == Valid) table.cards;;
List.filter (fun ts -> ts.tag = Valid) table.cards
let invalids table =
List.filter (fun ts -> ts.tag == Invalid) table.cards;;
List.filter (fun ts -> ts.tag = Invalid) table.cards
let score table =
List.length (valids table) - List.length (invalids table)
let hash table =
List.map (fun ts ->Tcards.hash ts) table.cards |>
List.fold_left sum 0;;
List.fold_left sum 0
let size table =
List.map (fun tl -> Tcards.length tl) table.cards |>
List.fold_left sum 0 ;;
List.fold_left sum 0
let flatten table : card list=
List.map (fun (ts:tcards) -> ts.cards) table.cards |>
List.concat |> List.sort Cards.value_cmp ;;
List.concat |> List.sort Cards.value_cmp
let contains tc table =
List.mem tc table.cards
@ -55,9 +55,9 @@ let neighbors (tcs:tcards) table : card list=
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 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
let doesnt_improve n scores =
if List.length scores < n then
@ -84,11 +84,9 @@ let play table in_play to_move : table =
in
assert (table |> contains in_play) ;
_play table.cards in_play to_move [] false false |> make
;;
let is_best_outcome table =
(invalids table |> List.length) == 0
(invalids table |> List.length) = 0
let alg ?maxiter original (dbg: int -> int -> table -> unit) =
let set = Hashtbl.create 1024 in
@ -97,23 +95,26 @@ let alg ?maxiter original (dbg: int -> int -> table -> unit) =
let max_score = ref (score !best) in
let rec _alg table n scores maxiter =
if !should_exit || Hashtbl.mem set (hash table) then
let cur_score = score table in
let uscores = scores[@cur_score] in
let cur_hash = hash table in
if !should_exit || Hashtbl.mem set cur_hash 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 ) ;
Hashtbl.add set cur_hash ();
dbg n cur_score table ;
if constraints original table && cur_score > !max_score then
(max_score := cur_score ; best := table ) ;
if !should_exit || n > maxiter || doesnt_improve (maxiter/2) (scores@[score table]) then
if !should_exit || n > maxiter || doesnt_improve (maxiter/2) uscores then
()
else (
table.cards |>
List.map (fun tcs -> neighbors tcs table |> List.map (fun v -> (tcs,v))) |> (* lista di carta:vicini *)
List.map (fun tcs -> neighbors tcs table |> List.map (fun v -> (tcs,v))) |> (* list of cards:neighbors *)
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)
List.iter (fun new_table -> _alg new_table (n+1) uscores maxiter)
)
)
in

View file

@ -1,6 +1,3 @@
open List;;
open Hashtbl;;
open Cards;;
type card_tag =
@ -62,14 +59,14 @@ let cmp (a:tcards) (b:tcards) =
let hash ts =
ts.cards |>
List.sort (fun a b -> if a.seed == b.seed then Cards.value_cmp a b else Cards.seed_cmp a b) |>
List.sort (fun a b -> if a.seed = b.seed then Cards.value_cmp a b else Cards.seed_cmp a b) |>
Hashtbl.hash;;
let remove card tcards =
assert (List.mem card tcards.cards);
match (List.filter (fun x -> x <> card) tcards.cards) with
| [] -> None
| (hd::tl) as lst -> Some (make lst) ;;
| (_::_) as lst -> Some (make lst) ;;
let r = remove (Cards.make Hearts 7) (make [Cards.make Hearts 7; Cards.make Clovers 7; Cards.make Pikes 7;]) in
match r with

297
hosaka/tests.ml Normal file
View file

@ -0,0 +1,297 @@
open Cards;;
open Table;;
open Tcards;;
open Printer;;
let card_tests () =
let cards = [{seed=Clovers; value=1}; {seed=Hearts; value=1}; {seed=Pikes; value=1}] in
assert (is_valid cards);
let cards = [{seed=Tiles; value=1}; {seed=Clovers; value=1}; {seed=Hearts; value=1}; {seed=Pikes; value=1}] in
assert (is_valid cards);
let cards = [{seed=Tiles; value=2}; {seed=Clovers; value=1}; {seed=Hearts; value=1}; {seed=Pikes; value=1}] in
assert (not (is_valid cards));
let cards = [{seed=Hearts; value=2}; {seed=Hearts; value=2}; {seed=Hearts; value=4}]
in assert (not (no_double_value cards));
let cards = [{seed=Hearts; value=2}; {seed=Hearts; value=2}; {seed=Hearts; value=4}]
in assert (not (no_double_seed cards));
let cards = [{seed=Pikes; value=2}; {seed=Clovers; value=2}; {seed=Tiles; value=4}; {seed=Hearts; value=4}]
in assert (no_double_seed cards);
let cards = [{seed=Hearts; value=4}; {seed=Hearts; value=3}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (is_valid cards);
let cards = [{seed=Hearts; value=13}; {seed=Hearts; value=12}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (is_valid cards);
let cards = [{seed=Pikes; value=13}; {seed=Hearts; value=12}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (not (is_valid cards));
let cards = [{seed=Pikes; value=13}; {seed=Pikes; value=12}; {seed=Pikes; value=1}]
in assert (is_valid cards);
let cards = [{seed=Hearts; value=12}; {seed=Pikes; value=12}; {seed=Pikes; value=1}]
in assert (not (is_valid cards));
let cards = [{seed=Hearts; value=13}; {seed=Hearts; value=3}; {seed=Hearts; value=2}; {seed=Hearts; value=1}]
in assert (is_valid cards);
let () =
assert ([
Cards.make Hearts 6;
Cards.make Hearts 7;
Cards.make Hearts 8;
Cards.make Hearts 9;
Cards.make Hearts 10;]
|> Cards.is_straight) ;
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;
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;
];
Tcards.make [
Cards.make Hearts 8;
]
] in
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
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) ; *)
Printf.printf "Tests done.\n" in
() ;;
card_tests ();;

294
main.ml
View file

@ -1,294 +0,0 @@
open Core;;
open Out_channel;;
open Cards;;
open Tcards;;
open Table;;
(* let card_to_string c = String.concat ["{ seed: "; card_type_to_string c.seed;
* "; value: "; string_of_int c.value; " }"] *)
let card_to_string c = String.concat ["{"; card_type_to_string c.seed;":"; string_of_int c.value; "}"]
let print_card chan card = Out_channel.output_string chan (card_to_string card);;
let tcards_to_string c = "TCards: <"::
Tcards.card_tag_to_string c.tag::":"::
Tcards.game_strategy_to_string c.strategy::
">["::
(List.map ~f:(fun c -> card_to_string c) c.cards |> String.concat)::
"]"::[] |> String.concat
let print_tcards chan tcards = Out_channel.output_string chan (tcards_to_string tcards);;
let table_to_string c = ""::
(List.map ~f:(fun c -> tcards_to_string c) c.cards |> String.concat ~sep:";\n")::
">"::[] |> String.concat ;;
let print_table chan table = Out_channel.output_string chan (table_to_string table);;
let deck = Cards.init
let card, _ = draw deck;;
(* Printf.printf "%a\n" print_card card *)
(* Mosse: Aggiunta, spostamento *)
(*
Triplette giocabili in mano, doppie usabili, singole usabili
una volta vista la mano, rimuovi le carte inusabili nel turno;
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: *)
(*
assert ([
Cards.make Hearts 6;
Cards.make Hearts 7;
Cards.make Hearts 8;
Cards.make Hearts 9;
Cards.make Hearts 10;]
|> Cards.is_straight) ;;
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;
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;
];
Tcards.make [
Cards.make Hearts 8;
]
] in
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
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)

7
makefile Normal file
View file

@ -0,0 +1,7 @@
main:
rm deck/main.exe -f && \
cd hosaka && dune build main.exe && \
ln -s $(shell pwd)/hosaka/_build/default/main.exe ../deck/main.exe
tests:
cd hosaka && corebuild tests.byte && ./tests.byte