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

80.0

/src/example.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 solve ~task_pool ~color_permutation ~solution =
  let steps = ref [] in
  let step_index = ref 0 in
  let add (t : Guess.t) ~by_cue =
    let by_cue =
      Nonempty_list.singleton
        { by_cue with Guess.By_cue.next_best_guesses = Not_computed }
    in
    let t = { t with by_cue } in
    steps := t :: !steps;
    Int.incr step_index;
    print_dyn (Dyn.Tuple [ !step_index |> Dyn.int; t |> Guess.to_dyn ])
  in
  let rec aux (t : Guess.t) ~possible_solutions =
    let cue = Code.analyze ~solution ~candidate:t.candidate in
    let by_cue =
      Nonempty_list.find t.by_cue ~f:(fun by_cue -> Cue.equal cue by_cue.cue)
      |> Option.get
    in
    add t ~by_cue;
    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
      add guess ~by_cue:(Nonempty_list.hd guess.by_cue))
    else (
      match by_cue.next_best_guesses with
      | Computed [] -> ()
      | Computed (guess :: _) -> aux guess ~possible_solutions
      | Not_computed ->
        (match Guess.compute_k_best ~task_pool ~possible_solutions ~k:1 () with
         | [] -> ()
         | guess :: _ -> aux guess ~possible_solutions))
  in
  let opening_book = Lazy.force Opening_book.opening_book in
  let root =
    Opening_book.root opening_book ~color_permutation:(Lazy.force color_permutation)
  in
  aux root ~possible_solutions:Codes.all;
  List.rev !steps
;;

let cmd =
  Command.make
    ~summary:"Run through an example."
    (let open Command.Std in
     let+ solution =
       Arg.named_opt
         [ "solution" ]
         Code.param
         ~docv:"CODE"
         ~doc:"Specify a chosen solution (default is arbitrary)."
     and+ task_pool_config = Task_pool.Config.arg in
     Task_pool.with_t task_pool_config ~f:(fun ~task_pool ->
       let solution =
         match solution with
         | Some solution -> solution
         | None -> Code.create_exn [| Green; Blue; Orange; White; Red |]
       in
       ignore
         (solve ~task_pool ~color_permutation:Color_permutation.identity ~solution
          : Guess.t list)))
;;

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 solve ~task_pool ~color_permutation ~solution =
8	let steps = ref [] in	2✔
9	let step_index = ref 0 in
10	let add (t : Guess.t) ~by_cue =
11	let by_cue =	11✔
12	Nonempty_list.singleton
13	{ by_cue with Guess.By_cue.next_best_guesses = Not_computed }
14	in
15	let t = { t with by_cue } in	11✔
16	steps := t :: !steps;
17	Int.incr step_index;
18	print_dyn (Dyn.Tuple [ !step_index \|> Dyn.int; t \|> Guess.to_dyn ])	11✔
19	in
20	let rec aux (t : Guess.t) ~possible_solutions =
21	let cue = Code.analyze ~solution ~candidate:t.candidate in	9✔
22	let by_cue =
23	Nonempty_list.find t.by_cue ~f:(fun by_cue -> Cue.equal cue by_cue.cue)	46✔
24	\|> Option.get	9✔
25	in
26	add t ~by_cue;	9✔
27	let possible_solutions =	9✔
28	Codes.filter possible_solutions ~candidate:t.candidate ~cue
29	in
30	if Codes.size possible_solutions = 1	9✔
31	then (	2✔
32	let solution = List.hd (Codes.to_list possible_solutions) in	2✔
33	let guess = Guess.compute ~possible_solutions ~candidate:solution in	2✔
34	add guess ~by_cue:(Nonempty_list.hd guess.by_cue))	2✔
35	else (	7✔
36	match by_cue.next_best_guesses with
37	\| Computed [] -> ()	×
38	\| Computed (guess :: _) -> aux guess ~possible_solutions	4✔
39	\| Not_computed ->	3✔
40	(match Guess.compute_k_best ~task_pool ~possible_solutions ~k:1 () with
41	\| [] -> ()	×
42	\| guess :: _ -> aux guess ~possible_solutions))	3✔
43	in
44	let opening_book = Lazy.force Opening_book.opening_book in
45	let root =	2✔
46	Opening_book.root opening_book ~color_permutation:(Lazy.force color_permutation)	2✔
47	in
48	aux root ~possible_solutions:Codes.all;	2✔
49	List.rev !steps	2✔
50	;;
51
52	let cmd =
53	Command.make	11✔
54	~summary:"Run through an example."
55	(let open Command.Std in
56	let+ solution =
57	Arg.named_opt	11✔
58	[ "solution" ]
59	Code.param
60	~docv:"CODE"
61	~doc:"Specify a chosen solution (default is arbitrary)."
62	and+ task_pool_config = Task_pool.Config.arg in
63	Task_pool.with_t task_pool_config ~f:(fun ~task_pool ->	×
64	let solution =	×
65	match solution with
66	\| Some solution -> solution	×
67	\| None -> Code.create_exn [\| Green; Blue; Orange; White; Red \|]	×
68	in
69	ignore
70	(solve ~task_pool ~color_permutation:Color_permutation.identity ~solution
71	: Guess.t list)))
72	;;

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