1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
open Core
open Placed_tile
type t = {
word : string;
positions : Placed_tile.position list;
direction : Board.direction;
tiles : Placed_tile.t list;
is_main_word : bool;
}
let are_tiles_in_line placed =
match placed with
| [] | _ :: [] -> true
| first :: rest ->
let same_row =
List.for_all rest ~f:(fun pt -> pt.pos.row = first.pos.row)
in
let same_col =
List.for_all rest ~f:(fun pt -> pt.pos.col = first.pos.col)
in
same_row || same_col
let are_tiles_contiguous board placed =
match placed with
| [] -> true
| first :: _ ->
let temp_board =
List.fold placed ~init:board ~f:(fun b { tile; pos } ->
Board.place_tile_on_board b pos tile)
in
let same_row =
List.for_all placed ~f:(fun pt -> pt.pos.row = first.pos.row)
in
let same_col =
List.for_all placed ~f:(fun pt -> pt.pos.col = first.pos.col)
in
if not (same_row || same_col) then false
else if same_row then
let row = first.pos.row in
let min_col =
List.fold placed ~init:Int.max_value ~f:(fun acc pt ->
Int.min acc pt.pos.col)
in
let max_col =
List.fold placed ~init:Int.min_value ~f:(fun acc pt ->
Int.max acc pt.pos.col)
in
let rec loop col =
if col > max_col then true
else
match Board.get_tile_at temp_board { row; col } with
| Some _ -> loop (col + 1)
| None -> false
in
loop min_col
else
let col = first.pos.col in
let min_row =
List.fold placed ~init:Int.max_value ~f:(fun acc pt ->
Int.min acc pt.pos.row)
in
let max_row =
List.fold placed ~init:Int.min_value ~f:(fun acc pt ->
Int.max acc pt.pos.row)
in
let rec loop row =
if row > max_row then true
else
match Board.get_tile_at temp_board { row; col } with
| Some _ -> loop (row + 1)
| None -> false
in
loop min_row
let determine_direction placed : Board.direction =
match placed with
| [] -> Horizontal
| first :: rest ->
let same_row =
List.for_all rest ~f:(fun pt -> pt.pos.row = first.pos.row)
in
if same_row then Horizontal else Vertical
let step = function Board.Horizontal -> (0, 1) | Board.Vertical -> (1, 0)
let perpendicular = function
| Board.Horizontal -> Board.Vertical
| Board.Vertical -> Board.Horizontal
let move pos (dr, dc) = { row = pos.row + dr; col = pos.col + dc }
let collect_word board pos direction =
let delta = step direction in
let rec find_start p =
let prev = move p (-fst delta, -snd delta) in
if Board.is_valid_position prev then
match Board.get_tile_at board prev with
| Some _ -> find_start prev
| None -> p
else p
in
let start = find_start pos in
let rec forward p acc =
if not (Board.is_valid_position p) then List.rev acc
else
match Board.get_tile_at board p with
| None -> List.rev acc
| Some tile -> forward (move p delta) ({ tile; pos = p } :: acc)
in
let tiles = forward start [] in
let word =
tiles
|> List.map ~f:(fun { tile; _ } -> tile |> Tile.get_letter |> String.make 1)
|> String.concat ~sep:""
in
(word, tiles)
let extract_words board placed =
if List.is_empty placed then []
else
let direction = determine_direction placed in
let combined =
List.fold placed ~init:board ~f:(fun b { tile; pos } ->
Board.place_tile_on_board b pos tile)
in
let main_pos = (List.hd_exn placed).pos in
let main_word, main_tiles = collect_word combined main_pos direction in
let main_positions = List.map main_tiles ~f:(fun pt -> pt.pos) in
let main =
{
word = main_word;
positions = main_positions;
direction;
tiles = main_tiles;
is_main_word = true;
}
in
let cross_direction = perpendicular direction in
let crosses =
placed
|> List.filter_map ~f:(fun { pos; _ } ->
let w, tiles = collect_word combined pos cross_direction in
if String.length w > 1 then
Some
{
word = w;
positions = List.map tiles ~f:(fun pt -> pt.pos);
direction = cross_direction;
tiles;
is_main_word = false;
}
else None)
in
(* Avoid duplicates when placed tiles are isolated but build same cross *)
let seen = Hashtbl.create (module String) ~size:8 in
let uniq words =
List.filter words ~f:(fun w ->
if Hashtbl.mem seen w.word then false
else (
Hashtbl.set seen ~key:w.word ~data:();
true))
in
uniq (main :: crosses)