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

91.55

/src/code.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                                                 *)
(*********************************************************************************)

type t = int [@@deriving compare, equal]

let size = Cue.code_size
let cardinality = lazy (Int.pow (force Color.cardinality) (force size))

module Hum = struct
  type t = Color.Hum.t array

  let to_dyn t = Dyn.array Color.Hum.to_dyn t
  let to_json t : Json.t = `List (Array.to_list t |> List.map ~f:Color.Hum.to_json)

  let of_json (json : Json.t) : t =
    match json with
    | `List l -> Array.of_list l |> Array.map ~f:Color.Hum.of_json
    | _ -> raise (Json.Invalid_json ("Expected list for [Code.Hum.t].", json))
  ;;

  let to_string t = to_json t |> Json.to_string
end

module Computing = struct
  type t = Color.t array

  let check_size_exn hum =
    let expected_size = force size in
    let code_size = Array.length hum in
    if code_size <> expected_size
    then
      Code_error.raise
        "Invalid code size."
        [ "code", Hum.to_dyn hum
        ; "code_size", Dyn.int code_size
        ; "expected_size", Dyn.int expected_size
        ]
  ;;

  let create_exn hum =
    check_size_exn hum;
    Array.map hum ~f:Color.of_hum
  ;;

  let to_hum t = t |> Array.map ~f:Color.to_hum

  let of_code (i : int) : t =
    let size = force size in
    let color_cardinality = force Color.cardinality in
    let colors = Array.create ~len:size (Color.of_index_exn 0) in
    let remainder = ref i in
    for i = 0 to size - 1 do
      let rem = !remainder % color_cardinality in
      remainder := !remainder / color_cardinality;
      colors.(i) <- Color.of_index_exn rem
    done;
    colors
  ;;

  let to_code (t : t) : int =
    let color_cardinality = Lazy.force Color.cardinality in
    Array.fold_right t ~init:0 ~f:(fun color acc ->
      (acc * color_cardinality) + Color.to_index color)
  ;;

  let analyze ~(solution : t) ~(candidate : t) =
    let solution = Array.map solution ~f:(fun i -> Some i) in
    let accounted = Array.map candidate ~f:(fun _ -> false) in
    let black = ref 0 in
    let white = ref 0 in
    Array.iteri candidate ~f:(fun i color ->
      match solution.(i) with
      | None -> assert false
      | Some color' ->
        if Color.equal color color'
        then (
          Int.incr black;
          accounted.(i) <- true;
          solution.(i) <- None));
    Array.iteri candidate ~f:(fun i color ->
      if not accounted.(i)
      then (
        accounted.(i) <- true;
        match
          Array.find_mapi solution ~f:(fun j solution ->
            Option.bind solution ~f:(fun solution ->
              if Color.equal color solution then Some j else None))
        with
        | None -> ()
        | Some j ->
          Int.incr white;
          solution.(j) <- None));
    Cue.create_exn { white = !white; black = !black }
  ;;

  let map_color t ~color_permutation =
    Array.map t ~f:(fun color -> Color_permutation.map_color color_permutation color)
  ;;
end

let create_exn hum = hum |> Computing.create_exn |> Computing.to_code
let to_hum t = t |> Computing.of_code |> Computing.to_hum
let to_dyn t = t |> to_hum |> Hum.to_dyn
let to_index t = t
let of_json_hum json = Hum.of_json json |> create_exn

let param =
  Command.Param.create'
    ~docv:"CODE"
    ~of_string:(fun s ->
      match Json.of_string s |> of_json_hum with
      | e -> Ok e
      | exception e -> Error (`Msg (Exn.to_string e)))
    ~to_string:(fun t -> Hum.to_string (to_hum t))
    ()
;;

let check_index_exn index =
  let cardinality = force cardinality in
  if not (0 <= index && index < cardinality)
  then
    Code_error.raise
      "Index out of bounds."
      [ "index", Dyn.int index; "cardinality", Dyn.int cardinality ]
;;

let of_index_exn index =
  check_index_exn index;
  index
;;

let analyze ~solution ~candidate =
  Computing.analyze
    ~solution:(Computing.of_code solution)
    ~candidate:(Computing.of_code candidate)
;;

let map_color t ~color_permutation =
  t |> Computing.of_code |> Computing.map_color ~color_permutation |> Computing.to_code
;;

let to_json t : Json.t = `Int (to_index t)

let of_json (json : Json.t) : t =
  match json with
  | `Int i -> of_index_exn i
  | _ -> raise (Json.Invalid_json ("Expected int for [Code.t].", json))
;;

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	type t = int [@@deriving compare, equal]	62,955✔
8
9	let size = Cue.code_size
10	let cardinality = lazy (Int.pow (force Color.cardinality) (force size))	12✔
11
12	module Hum = struct
13	type t = Color.Hum.t array
14
15	let to_dyn t = Dyn.array Color.Hum.to_dyn t	56✔
NEW 16	let to_json t : Json.t = `List (Array.to_list t \|> List.map ~f:Color.Hum.to_json)	×
17
18	let of_json (json : Json.t) : t =
19	match json with	9✔
20	\| `List l -> Array.of_list l \|> Array.map ~f:Color.Hum.of_json	9✔
NEW 21	\| _ -> raise (Json.Invalid_json ("Expected list for [Code.Hum.t].", json))	×
22	;;
23
NEW 24	let to_string t = to_json t \|> Json.to_string	×
25	end
26
27	module Computing = struct
28	type t = Color.t array
29
30	let check_size_exn hum =
31	let expected_size = force size in	32,867✔
32	let code_size = Array.length hum in	32,867✔
33	if code_size <> expected_size	32,867✔
34	then
35	Code_error.raise	4✔
36	"Invalid code size."
37	[ "code", Hum.to_dyn hum	4✔
38	; "code_size", Dyn.int code_size	4✔
39	; "expected_size", Dyn.int expected_size	4✔
40	]
41	;;
42
43	let create_exn hum =
44	check_size_exn hum;	32,867✔
45	Array.map hum ~f:Color.of_hum	32,863✔
46	;;
47
48	let to_hum t = t \|> Array.map ~f:Color.to_hum	32,820✔
49
50	let of_code (i : int) : t =
51	let size = force size in	41,576,346✔
52	let color_cardinality = force Color.cardinality in	41,580,841✔
53	let colors = Array.create ~len:size (Color.of_index_exn 0) in	41,328,422✔
54	let remainder = ref i in	41,782,577✔
55	for i = 0 to size - 1 do
56	let rem = !remainder % color_cardinality in	200,886,006✔
57	remainder := !remainder / color_cardinality;	200,611,963✔
58	colors.(i) <- Color.of_index_exn rem	199,349,866✔
59	done;
60	colors
61	;;
62
63	let to_code (t : t) : int =
64	let color_cardinality = Lazy.force Color.cardinality in	35,712✔
65	Array.fold_right t ~init:0 ~f:(fun color acc ->	35,712✔
66	(acc * color_cardinality) + Color.to_index color)	178,558✔
67	;;
68
69	let analyze ~(solution : t) ~(candidate : t) =
70	let solution = Array.map solution ~f:(fun i -> Some i) in	20,743,157✔
71	let accounted = Array.map candidate ~f:(fun _ -> false) in	20,873,241✔
72	let black = ref 0 in	20,782,985✔
73	let white = ref 0 in
74	Array.iteri candidate ~f:(fun i color ->
75	match solution.(i) with	102,854,464✔
76	\| None -> assert false
77	\| Some color' ->	102,973,425✔
78	if Color.equal color color'
79	then (	13,857,899✔
80	Int.incr black;
81	accounted.(i) <- true;	13,845,626✔
82	solution.(i) <- None));	13,850,944✔
83	Array.iteri candidate ~f:(fun i color ->	20,786,511✔
84	if not accounted.(i)	102,169,215✔
85	then (	88,896,776✔
86	accounted.(i) <- true;
87	match	88,883,796✔
88	Array.find_mapi solution ~f:(fun j solution ->
89	Option.bind solution ~f:(fun solution ->	354,634,239✔
90	if Color.equal color solution then Some j else None))	32,432,280✔
91	with
92	\| None -> ()	56,866,720✔
93	\| Some j ->	32,447,650✔
94	Int.incr white;
95	solution.(j) <- None));	32,444,040✔
96	Cue.create_exn { white = !white; black = !black }	20,812,307✔
97	;;
98
99	let map_color t ~color_permutation =
100	Array.map t ~f:(fun color -> Color_permutation.map_color color_permutation color)	2,849✔
101	;;
102	end
103
104	let create_exn hum = hum \|> Computing.create_exn \|> Computing.to_code	32,863✔
105	let to_hum t = t \|> Computing.of_code \|> Computing.to_hum	32,820✔
106	let to_dyn t = t \|> to_hum \|> Hum.to_dyn	52✔
107	let to_index t = t	33,051✔
108	let of_json_hum json = Hum.of_json json \|> create_exn	2✔
109
110	let param =
111	Command.Param.create'	19✔
112	~docv:"CODE"
113	~of_string:(fun s ->
114	match Json.of_string s \|> of_json_hum with	2✔
115	\| e -> Ok e	2✔
116	\| exception e -> Error (`Msg (Exn.to_string e)))	×
NEW 117	~to_string:(fun t -> Hum.to_string (to_hum t))	×
118	()
119	;;
120
121	let check_index_exn index =
122	let cardinality = force cardinality in	5,838,428✔
123	if not (0 <= index && index < cardinality)	5,838,393✔
124	then
125	Code_error.raise	1✔
126	"Index out of bounds."
127	[ "index", Dyn.int index; "cardinality", Dyn.int cardinality ]	1✔
128	;;
129
130	let of_index_exn index =
131	check_index_exn index;	5,838,423✔
132	index	5,838,284✔
133	;;
134
135	let analyze ~solution ~candidate =
136	Computing.analyze	20,879,895✔
137	~solution:(Computing.of_code solution)	20,795,534✔
138	~candidate:(Computing.of_code candidate)	20,753,097✔
139	;;
140
141	let map_color t ~color_permutation =
142	t \|> Computing.of_code \|> Computing.map_color ~color_permutation \|> Computing.to_code	2,849✔
143	;;
144
145	let to_json t : Json.t = `Int (to_index t)	283✔
146
147	let of_json (json : Json.t) : t =
148	match json with	2,072✔
149	\| `Int i -> of_index_exn i	2,072✔
NEW 150	\| _ -> raise (Json.Invalid_json ("Expected int for [Code.t].", json))	×
151	;;

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