mbarbin / super-master-mind / 157

Committed 19 Sep 2025 02:05PM UTC coverage: 96.347% (+0.008%) from 96.339%

Build # 157

Build Type

push

github

Committed by

mbarbin

Commit Message

Upgrade to cmdlang.0.0.10

Run Details

2 of 4 new or added lines in 2 files covered. (50.0%)

844 of 876 relevant lines covered (96.35%)

3381428.51 hits per line

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

94.83

/lib/super_master_mind/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, hash]

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

module Hum = struct
  type t = Color.Hum.t array [@@deriving sexp]
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
      raise_s
        [%sexp
          "Invalid code size"
        , { code = (hum : Hum.t); code_size : int; expected_size : int }]
  ;;

  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 = 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 sexp_of_t t = [%sexp (to_hum t : Hum.t)]
let t_of_sexp sexp = sexp |> [%of_sexp: Hum.t] |> create_exn
let to_index t = t

let param =
  Command.Param.create'
    ~docv:"CODE"
    ~of_string:(fun s ->
      match Parsexp.Single.parse_string_exn s |> [%of_sexp: t] with
      | e -> Ok e
      | exception e -> Error (`Msg (Exn.to_string e)))
    ~to_string:(fun t -> Sexp.to_string ([%sexp_of: t] t))
    ()
;;

let check_index_exn index =
  let cardinality = force cardinality in
  if not (0 <= index && index < cardinality)
  then raise_s [%sexp "Index out of bounds", { index : int; cardinality : int }]
;;

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
;;

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, hash]	×
8
9	let size = Cue.code_size
10	let cardinality = lazy (Int.pow (force Color.cardinality) (force size))	11✔
11
12	module Hum = struct
13	type t = Color.Hum.t array [@@deriving sexp]	2,422✔
14	end
15
16	module Computing = struct
17	type t = Color.t array
18
19	let check_size_exn hum =
20	let expected_size = force size in	34,939✔
21	let code_size = Array.length hum in	34,939✔
22	if code_size <> expected_size	34,939✔
23	then
24	raise_s	4✔
25	[%sexp
26	"Invalid code size"
27	, { code = (hum : Hum.t); code_size : int; expected_size : int }]
28	;;
29
30	let create_exn hum =
31	check_size_exn hum;	34,939✔
32	Array.map hum ~f:Color.of_hum	34,935✔
33	;;
34
35	let to_hum t = t \|> Array.map ~f:Color.to_hum	33,105✔
36
37	let of_code (i : int) : t =
38	let size = force size in	41,582,390✔
39	let color_cardinality = force Color.cardinality in	41,524,656✔
40	let colors = Array.create ~len:size (Color.of_index_exn 0) in	41,404,811✔
41	let remainder = ref i in	41,843,929✔
42	for i = 0 to size - 1 do
43	let rem = !remainder % color_cardinality in	202,497,917✔
44	remainder := !remainder / color_cardinality;	202,475,997✔
45	colors.(i) <- Color.of_index_exn rem	202,919,525✔
46	done;
47	colors
48	;;
49
50	let to_code (t : t) : int =
51	let color_cardinality = force Color.cardinality in	37,784✔
52	Array.fold_right t ~init:0 ~f:(fun color acc ->	37,784✔
53	(acc * color_cardinality) + Color.to_index color)	188,918✔
54	;;
55
56	let analyze ~(solution : t) ~(candidate : t) =
57	let solution = Array.map solution ~f:(fun i -> Some i) in	20,537,609✔
58	let accounted = Array.map candidate ~f:(fun _ -> false) in	20,899,196✔
59	let black = ref 0 in	20,655,620✔
60	let white = ref 0 in
61	Array.iteri candidate ~f:(fun i color ->
62	match solution.(i) with	102,099,328✔
63	\| None -> assert false
64	\| Some color' ->	102,380,762✔
65	if Color.equal color color'
66	then (	13,870,466✔
67	Int.incr black;
68	accounted.(i) <- true;	13,817,605✔
69	solution.(i) <- None));	13,838,416✔
70	Array.iteri candidate ~f:(fun i color ->	20,804,800✔
71	if not accounted.(i)	103,134,936✔
72	then (	89,680,437✔
73	accounted.(i) <- true;
74	match	89,646,290✔
75	Array.find_mapi solution ~f:(fun j solution ->
76	Option.bind solution ~f:(fun solution ->	359,458,692✔
77	if Color.equal color solution then Some j else None))	32,593,890✔
78	with
79	\| None -> ()	57,308,321✔
80	\| Some j ->	32,590,623✔
81	Int.incr white;
82	solution.(j) <- None));	32,580,862✔
83	Cue.create_exn { white = !white; black = !black }	20,869,166✔
84	;;
85
86	let map_color t ~color_permutation =
87	Array.map t ~f:(fun color -> Color_permutation.map_color color_permutation color)	2,849✔
88	;;
89	end
90
91	let create_exn hum = hum \|> Computing.create_exn \|> Computing.to_code	34,935✔
92	let to_hum t = t \|> Computing.of_code \|> Computing.to_hum	33,105✔
93	let sexp_of_t t = [%sexp (to_hum t : Hum.t)]	337✔
94	let t_of_sexp sexp = sexp \|> [%of_sexp: Hum.t] \|> create_exn	2,074✔
95	let to_index t = t	32,768✔
96
97	let param =
98	Command.Param.create'	19✔
99	~docv:"CODE"
100	~of_string:(fun s ->
101	match Parsexp.Single.parse_string_exn s \|> [%of_sexp: t] with	2✔
102	\| e -> Ok e	2✔
103	\| exception e -> Error (`Msg (Exn.to_string e)))	×
NEW 104	~to_string:(fun t -> Sexp.to_string ([%sexp_of: t] t))	×
105	()
106	;;
107
108	let check_index_exn index =
109	let cardinality = force cardinality in	5,869,144✔
110	if not (0 <= index && index < cardinality)	5,868,909✔
111	then raise_s [%sexp "Index out of bounds", { index : int; cardinality : int }]	1✔
112	;;
113
114	let of_index_exn index =
115	check_index_exn index;	5,869,020✔
116	index	5,868,717✔
117	;;
118
119	let analyze ~solution ~candidate =
120	Computing.analyze	20,919,816✔
121	~solution:(Computing.of_code solution)	20,808,225✔
122	~candidate:(Computing.of_code candidate)	20,689,524✔
123	;;
124
125	let map_color t ~color_permutation =
126	t \|> Computing.of_code \|> Computing.map_color ~color_permutation \|> Computing.to_code	2,849✔
127	;;

mbarbin / super-master-mind / 157

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