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

83.33

/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	6✔
16	let size = Lazy.force size in	6✔
17	let res = ref cardinality in	6✔
18	for _ = 2 to size do
19	res := !res * cardinality	24✔
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	39✔
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	×
32	\| `List l -> Array.of_list l \|> Array.map ~f:Color.Hum.of_json	×
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,858✔
44	let code_size = Array.length hum in	32,858✔
45	if code_size <> expected_size	32,858✔
46	then
47	Code_error.raise	3✔
48	"Invalid code size."
49	[ "code", Hum.to_dyn hum	3✔
50	; "code_size", Dyn.int code_size	3✔
51	; "expected_size", Dyn.int expected_size	3✔
52	]
53	;;
54
55	let create_exn hum =
56	check_size_exn hum;	32,858✔
57	Array.map hum ~f:Color.of_hum	32,855✔
58	;;
59
60	let to_hum t = t \|> Array.map ~f:Color.to_hum	32,804✔
61
62	let of_code (i : int) : t =
63	let size = Lazy.force size in	32,074,993✔
64	let color_cardinality = Lazy.force Color.cardinality in	31,904,461✔
65	let colors = Array.create ~len:size (Color.of_index_exn 0) in	31,824,050✔
66	let remainder = ref i in	32,355,621✔
67	for i = 0 to size - 1 do
68	let rem = !remainder mod color_cardinality in	155,764,183✔
69	remainder := !remainder / color_cardinality;
70	colors.(i) <- Color.of_index_exn rem	155,209,338✔
71	done;
72	colors
73	;;
74
75	let to_code (t : t) : int =
76	let color_cardinality = Lazy.force Color.cardinality in	34,668✔
77	Array.fold_right t ~init:0 ~f:(fun color acc ->	34,668✔
78	(acc * color_cardinality) + Color.to_index color)	173,340✔
79	;;
80
81	let analyze ~(solution : t) ~(candidate : t) =
82	let solution = Array.map solution ~f:(fun i -> Some i) in	15,932,432✔
83	let accounted = Array.map candidate ~f:(fun _ -> false) in	15,879,717✔
84	let black = ref 0 in	15,870,099✔
85	let white = ref 0 in
86	Array.iteri candidate ~f:(fun i color ->
87	match solution.(i) with	78,618,762✔
88	\| None -> assert false
89	\| Some color' ->	78,677,998✔
90	if Color.equal color color'
91	then (	10,662,704✔
92	Int.incr black;
93	accounted.(i) <- true;	10,656,670✔
94	solution.(i) <- None));	10,654,919✔
95	Array.iteri candidate ~f:(fun i color ->	16,065,001✔
96	if not accounted.(i)	79,381,692✔
97	then (	69,003,553✔
98	accounted.(i) <- true;
99	match	68,946,369✔
100	Array.find_mapi solution ~f:(fun j solution ->
101	Option.bind solution ~f:(fun solution ->	276,479,195✔
102	if Color.equal color solution then Some j else None))	24,582,330✔
103	with
104	\| None -> ()	44,567,591✔
105	\| Some j ->	24,594,034✔
106	Int.incr white;
107	solution.(j) <- None));	24,593,576✔
108	Cue.create_exn { white = !white; black = !black }	16,116,679✔
109	;;
110
111	let map_color t ~color_permutation =
112	Array.map t ~f:(fun color -> Color_permutation.map_color color_permutation color)	1,813✔
113	;;
114	end
115
116	let create_exn hum = hum \|> Computing.create_exn \|> Computing.to_code	32,855✔
117	let to_hum t = t \|> Computing.of_code \|> Computing.to_hum	32,804✔
118	let to_dyn t = t \|> to_hum \|> Hum.to_dyn	36✔
119	let to_index t = t	32,768✔
120	let of_json_hum json = Hum.of_json json \|> create_exn	×
121
122	let param =
123	Command.Param.create'	11✔
124	~docv:"CODE"
125	~of_string:(fun s ->
126	match Json.of_string s \|> of_json_hum with	×
127	\| e -> Ok e	×
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	4,293,343✔
135	if not (0 <= index && index < cardinality)	4,292,910✔
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;	4,293,274✔
144	index	4,292,928✔
145	;;
146
147	let analyze ~solution ~candidate =
148	Computing.analyze	16,159,726✔
149	~solution:(Computing.of_code solution)	16,016,851✔
150	~candidate:(Computing.of_code candidate)	16,006,599✔
151	;;
152
153	let map_color t ~color_permutation =
154	t \|> Computing.of_code \|> Computing.map_color ~color_permutation \|> Computing.to_code	1,813✔
155	;;
156
157	let to_json t : Json.t = `Int (to_index t)	×
158
159	let of_json (json : Json.t) : t =
160	match json with	777✔
161	\| `Int i -> of_index_exn i	777✔
162	\| _ -> raise (Json.Invalid_json ("Expected int for [Code.t].", json))	×
163	;;

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