~srpablo/squardle_bot

87d9ba61c57878a9d59106faea1ddb9e3af7632d — Pablo Meier 1 year, 5 months ago fe34a73 
some file reorg
patch browse .tar.gz 
9 files changed, 357 insertions(+), 377 deletions(-)

M src/squardle_solver.ml
M src/squardle_solver_lib/cli.ml
A src/squardle_solver_lib/datatypes.ml
M src/squardle_solver_lib/game.ml
A src/squardle_solver_lib/main.ml
A src/squardle_solver_lib/suggest.ml
D src/squardle_solver_lib/tag_colors.ml
A src/squardle_solver_lib/wordlist.mli
M src/squardle_solver_lib_test/test_squardle.ml

M src/squardle_solver.ml => src/squardle_solver.ml +1 -1
@@ 1,1 1,1 @@
Squardle_solver_lib.Game.play ()
Squardle_solver_lib.Main.play ()


M src/squardle_solver_lib/cli.ml => src/squardle_solver_lib/cli.ml +1 -1
@@ 1,5 1,5 @@
open Core
open Tag_colors
open Datatypes

(* This is a little hacked together — we need a way to interact with the program
 * to tell us what the Squardle acutally told us back. So we have this little CLI


A src/squardle_solver_lib/datatypes.ml => src/squardle_solver_lib/datatypes.ml +112 -0
@@ 0,0 1,112 @@
open Core

type tag_color =
  | Red of int
  | Yellow of int
  | Orange of int * int
  | White
  | Green
  | Black
[@@deriving show, eq]

(*
 * A "tag" is one of those little bits of information on a tile:
 * e.g. "this is green containing 'T'" or "this is red, on 'R',
 * with two arrows." It's just those two bits of data: the color,
 * any numbers on that color (the arrows on them), and the character
 * we've guessed.
 *
 * Then Pablo, my brother in Christ, what the hell is all this? Why
 * isn't this `type tag = {guess: string; color: tag_color}`?
 *
 * Well OCaml is very tYpE-sAfE, so you can't just say "stick it
 * in a set," you have to do the OCaml equivalent of defining
 * equals() and hashCode(). That's what all this crap is: wrapping
 * it in a struct/module, which in turn contains another little
 * struct/module that we can pass to the "convenience" functor
 * to easily make this Set-insertable. Details here:
 *
 * https://dev.realworldocaml.org/maps-and-hashtables.html#sets
 *)
module Tag = struct
  module T = struct
    type t = {
      guess: string;
      color: tag_color;
    }

    let create s c = { guess = s; color = c }

    let show_tag { guess; color } = Format.sprintf "{%s,%s}" guess (show_tag_color color)

    let compare { guess = g1; color = c1 } { guess = g2; color = c2 } =
      if Stdlib.( = ) c1 c2 then
        String.compare g1 g2
      else
        -1

    let sexp_of_t { guess = g1; color = c1 } =
      Sexp.List [Sexp.Atom g1; Sexp.Atom (show_tag_color c1)]
  end

  include T
  include Comparator.Make (T)
end

open Tag

type tile =
  | Solved of string * (Tag.t, Tag.comparator_witness) Set.t
  | Unsolved of (Tag.t, Tag.comparator_witness) Set.t

(*
 * Okay, fucking NOW what!? `pp_tile` and `equal_tile`?
 *
 * Yeah man, do you ever want to print your value, like `IO.inspect` in Elixir?
 * Well too bad, we have to define the equivalent of `toString()` here. And while
 * `ppx_derive` can do that for most simple datatypes, it didn't work with
 * Jane Street's Set, so I have to implement these myself on this type.
 *)
let pp_tile formatter t =
  match t with
  | Solved (x, _) -> Format.pp_print_string formatter ("Solved " ^ x)
  | Unsolved tags ->
      let tags_as_strings = tags |> Set.to_list |> List.map ~f:show_tag |> String.concat ~sep:"," in
      Format.pp_print_string formatter ("Unsolved set(" ^ tags_as_strings ^ ")")


let equal_tile t1 t2 =
  match t1, t2 with
  | Unsolved _, Solved _ -> false
  | Solved _, Unsolved _ -> false
  | Solved (x1, _), Solved (x2, _) -> String.equal x1 x2
  | Unsolved x1, Unsolved x2 -> Set.equal x1 x2


type board = tile list [@@deriving show, eq]

type game = {
  board: board;
  cursor: int;
  num_guesses: int;
}
[@@deriving show, eq]

type guess_type =
  | Row
  | Col

(* A single, itty-bitty util. *)
let explode_string str = String.to_list str |> List.map ~f:Char.to_string

let row_offsets = function
  | 0 -> [0; 1; 2; 3; 4]
  | 1 -> [8; 9; 10; 11; 12]
  | 2 -> [16; 17; 18; 19; 20]
  | _ -> failwith "invalid row index"

let col_offsets = function
  | 0 -> [0; 5; 8; 13; 16]
  | 1 -> [2; 6; 10; 14; 18]
  | 2 -> [4; 7; 12; 15; 20]
  | _ -> failwith "invalid col index"


M src/squardle_solver_lib/game.ml => src/squardle_solver_lib/game.ml +31 -346
@@ 1,98 1,9 @@
open Core
open Tag_colors

(*
 * - Write guess logic
 *   - Score with ambiguities
 *   - Pick lowest ambiguities
 *   - OCaml pre-5:00, so no parallel :'(
 *)

(*
 * A "tag" is one of those little bits of information on a tile:
 * e.g. "this is green containing 'T'" or "this is red, on 'R',
 * with two arrows." It's just those two bits of data: the color,
 * any numbers on that color (the arrows on them), and the character
 * we've guessed.
 *
 * Then Pablo, my brother in Christ, what the hell is all this?
 *
 * Well OCaml is very tYpE-sAfE, so you can't just say "stick it
 * in a set," you have to do the OCaml equivalent of defining
 * equals() and hashCode(). That's what all this crap is: wrapping
 * it in a struct/module, which in turn contains another little
 * struct/module that we can pass to the "convenience" functor
 * to easily make this Set-insertable. Details here:
 *
 * https://dev.realworldocaml.org/maps-and-hashtables.html#sets
 *)
module Tag = struct
  module T = struct
    type t = {
      guess: string;
      color: Tag_colors.tag_color;
    }

    let create s c = { guess = s; color = c }

    let show_tag { guess; color } = Format.sprintf "{%s,%s}" guess (show_tag_color color)

    let compare { guess = g1; color = c1 } { guess = g2; color = c2 } =
      if Stdlib.( = ) c1 c2 then
        String.compare g1 g2
      else
        -1


    let sexp_of_t { guess = g1; color = c1 } =
      Sexp.List [Sexp.Atom g1; Sexp.Atom (show_tag_color c1)]
  end

  include T
  include Comparator.Make (T)
end

open Tag

type tile =
  | Solved of string * (Tag.t, Tag.comparator_witness) Set.t
  | Unsolved of (Tag.t, Tag.comparator_witness) Set.t

(*
 * Okay, fucking NOW what!? `pp_tile` and `equal_tile`?
 *
 * Yeah man, do you ever want to print your value, like `IO.inspect` in Elixir?
 * Well too bad, we have to define the equivalent of `toString()` here. And while
 * `ppx_derive` can do that for most simple datatypes, it didn't work with
 * Jane Street's Set, so I have to implement these myself on this type.
 *)
let pp_tile formatter t =
  match t with
  | Solved (x, _) -> Format.pp_print_string formatter ("Solved " ^ x)
  | Unsolved tags ->
      let tags_as_strings = tags |> Set.to_list |> List.map ~f:show_tag |> String.concat ~sep:"," in
      Format.pp_print_string formatter ("Unsolved set(" ^ tags_as_strings ^ ")")


let equal_tile t1 t2 =
  match t1, t2 with
  | Unsolved _, Solved _ -> false
  | Solved _, Unsolved _ -> false
  | Solved (x1, _), Solved (x2, _) -> String.equal x1 x2
  | Unsolved x1, Unsolved x2 -> Set.equal x1 x2


type board = tile list [@@deriving show, eq]

type game = {
  board: board;
  cursor: int;
  num_guesses: int;
}
[@@deriving show, eq]
open Datatypes
open Datatypes.Tag

(* ******************* *)
(* GAME MODELING LOGIC *)
let explode_string str = String.to_list str |> List.map ~f:Char.to_string

let tag_from_tuple (str, color) = { guess = str; color }



@@ 101,21 12,6 @@ let make_new_tags exploded_string color_collection =
  | List.Or_unequal_lengths.Ok lst -> List.map ~f:tag_from_tuple lst
  | List.Or_unequal_lengths.Unequal_lengths -> failwith "unequal lengths"


let row_offsets = function
  | 0 -> [0; 1; 2; 3; 4]
  | 1 -> [8; 9; 10; 11; 12]
  | 2 -> [16; 17; 18; 19; 20]
  | _ -> failwith "invalid row index"


let col_offsets = function
  | 0 -> [0; 5; 8; 13; 16]
  | 1 -> [2; 6; 10; 14; 18]
  | 2 -> [4; 7; 12; 15; 20]
  | _ -> failwith "invalid col index"


(* mad inefficient but who cares lol *)
let sub_value_at lst i new_val = List.take lst i @ [new_val] @ List.drop lst (i + 1)



@@ 130,7 26,6 @@ let add_tags_generic board offsets tags =
      in
      sub_value_at accum offset tile)


let set_row_tiles cursor row board = add_tags_generic board (row_offsets cursor) row

let set_col_tiles ~cursor ~col board = add_tags_generic board (col_offsets cursor) col


@@ 140,7 35,7 @@ let set_col_tiles ~cursor ~col board = add_tags_generic board (col_offsets curso
 * will tell you what tags it produced, we feed that to the bot. That's
 * row_resp and col_resp.
 *)
let guess { board; cursor; num_guesses } guess row_colors col_colors =
let record_guess { board; cursor; num_guesses } guess row_colors col_colors =
  let exploded_string = explode_string guess in
  let row_tags = make_new_tags exploded_string row_colors in
  let col_tags = make_new_tags exploded_string col_colors in


@@ 148,241 43,31 @@ let guess { board; cursor; num_guesses } guess row_colors col_colors =
  let new_cursor = (cursor + 1) mod 3 in
  { board = new_board; cursor = new_cursor; num_guesses = num_guesses - 1 }


(* SUGGESTION GENERATION LOGIC *)

(* Red is an exclusion for row guesses, and yellow is an exclusion for col guesses.
 * We want `best_shot` to be pretty general, but it will need to know which one we're doing,
 * so we pass it this data type.
 *)
type guess_type =
  | Row
  | Col

let tags_of = function
  | Solved (_, t) -> t
  | Unsolved t -> t


let color_match seeking presented =
  match seeking, presented.color with
  | White, White -> true
  | Black, Black -> true
  | Green, Green -> true
  | Red _, Red _ -> true
  | Orange _, Orange _ -> true
  | Yellow _, Yellow _ -> true
  | _ -> false


let tags_if_unsolved = function
  | Solved _ -> None
  | Unsolved lst -> Some lst


let is_exclusion guess_type { color; guess } =
  match guess_type, color with
  | _, Black -> Some guess
  | _, White -> Some guess
  | Col, Yellow _ -> Some guess
  | Row, Red _ -> Some guess
  | _ -> None


let get_inclusion_type = function
  | Col -> Red 1
  | Row -> Yellow 1


let tag_set_to_exclusion_string guess_type set =
  set |> Set.to_list |> List.filter_map ~f:(is_exclusion guess_type) |> Set.of_list (module String)


let generate_exclusions tiles guess_type =
  tiles
  |> List.filter_map ~f:tags_if_unsolved
  |> List.fold ~init:(Set.empty (module Tag)) ~f:(fun accum s1 -> Set.union accum s1)
  |> tag_set_to_exclusion_string guess_type


let as_exclusion_regex str =
  if String.equal str "" then
    "."
  else
    String.concat ["[^"; str; "]"]


let pattern_char_for exclusion_pattern tile =
  match tile with
  | Solved (x, _) -> x
  | Unsolved _ -> exclusion_pattern


let winnow_down_list valid_guess_list tiles guess_type global_blacks =
  let global_exclusions = tag_set_to_exclusion_string guess_type global_blacks in
  let exclusion_pattern =
    generate_exclusions tiles guess_type
    |> Set.union global_exclusions
    |> Set.to_list
    |> String.concat
    |> as_exclusion_regex
  in
  let regex_pattern = List.map tiles ~f:(pattern_char_for exclusion_pattern) |> String.concat in
  let () = Printf.printf "%s\n" regex_pattern in
  let regex = Re2.create_exn regex_pattern in
  List.filter_map valid_guess_list ~f:(fun x -> if Re2.matches regex x then Some x else None)


(* Should have made these maps lol *)
let find_tag_for_char tagset chr return_if_true =
  let filtered =
    Set.to_list tagset |> List.filter ~f:(fun { guess; _ } -> String.equal guess chr)
  in
  match filtered with
  | [] -> None
  | _ -> Some return_if_true


let score_spot ojs_reds_yellows whites (tile, guess_char) =
  match tile with
  | Solved _ -> 10
  | Unsolved tags -> (
      (* If this tiles already has a tag for guess_char, 0 points 
       * Else, if there is an oj/red/yellow, 5 points
       * Additionally, if there is a global white, 2 points
       *)
      match find_tag_for_char tags guess_char 0 with
      | Some _ -> 0
      | None ->
          let is_oj_but_not_this = find_tag_for_char ojs_reds_yellows guess_char 5 in
          let is_global_white = find_tag_for_char whites guess_char 2 in
          Option.value ~default:0 is_oj_but_not_this + Option.value ~default:0 is_global_white)


let score_guess tiles ojs_reds_yellows considered_whites guess =
  let tiles_and_chars = List.zip_exn tiles (explode_string guess) in
  let score =
    tiles_and_chars
    |> List.map ~f:(score_spot ojs_reds_yellows considered_whites)
    |> List.fold ~init:0 ~f:( + )
let starting_game =
  let empty_tag_set = Set.of_list (module Tag) [] in
  let starting_board =
    [
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
      Unsolved empty_tag_set;
    ]
  in
  guess, score


let tags_of_color color lst_of_tiles =
  lst_of_tiles
  |> List.map ~f:tags_of
  |> List.fold ~init:(Set.empty (module Tag)) ~f:Base.Set.union
  |> Set.to_list
  |> List.filter ~f:(color_match color)
  |> Set.of_list (module Tag)


(**
 * We do dynamic regex construction, and really naive matching. If we had Elixir Streams, that'd
 * be pretty dope but I trust OCaml is p fast. We'll look at the tag lists, construct regexes
 * for the following:
 *
 *  - Look at the tags and produce a list of _absolute exclusions_. These
 *    letters will not appear in our guess word at all. Examples:
 *    - Black tiles (from anywhere on the board)
 *    - White Tiles, locally (if it were in this col or row, it'd be a different color)
 *    - Yellow for column, Red for row (these would be orange if they were in this guess).
 *  - Additionally, "pin" any green tiles as fixed in the word we're looking for.
 * 
 *  This winnows down our word list pretty significantly. After this, we take the Red/Yellows
 *  and try various combinations:
 *  
 *  - Not in their current tile, or a green one. Each present one adds 3 "points."
 *  - "Global" white tiles that aren't present in this row or column at all. Adds 1 "point"
 *  - A locked green tile remains, adds 5 "points."
 *
 *  Of all the candidates, we return the ones with the highest score.
 *)
let best_shot valid_guess_list tiles guess_type global_blacks global_whites =
  let winnowed = winnow_down_list valid_guess_list tiles guess_type global_blacks in
  let local_whites = tags_of_color White tiles in
  let considered_whites = Set.diff global_whites local_whites in
  let ojs_red_yellows =
    tags_of_color (Orange (1, 1)) tiles
    |> Set.union (tags_of_color (get_inclusion_type guess_type) tiles)
  in
  let scored = List.map ~f:(score_guess tiles ojs_red_yellows considered_whites) winnowed in
  List.sort scored ~compare:(fun (_, s1) (_, s2) -> Int.compare s2 s1) |> List.hd_exn


(*
 * Toplevel returns a guess for the current gamestate. Considers the row and column separately, and returns the
 * one that has the highest likelihood of being "solved" in this turn. This is done with a point system explained
 * above. Note that a solved row or col will consist entirely of green tiles, so we hardcode against that specific
 * case by checking for 25 points and _not_ taking that suggestion.
 *
 * If both are already solved and your cursor is on that pair, in theory I could write some logic that maximizes for
 * information gathering, but that's a lot of trouble to consider right now.
 *)
let suggest { board; cursor; _ } =
  let global_blacks = tags_of_color Black board in
  let global_whites = tags_of_color White board in
  let row_tiles = List.map (row_offsets cursor) ~f:(List.nth_exn board) in
  let col_tiles = List.map (col_offsets cursor) ~f:(List.nth_exn board) in
  let row_guess, row_score =
    best_shot Wordlist.valid_guesses row_tiles Row global_blacks global_whites
  in
  let col_guess, col_score =
    best_shot Wordlist.valid_guesses col_tiles Col global_blacks global_whites
  in
  let () = Printf.printf "Row guess: %s %d\n" row_guess row_score in
  let () = Printf.printf "Col guess: %s %d\n" col_guess col_score in
  match phys_equal row_score 50, phys_equal col_score 50 with
  | true, _ -> col_guess
  | _, true -> row_guess
  | _ -> if row_score > col_score then row_guess else col_guess


(* TOPLEVEL *)

let empty_tag_set = Set.of_list (module Tag) []

let starting_board =
  [
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
    Unsolved empty_tag_set;
  ]


let starting_game = { board = starting_board; cursor = 0; num_guesses = 10 }

let rec game_loop game =
  let () = Printf.printf "Guess + results: " in
  let the_guess, rows, cols = Cli.collect_guess () in
  let advanced_state = guess game the_guess rows cols in
  let suggestion = suggest advanced_state in
  let () = Printf.printf "We suggest: %s\n" suggestion in
  game_loop advanced_state


(**
 * Runs it all
 *)
let play () =
  Printf.printf "Good luck!\n";
  game_loop starting_game
  { board = starting_board; cursor = 0; num_guesses = 10 }


A src/squardle_solver_lib/main.ml => src/squardle_solver_lib/main.ml +12 -0
@@ 0,0 1,12 @@
let rec game_loop game =
  let () = Printf.printf "Guess + results: " in
  let the_guess, rows, cols = Cli.collect_guess () in
  let advanced_state = Game.record_guess game the_guess rows cols in
  let suggestion = Suggest.suggest advanced_state in
  let () = Printf.printf "We suggest: %s\n" suggestion in
  game_loop advanced_state

(** Runs the CLI all *)
let play () =
  Printf.printf "Good luck!\n";
  game_loop Game.starting_game


A src/squardle_solver_lib/suggest.ml => src/squardle_solver_lib/suggest.ml +181 -0
@@ 0,0 1,181 @@
open Core
open Datatypes
open Datatypes.Tag

(* SUGGESTION GENERATION LOGIC *)

(* Red is an exclusion for row guesses, and yellow is an exclusion for col guesses.
 * We want `best_shot` to be pretty general, but it will need to know which one we're doing,
 * so we pass it this data type.
 *)
let tags_of = function
  | Solved (_, t) -> t
  | Unsolved t -> t


let color_match seeking presented =
  match seeking, presented.color with
  | White, White -> true
  | Black, Black -> true
  | Green, Green -> true
  | Red _, Red _ -> true
  | Orange _, Orange _ -> true
  | Yellow _, Yellow _ -> true
  | _ -> false


let tags_if_unsolved = function
  | Solved _ -> None
  | Unsolved lst -> Some lst


let is_exclusion guess_type { color; guess } =
  match guess_type, color with
  | _, Black -> Some guess
  | _, White -> Some guess
  | Col, Yellow _ -> Some guess
  | Row, Red _ -> Some guess
  | _ -> None


let get_inclusion_type = function
  | Col -> Red 1
  | Row -> Yellow 1


let tag_set_to_exclusion_string guess_type set =
  set |> Set.to_list |> List.filter_map ~f:(is_exclusion guess_type) |> Set.of_list (module String)


let generate_exclusions tiles guess_type =
  tiles
  |> List.filter_map ~f:tags_if_unsolved
  |> List.fold ~init:(Set.empty (module Tag)) ~f:(fun accum s1 -> Set.union accum s1)
  |> tag_set_to_exclusion_string guess_type


let as_exclusion_regex str =
  if String.equal str "" then
    "."
  else
    String.concat ["[^"; str; "]"]

let pattern_char_for exclusion_pattern tile =
  match tile with
  | Solved (x, _) -> x
  | Unsolved _ -> exclusion_pattern

let winnow_down_list valid_guess_list tiles guess_type global_blacks =
  let global_exclusions = tag_set_to_exclusion_string guess_type global_blacks in
  let exclusion_pattern =
    generate_exclusions tiles guess_type
    |> Set.union global_exclusions
    |> Set.to_list
    |> String.concat
    |> as_exclusion_regex
  in
  let regex_pattern = List.map tiles ~f:(pattern_char_for exclusion_pattern) |> String.concat in
  let regex = Re2.create_exn regex_pattern in
  List.filter_map valid_guess_list ~f:(fun x -> if Re2.matches regex x then Some x else None)

(* Should have made these maps lol *)
let find_tag_for_char tagset chr return_if_true =
  let filtered =
    Set.to_list tagset |> List.filter ~f:(fun { guess; _ } -> String.equal guess chr)
  in
  match filtered with
  | [] -> None
  | _ -> Some return_if_true

let score_spot ojs_reds_yellows whites (tile, guess_char) =
  match tile with
  | Solved _ -> 10
  | Unsolved tags -> (
      (* If this tiles already has a tag for guess_char, 0 points 
       * Else, if there is an oj/red/yellow, 5 points
       * Additionally, if there is a global white, 2 points
       *)
      match find_tag_for_char tags guess_char 0 with
      | Some _ -> 0
      | None ->
          let is_oj_but_not_this = find_tag_for_char ojs_reds_yellows guess_char 5 in
          let is_global_white = find_tag_for_char whites guess_char 2 in
          Option.value ~default:0 is_oj_but_not_this + Option.value ~default:0 is_global_white)

let score_guess tiles ojs_reds_yellows considered_whites guess =
  let tiles_and_chars = List.zip_exn tiles (explode_string guess) in
  let score =
    tiles_and_chars
    |> List.map ~f:(score_spot ojs_reds_yellows considered_whites)
    |> List.fold ~init:0 ~f:( + )
  in
  guess, score

let tags_of_color color lst_of_tiles =
  lst_of_tiles
  |> List.map ~f:tags_of
  |> List.fold ~init:(Set.empty (module Tag)) ~f:Base.Set.union
  |> Set.to_list
  |> List.filter ~f:(color_match color)
  |> Set.of_list (module Tag)

(**
 * We do dynamic regex construction, and really naive matching. If we had Elixir Streams, that'd
 * be pretty dope, but I trust OCaml is p fast. We'll look at the tag lists, construct regexes
 * for the following:
 *
 *  - Look at the tags and produce a list of _absolute exclusions_. These
 *    letters will not appear in our guess word at all. Examples:
 *    - Black tiles (from anywhere on the board)
 *    - White Tiles, locally (if it were in this col or row, it'd be a different color)
 *    - Yellow for column, Red for row (these would be orange if they were in this guess).
 *  - Additionally, "pin" any green tiles as fixed in the word we're looking for.
 * 
 *  This winnows down our word list pretty significantly. After this, we take
 *  the Red/Yellows/Oranges, Whites from other parts of the board, and "score" every guess:
 *
 *  - Green tiles give 10 points. Close to being solved!
 *  - Orange or red from somewhere else in the row/col. Each present one adds 5 "points."
 *  - "Global" white tiles that aren't present in this row or column at all. Adds 2 "point"
 *
 * Of all the candidates, we return the ones with the highest score. This is the one we think
 * is the closest to being solved, and contains the most data from the other "clues."
 *)
let best_shot valid_guess_list tiles guess_type global_blacks global_whites =
  let winnowed = winnow_down_list valid_guess_list tiles guess_type global_blacks in
  let local_whites = tags_of_color White tiles in
  let considered_whites = Set.diff global_whites local_whites in
  let ojs_red_yellows =
    tags_of_color (Orange (1, 1)) tiles
    |> Set.union (tags_of_color (get_inclusion_type guess_type) tiles)
  in
  let scored = List.map ~f:(score_guess tiles ojs_red_yellows considered_whites) winnowed in
  List.sort scored ~compare:(fun (_, s1) (_, s2) -> Int.compare s2 s1) |> List.hd_exn


(*
 * Toplevel guessing function. Returns a guess for the current gamestate.
 * Considers the row and column separately, and returns the one that has the
 * highest likelihood of being "solved" in this turn. This is done with a point
 * system explained above. Note that a solved row or col will consist entirely
 * of green tiles, so we hardcode against that specific case by checking for 50
 * points and _not_ taking that suggestion if possible. If both are already
 * solved and your cursor is on that pair, in theory I could write some logic
 * that maximizes for information gathering, but that's a lot of trouble to
 * consider right now.
 *)
let suggest { board; cursor; _ } =
  let global_blacks = tags_of_color Black board in
  let global_whites = tags_of_color White board in
  let row_tiles = List.map (row_offsets cursor) ~f:(List.nth_exn board) in
  let col_tiles = List.map (col_offsets cursor) ~f:(List.nth_exn board) in
  let row_guess, row_score =
    best_shot Wordlist.valid_guesses row_tiles Row global_blacks global_whites
  in
  let col_guess, col_score =
    best_shot Wordlist.valid_guesses col_tiles Col global_blacks global_whites
  in
  match phys_equal row_score 50, phys_equal col_score 50 with
  | true, _ -> col_guess
  | _, true -> row_guess
  | _ -> if row_score > col_score then row_guess else col_guess


D src/squardle_solver_lib/tag_colors.ml => src/squardle_solver_lib/tag_colors.ml +0 -8
@@ 1,8 0,0 @@
type tag_color =
  | Red of int
  | Yellow of int
  | Orange of int * int
  | White
  | Green
  | Black
[@@deriving show, eq]


A src/squardle_solver_lib/wordlist.mli => src/squardle_solver_lib/wordlist.mli +3 -0
@@ 0,0 1,3 @@
(** We hardcode these in. Making an .mli file to see if it
    helps with incremental compilation. *)
val valid_guesses: string list


M src/squardle_solver_lib_test/test_squardle.ml => src/squardle_solver_lib_test/test_squardle.ml +16 -21
@@ 1,26 1,27 @@
open Squardle_solver_lib
open Squardle_solver_lib.Datatypes

(* This took diving into the source to figure out how to do lol. *)
let testable_game = Alcotest.testable Game.pp_game Game.equal_game
let testable_game = Alcotest.testable pp_game equal_game

let testable_tag_color = Alcotest.testable Tag_colors.pp_tag_color Tag_colors.equal_tag_color
let testable_tag_color = Alcotest.testable pp_tag_color equal_tag_color

let unsolved_of lst =
  let mapped = Core.List.map lst ~f:(fun (s, c) -> Game.Tag.create s c) in
  let as_set = Base.Set.of_list (module Game.Tag) mapped in
  Game.Unsolved as_set
  let mapped = Core.List.map lst ~f:(fun (s, c) -> Tag.create s c) in
  let as_set = Base.Set.of_list (module Tag) mapped in
  Unsolved as_set


let solved_of chr lst =
  let mapped = Core.List.map lst ~f:(fun (s, c) -> Game.Tag.create s c) in
  let as_set = Base.Set.of_list (module Game.Tag) mapped in
  Game.Solved (chr, as_set)
  let mapped = Core.List.map lst ~f:(fun (s, c) -> Tag.create s c) in
  let as_set = Base.Set.of_list (module Tag) mapped in
  Solved (chr, as_set)


let empty_tiles = Base.Set.empty (module Game.Tag)
let empty_tiles = Base.Set.empty (module Tag)

let test_first_guess_on_empty () =
  let expected_game : Game.game =
  let expected_game : game =
    {
      board =
        [


@@ 51,7 52,7 @@ let test_first_guess_on_empty () =
    }
  in
  let result =
    Game.guess
    Game.record_guess
      Game.starting_game
      "crane"
      [Black; White; Red 1; Orange (1, 1); Orange (1, 1)]


@@ 62,11 63,10 @@ let test_first_guess_on_empty () =

let run_triples triples =
  Core.List.fold triples ~init:Game.starting_game ~f:(fun accum (the_guess, rows, cols) ->
      Game.guess accum the_guess rows cols)
      Game.record_guess accum the_guess rows cols)


let first_three_moves =
  let open Tag_colors in
  [
    ( "crane",
      [Black; White; Red 1; Orange (1, 1); Orange (1, 1)],


@@ 81,7 81,7 @@ let first_three_moves =


let test_three_guesses () =
  let expected_game : Game.game =
  let expected_game : game =
    {
      board =
        [


@@ 117,8 117,6 @@ let test_three_guesses () =


let test_wraparound () =
  let open Tag_colors in
  let open Game in
  let expected_game : game =
    {
      board =


@@ 162,7 160,6 @@ let test_wraparound () =


let test_best_shot_rows () =
  let open Game in
  let test_cases =
    [
      ( ["orange"; "preen"; "sheen"; "queen"; "green"],


@@ 186,12 183,11 @@ let test_best_shot_rows () =
    ]
  in
  Core.List.iter test_cases ~f:(fun (wordlist, tiles, expected) ->
      let evaluated, _ = best_shot wordlist tiles Row empty_tiles empty_tiles in
      let evaluated, _ = Suggest.best_shot wordlist tiles Row empty_tiles empty_tiles in
      Alcotest.(check string) ("Expecting " ^ expected) expected evaluated)


let test_best_shot_cols () =
  let open Game in
  let test_cases =
    [
      ( ["orange"; "preen"; "sheen"; "queen"; "green"],


@@ 215,12 211,11 @@ let test_best_shot_cols () =
    ]
  in
  Core.List.iter test_cases ~f:(fun (wordlist, tiles, expected) ->
      let evaluated, _ = best_shot wordlist tiles Col empty_tiles empty_tiles in
      let evaluated, _ = Suggest.best_shot wordlist tiles Col empty_tiles empty_tiles in
      Alcotest.(check string) ("Expecting " ^ expected) expected evaluated)


let test_guess_parse_syntax () =
  let open Tag_colors in
  let test_cases =
    [
      ( "crane b,w,r1,o11,o11 b,o11,w,w,o11",