mbarbin / super-master-mind / 216

Committed 31 Jan 2026 09:40AM UTC coverage: 75.947% (-12.4%) from 88.313%

Build # 216

Build Type

Pull #45

github

Committed by

web-flow

Commit Message

Merge 729c30d79 into 3d48eb3d9

Pull Request Pull Request #45: Dune pkg ci migration

Run Details

922 of 1214 relevant lines covered (75.95%)

2008918.11 hits per line

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

4.44

/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 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 =
    print_string prompt;
    Out_channel.(flush stdout);
    let int = input_line () in
    match Int.of_string int with
    | Some i -> i
    | None ->
      Printf.printf "%S: Not a int.\n%!" int;
      input_int ~prompt
  in
  let black = input_int ~prompt:"#black (correctly placed)  : " in
  let white =
    let prompt = "#white (incorrectly placed): " in
    if black >= 4
    then (
      print_endline (prompt ^ "0");
      0)
    else input_int ~prompt
  in
  match Cue.create_exn { white; black } with
  | exception e ->
    print_endline (Printexc.to_string e);
    input_cue ()
  | cue -> cue
;;

let solve ~color_permutation ~task_pool =
  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 In_channel.input_line In_channel.stdin with	×
9	\| Some line -> line	×
10	\| None -> raise End_of_file	×
11	;;
12
13	let rec input_cue () =
14	let rec input_int ~prompt =	×
15	print_string prompt;	×
16	Out_channel.(flush stdout);	×
17	let int = input_line () in
18	match Int.of_string int with	×
19	\| Some i -> i	×
20	\| None ->	×
21	Printf.printf "%S: Not a int.\n%!" int;
22	input_int ~prompt	×
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	print_endline (prompt ^ "0");
30	0)	×
31	else input_int ~prompt	×
32	in
33	match Cue.create_exn { white; black } with
34	\| exception e ->	×
35	print_endline (Printexc.to_string e);	×
36	input_cue ()	×
37	\| cue -> cue	×
38	;;
39
40	let solve ~color_permutation ~task_pool =
41	print_string "Press enter when done choosing a solution: ";	×
42	Out_channel.(flush stdout);	×
43	let (_ : string) = input_line () in
44	let step_index = ref 0 in	×
45	let print (t : Guess.t) =
46	Int.incr step_index;	×
47	print_dyn (Dyn.Tuple [ !step_index \|> Dyn.int; t.candidate \|> Code.to_dyn ]);	×
48	Out_channel.(flush stdout)	×
49	in
50	let rec aux (t : Guess.t) ~possible_solutions =
51	print t;	×
52	let cue = input_cue () in	×
53	let by_cue =	×
54	Nonempty_list.find t.by_cue ~f:(fun by_cue -> Cue.equal cue by_cue.cue)	×
55	\|> Option.get	×
56	in
57	let possible_solutions =	×
58	Codes.filter possible_solutions ~candidate:t.candidate ~cue
59	in
60	if Codes.size possible_solutions = 1	×
61	then (	×
62	let solution = List.hd (Codes.to_list possible_solutions) in	×
63	let guess = Guess.compute ~possible_solutions ~candidate:solution in	×
64	print guess)
65	else (	×
66	let guess =
67	match by_cue.next_best_guesses with
68	\| Computed [] -> assert false
69	\| Computed (guess :: _) -> guess	×
70	\| Not_computed ->	×
71	(match Guess.compute_k_best ~task_pool ~possible_solutions ~k:1 () with
72	\| [] -> assert false
73	\| guess :: _ -> guess)	×
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	×
79	aux root ~possible_solutions:Codes.all	×
80	;;
81
82	let cmd =
83	Command.make	11✔
84	~summary:"Solve interactively."
85	(let open Command.Std in
86	let+ color_permutation =
87	Arg.named_opt	11✔
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 =	×
94	let index =
95	match color_permutation with
96	\| Some index -> index	×
97	\| None -> Random.int (Lazy.force Color_permutation.cardinality) [@coverage off]
98	in
99	Color_permutation.of_index_exn index	×
100	in
101	Task_pool.with_t task_pool_config ~f:(fun ~task_pool ->
102	solve ~color_permutation ~task_pool))	×
103	;;

mbarbin / super-master-mind / 216

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