bparodi/Octopus_Carnival
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

restructured + tests

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

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

42
cards.ml → hosaka/cards.ml
View file

@ -1,7 +1,6 @@
open List;; open List;;
open String;;
Random.self_init ();; (* Random.self_init ();; *)
type card_type = type card_type =
| Hearts | Hearts
@ -92,42 +91,3 @@ let is_valid _cards =
match cards with match cards with
| a::b::_ when value_cmp a b = 0 -> is_tris cards | a::b::_ when value_cmp a b = 0 -> is_tris cards
| _ -> is_straight 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)

0
hashset.ml → hosaka/hashset.ml
View file

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 _ _ _ = ();;

43
table.ml → hosaka/table.ml
View file

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

7
tcards.ml → hosaka/tcards.ml
View file

@ -1,6 +1,3 @@
open List;;
open Hashtbl;;
open Cards;; open Cards;;
type card_tag = type card_tag =
@ -62,14 +59,14 @@ let cmp (a:tcards) (b:tcards) =
let hash ts = let hash ts =
ts.cards |> 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;; Hashtbl.hash;;
let remove card tcards = let remove card tcards =
assert (List.mem card tcards.cards); assert (List.mem card tcards.cards);
match (List.filter (fun x -> x <> card) tcards.cards) with match (List.filter (fun x -> x <> card) tcards.cards) with
| [] -> None | [] -> 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 let r = remove (Cards.make Hearts 7) (make [Cards.make Hearts 7; Cards.make Clovers 7; Cards.make Pikes 7;]) in
match r with 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

0
alg.py → metro_holografix/scrapes/alg.py
View file

0
cardtypes.py → metro_holografix/scrapes/cardtypes.py
View file

0
test.py → metro_holografix/scrapes/test.py
View file

0
vecchio.py → metro_holografix/scrapes/vecchio.py
View file