mbarbin / super-master-mind / 178

Committed 16 Dec 2025 02:29PM UTC coverage: 90.591% (-1.4%) from 92.007%

Build # 178

Build Type

Pull #34

github

Committed by

web-flow

Commit Message

Merge 2b6e477ba into e92bc19b9

Pull Request Pull Request #34: Use ordering in comparisons

Run Details

109 of 135 new or added lines in 14 files covered. (80.74%)

44 existing lines in 2 files now uncovered.

1011 of 1116 relevant lines covered (90.59%)

2830912.54 hits per line

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

91.67

/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

let equal = Int.equal
let compare = Int.compare
let size = Cue.code_size

let cardinality =
  lazy
    (let cardinality = Lazy.force Color.cardinality in
     let size = Lazy.force size in
     let res = ref cardinality in
     for _ = 2 to size do
       res := !res * cardinality
     done;
     !res)
;;

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 = Lazy.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 = Lazy.force size in
    let color_cardinality = Lazy.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 mod 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 (Printexc.to_string e)))
    ~to_string:(fun t -> Hum.to_string (to_hum t))
    ()
;;

let check_index_exn index =
  let cardinality = Lazy.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
8
9	let equal = Int.equal
10	let compare = Int.compare
11	let size = Cue.code_size
12
13	let cardinality =
14	lazy
15	(let cardinality = Lazy.force Color.cardinality in	12✔
16	let size = Lazy.force size in	12✔
17	let res = ref cardinality in	12✔
18	for _ = 2 to size do
19	res := !res * cardinality	46✔
20	done;
21	!res)
22	;;
23
24	module Hum = struct
25	type t = Color.Hum.t array
26
27	let to_dyn t = Dyn.array Color.Hum.to_dyn t	56✔
28	let to_json t : Json.t = `List (Array.to_list t \|> List.map ~f:Color.Hum.to_json)	×
29
30	let of_json (json : Json.t) : t =
31	match json with	9✔
32	\| `List l -> Array.of_list l \|> Array.map ~f:Color.Hum.of_json	9✔
33	\| _ -> raise (Json.Invalid_json ("Expected list for [Code.Hum.t].", json))	×
34	;;
35
36	let to_string t = to_json t \|> Json.to_string	×
37	end
38
39	module Computing = struct
40	type t = Color.t array
41
42	let check_size_exn hum =
43	let expected_size = Lazy.force size in	32,867✔
44	let code_size = Array.length hum in	32,867✔
45	if code_size <> expected_size	32,867✔
46	then
47	Code_error.raise	4✔
48	"Invalid code size."
49	[ "code", Hum.to_dyn hum	4✔
50	; "code_size", Dyn.int code_size	4✔
51	; "expected_size", Dyn.int expected_size	4✔
52	]
53	;;
54
55	let create_exn hum =
56	check_size_exn hum;	32,867✔
57	Array.map hum ~f:Color.of_hum	32,863✔
58	;;
59
60	let to_hum t = t \|> Array.map ~f:Color.to_hum	32,820✔
61
62	let of_code (i : int) : t =
63	let size = Lazy.force size in	41,492,465✔
64	let color_cardinality = Lazy.force Color.cardinality in	41,447,788✔
65	let colors = Array.create ~len:size (Color.of_index_exn 0) in	41,227,120✔
66	let remainder = ref i in	41,765,292✔
67	for i = 0 to size - 1 do
68	let rem = !remainder mod color_cardinality in	201,659,956✔
69	remainder := !remainder / color_cardinality;
70	colors.(i) <- Color.of_index_exn rem	200,349,248✔
71	done;
72	colors
73	;;
74
75	let to_code (t : t) : int =
76	let color_cardinality = Lazy.force Color.cardinality in	35,712✔
77	Array.fold_right t ~init:0 ~f:(fun color acc ->	35,712✔
78	(acc * color_cardinality) + Color.to_index color)	178,558✔
79	;;
80
81	let analyze ~(solution : t) ~(candidate : t) =
82	let solution = Array.map solution ~f:(fun i -> Some i) in	20,605,673✔
83	let accounted = Array.map candidate ~f:(fun _ -> false) in	20,682,768✔
84	let black = ref 0 in	20,621,603✔
85	let white = ref 0 in
86	Array.iteri candidate ~f:(fun i color ->
87	match solution.(i) with	102,458,483✔
88	\| None -> assert false
89	\| Some color' ->	102,560,158✔
90	if Color.equal color color'
91	then (	13,876,219✔
92	Int.incr black;
93	accounted.(i) <- true;	13,878,365✔
94	solution.(i) <- None));	13,876,135✔
95	Array.iteri candidate ~f:(fun i color ->	20,789,341✔
96	if not accounted.(i)	102,943,213✔
97	then (	89,425,164✔
98	accounted.(i) <- true;
99	match	89,381,806✔
100	Array.find_mapi solution ~f:(fun j solution ->
101	Option.bind solution ~f:(fun solution ->	360,896,981✔
102	if Color.equal color solution then Some j else None))	32,476,998✔
103	with
104	\| None -> ()	57,001,598✔
105	\| Some j ->	32,492,129✔
106	Int.incr white;
107	solution.(j) <- None));	32,496,166✔
108	Cue.create_exn { white = !white; black = !black }	20,823,925✔
109	;;
110
111	let map_color t ~color_permutation =
112	Array.map t ~f:(fun color -> Color_permutation.map_color color_permutation color)	2,849✔
113	;;
114	end
115
116	let create_exn hum = hum \|> Computing.create_exn \|> Computing.to_code	32,863✔
117	let to_hum t = t \|> Computing.of_code \|> Computing.to_hum	32,820✔
118	let to_dyn t = t \|> to_hum \|> Hum.to_dyn	52✔
119	let to_index t = t	33,051✔
120	let of_json_hum json = Hum.of_json json \|> create_exn	2✔
121
122	let param =
123	Command.Param.create'	19✔
124	~docv:"CODE"
125	~of_string:(fun s ->
126	match Json.of_string s \|> of_json_hum with	2✔
127	\| e -> Ok e	2✔
NEW 128	\| exception e -> Error (`Msg (Printexc.to_string e)))	×
129	~to_string:(fun t -> Hum.to_string (to_hum t))	×
130	()
131	;;
132
133	let check_index_exn index =
134	let cardinality = Lazy.force cardinality in	5,838,404✔
135	if not (0 <= index && index < cardinality)	5,838,074✔
136	then
137	Code_error.raise	1✔
138	"Index out of bounds."
139	[ "index", Dyn.int index; "cardinality", Dyn.int cardinality ]	1✔
140	;;
141
142	let of_index_exn index =
143	check_index_exn index;	5,838,425✔
144	index	5,838,059✔
145	;;
146
147	let analyze ~solution ~candidate =
148	Computing.analyze	20,868,315✔
149	~solution:(Computing.of_code solution)	20,644,491✔
150	~candidate:(Computing.of_code candidate)	20,692,046✔
151	;;
152
153	let map_color t ~color_permutation =
154	t \|> Computing.of_code \|> Computing.map_color ~color_permutation \|> Computing.to_code	2,849✔
155	;;
156
157	let to_json t : Json.t = `Int (to_index t)	283✔
158
159	let of_json (json : Json.t) : t =
160	match json with	2,072✔
161	\| `Int i -> of_index_exn i	2,072✔
162	\| _ -> raise (Json.Invalid_json ("Expected int for [Code.t].", json))	×
163	;;

mbarbin / super-master-mind / 178

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