mbarbin / super-master-mind / 177

Committed 16 Dec 2025 02:27PM UTC coverage: 92.007% (-4.3%) from 96.355%

Build # 177

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #33 from mbarbin/json-opening

Use json format for opening-book

Run Details

420 of 491 new or added lines in 28 files covered. (85.54%)

2 existing lines in 1 file now uncovered.

1013 of 1101 relevant lines covered (92.01%)

3368615.51 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

93.48

/src/solver.ml

(*********************************************************************************)
(*  super-master-mind: A solver for the super master mind game                   *)
(*  SPDX-FileCopyrightText: 2021-2025 Mathieu Barbin <mathieu.barbin@gmail.com>  *)
(*  SPDX-License-Identifier: MIT                                                 *)
(*********************************************************************************)

let input_line () =
  match Stdlib.In_channel.input_line In_channel.stdin with
  | Some line -> line
  | None -> raise End_of_file
;;

let rec input_cue () =
  let rec input_int ~prompt =
    Stdlib.print_string prompt;
    Out_channel.(flush stdout);
    let int = input_line () in
    match Int.of_string int with
    | exception e ->
      Stdlib.print_endline (Stdlib.Printexc.to_string e);
      input_int ~prompt
    | i -> i
  in
  let black = input_int ~prompt:"#black (correctly placed)  : " in
  let white =
    let prompt = "#white (incorrectly placed): " in
    if black >= 4
    then (
      Stdlib.print_endline (prompt ^ "0");
      0)
    else input_int ~prompt
  in
  match Cue.create_exn { white; black } with
  | exception e ->
    Stdlib.print_endline (Stdlib.Printexc.to_string e);
    input_cue ()
  | cue -> cue
;;

let solve ~color_permutation ~task_pool =
  Stdlib.print_string "Press enter when done choosing a solution: ";
  Out_channel.(flush stdout);
  let (_ : string) = input_line () in
  let step_index = ref 0 in
  let print (t : Guess.t) =
    Int.incr step_index;
    print_dyn (Dyn.Tuple [ !step_index |> Dyn.int; t.candidate |> Code.to_dyn ]);
    Out_channel.(flush stdout)
  in
  let rec aux (t : Guess.t) ~possible_solutions =
    print t;
    let cue = input_cue () in
    let by_cue =
      Nonempty_list.find t.by_cue ~f:(fun by_cue -> Cue.equal cue by_cue.cue)
      |> Option.get
    in
    let possible_solutions =
      Codes.filter possible_solutions ~candidate:t.candidate ~cue
    in
    if Codes.size possible_solutions = 1
    then (
      let solution = List.hd (Codes.to_list possible_solutions) in
      let guess = Guess.compute ~possible_solutions ~candidate:solution in
      print guess)
    else (
      let guess =
        match by_cue.next_best_guesses with
        | Computed [] -> assert false
        | Computed (guess :: _) -> guess
        | Not_computed ->
          (match Guess.compute_k_best ~task_pool ~possible_solutions ~k:1 () with
           | [] -> assert false
           | guess :: _ -> guess)
      in
      aux guess ~possible_solutions)
  in
  let opening_book = Lazy.force Opening_book.opening_book in
  let root = Opening_book.root opening_book ~color_permutation in
  aux root ~possible_solutions:Codes.all
;;

let cmd =
  Command.make
    ~summary:"Solve interactively."
    (let open Command.Std in
     let+ color_permutation =
       Arg.named_opt
         [ "color-permutation" ]
         Param.int
         ~docv:"N"
         ~doc:"Force use of permutation (random by default)."
     and+ task_pool_config = Task_pool.Config.arg in
     let color_permutation =
       let index =
         match color_permutation with
         | Some index -> index
         | None -> Random.int (Lazy.force Color_permutation.cardinality) [@coverage off]
       in
       Color_permutation.of_index_exn index
     in
     Task_pool.with_t task_pool_config ~f:(fun ~task_pool ->
       solve ~color_permutation ~task_pool))
;;

1	(*********************************************************************************)
2	(* super-master-mind: A solver for the super master mind game *)
3	(* SPDX-FileCopyrightText: 2021-2025 Mathieu Barbin <mathieu.barbin@gmail.com> *)
4	(* SPDX-License-Identifier: MIT *)
5	(*********************************************************************************)
6
7	let input_line () =
8	match Stdlib.In_channel.input_line In_channel.stdin with	14✔
9	\| Some line -> line	14✔
NEW 10	\| None -> raise End_of_file	×
11	;;
12
13	let rec input_cue () =
14	let rec input_int ~prompt =	6✔
15	Stdlib.print_string prompt;	13✔
16	Out_channel.(flush stdout);	13✔
17	let int = input_line () in
18	match Int.of_string int with	13✔
19	\| exception e ->	1✔
20	Stdlib.print_endline (Stdlib.Printexc.to_string e);	1✔
21	input_int ~prompt	1✔
22	\| i -> i	12✔
23	in
24	let black = input_int ~prompt:"#black (correctly placed) : " in
25	let white =
26	let prompt = "#white (incorrectly placed): " in
27	if black >= 4
28	then (	×
29	Stdlib.print_endline (prompt ^ "0");
30	0)	×
31	else input_int ~prompt	6✔
32	in
33	match Cue.create_exn { white; black } with
34	\| exception e ->	1✔
35	Stdlib.print_endline (Stdlib.Printexc.to_string e);	1✔
36	input_cue ()	1✔
37	\| cue -> cue	5✔
38	;;
39
40	let solve ~color_permutation ~task_pool =
41	Stdlib.print_string "Press enter when done choosing a solution: ";	1✔
42	Out_channel.(flush stdout);	1✔
43	let (_ : string) = input_line () in
44	let step_index = ref 0 in	1✔
45	let print (t : Guess.t) =
46	Int.incr step_index;	6✔
47	print_dyn (Dyn.Tuple [ !step_index \|> Dyn.int; t.candidate \|> Code.to_dyn ]);	6✔
48	Out_channel.(flush stdout)	6✔
49	in
50	let rec aux (t : Guess.t) ~possible_solutions =
51	print t;	5✔
52	let cue = input_cue () in	5✔
53	let by_cue =	5✔
54	Nonempty_list.find t.by_cue ~f:(fun by_cue -> Cue.equal cue by_cue.cue)	23✔
55	\|> Option.get	5✔
56	in
57	let possible_solutions =	5✔
58	Codes.filter possible_solutions ~candidate:t.candidate ~cue
59	in
60	if Codes.size possible_solutions = 1	5✔
61	then (	1✔
62	let solution = List.hd (Codes.to_list possible_solutions) in	1✔
63	let guess = Guess.compute ~possible_solutions ~candidate:solution in	1✔
64	print guess)
65	else (	4✔
66	let guess =
67	match by_cue.next_best_guesses with
68	\| Computed [] -> assert false
69	\| Computed (guess :: _) -> guess	2✔
70	\| Not_computed ->	2✔
71	(match Guess.compute_k_best ~task_pool ~possible_solutions ~k:1 () with
72	\| [] -> assert false
73	\| guess :: _ -> guess)	2✔
74	in
75	aux guess ~possible_solutions)
76	in
77	let opening_book = Lazy.force Opening_book.opening_book in
78	let root = Opening_book.root opening_book ~color_permutation in	1✔
79	aux root ~possible_solutions:Codes.all	1✔
80	;;
81
82	let cmd =
83	Command.make	19✔
84	~summary:"Solve interactively."
85	(let open Command.Std in
86	let+ color_permutation =
87	Arg.named_opt	19✔
88	[ "color-permutation" ]
89	Param.int
90	~docv:"N"
91	~doc:"Force use of permutation (random by default)."
92	and+ task_pool_config = Task_pool.Config.arg in
93	let color_permutation =	1✔
94	let index =
95	match color_permutation with
96	\| Some index -> index	1✔
97	\| None -> Random.int (Lazy.force Color_permutation.cardinality) [@coverage off]
98	in
99	Color_permutation.of_index_exn index	1✔
100	in
101	Task_pool.with_t task_pool_config ~f:(fun ~task_pool ->
102	solve ~color_permutation ~task_pool))	1✔
103	;;

mbarbin / super-master-mind / 177

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous