Word search: Difference between revisions
→{{header|11l}}
m (→{{header|Wren}}: Minor tidy) |
|||
Line 225:
ode (7,4)(9,4) fan (9,7)(7,5)
ala (5,2)(3,0) wok (8,0)(8,2)
</pre>
=={{header|Ada}}==
(Rows start at one, because that's how humans - and Ada programmers - count!)
<syntaxhighlight lang="ada">
pragma Ada_2022;
with Ada.Containers; use Ada.Containers;
with Ada.Containers.Vectors;
with Ada.Numerics.Discrete_Random;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
procedure Word_Search is
MIN_WORDS : constant Positive := 25;
MIN_WORD_LEN : constant Positive := 3;
MAX_WORD_LEN : constant Positive := 9;
SIDE_LEN : constant Positive := 10;
MESSAGE : constant String := "ROSETTACODE";
DICT_FILENAME : constant String := "unixdict.txt";
type Directions is (N, NE, E, SE, S, SW, W, NW);
type Move is record
DX, DY : Integer;
end record;
type Moves_Arr is array (Directions) of Move;
Moves : constant Moves_Arr := [
N => (0, -1), NE => (1, -1), E => (1, 0), SE => (1, 1),
S => (0, 1), SW => (-1, 1), W => (-1, 0), NW => (-1, -1)
];
subtype Grid_Dimension is Positive range 1 .. SIDE_LEN;
type Matrix is array (Grid_Dimension, Grid_Dimension) of Character;
subtype LC_Chars is Character range 'a' .. 'z';
subtype Valid_Lengths is Positive range MIN_WORD_LEN .. MAX_WORD_LEN;
package Word_Vectors is new Ada.Containers.Vectors (Positive, Unbounded_String);
type Dictionary is array (Valid_Lengths) of Word_Vectors.Vector;
Dict : Dictionary;
type Placement is record
Word : Unbounded_String;
Start : Unbounded_String;
end record;
package Placement_Vectors is new Ada.Containers.Vectors (Positive, Placement);
Placings : Placement_Vectors.Vector;
subtype Ten_K is Positive range 1 .. 10000;
package Rand_Dimension is new Ada.Numerics.Discrete_Random (Grid_Dimension);
package Rand_Dir is new Ada.Numerics.Discrete_Random (Directions);
package Rand_Len is new Ada.Numerics.Discrete_Random (Valid_Lengths);
package Rand_10k is new Ada.Numerics.Discrete_Random (Ten_K);
Dimension_Gen : Rand_Dimension.Generator;
Dir_Gen : Rand_Dir.Generator;
Len_Gen : Rand_Len.Generator;
Ten_K_Gen : Rand_10k.Generator;
procedure Load_Dictionary (Filename : String) is
Dict_File : File_Type;
Dict_Word : Unbounded_String;
Dict_Word_Len : Positive;
Word_OK : Boolean;
begin
Open (File => Dict_File, Mode => In_File, Name => Filename);
while not End_Of_File (Dict_File) loop
Dict_Word := Get_Line (Dict_File);
Dict_Word_Len := Length (Dict_Word);
if Dict_Word_Len >= MIN_WORD_LEN and then
Dict_Word_Len <= MAX_WORD_LEN
then
Word_OK := True;
for C of To_String (Dict_Word) loop
if C not in LC_Chars then
Word_OK := False;
exit;
end if;
end loop;
if Word_OK then
Dict (Dict_Word_Len).Append (Dict_Word);
end if;
end if;
end loop;
end Load_Dictionary;
function Pick_Random_Word return Unbounded_String is
Word_Length : Positive := Rand_Len.Random (Len_Gen);
Rand : constant Natural := Rand_10k.Random (Ten_K_Gen);
Word_Ix : Positive;
begin
Word_Length := Rand_Len.Random (Len_Gen);
if Word_Length > 4 then -- Reduce number of words > 4 chars
Word_Length := Rand_Len.Random (Len_Gen);
end if;
Word_Ix := Positive (Rand) mod (Positive (Dict (Word_Length).Length) - 1) + 1;
return Dict (Word_Length) (Word_Ix);
end Pick_Random_Word;
function Not_Too_Long (X, Y : Grid_Dimension; Len : Positive; Dir : Directions) return Boolean is
begin
case Dir is
when N => return Y - Len > 0;
when S => return Y + Len <= SIDE_LEN;
when E => return X + Len <= SIDE_LEN;
when W => return X - Len > 0;
when NE => return X + Len <= SIDE_LEN and then Y - Len > 0;
when SW => return Y + Len <= SIDE_LEN and then X - Len > 0;
when SE => return Y + Len <= SIDE_LEN and then X + Len <= SIDE_LEN;
when NW => return Y - Len > 0 and then X - Len > 0;
end case;
end Not_Too_Long;
function Is_Empty (G : Matrix; Row, Col : Positive) return Boolean is
(G (Row, Col) = ' ');
function Count_Empties (G : Matrix) return Natural is
Count : Natural := 0;
begin
for Row in Grid_Dimension loop
for Col in Grid_Dimension loop
Count := Count + (if Is_Empty (G, Row, Col) then 1 else 0);
end loop;
end loop;
return Count;
end Count_Empties;
function Can_Place (G : Matrix; X, Y : Grid_Dimension; Word : Unbounded_String; Dir : Directions)
return Boolean is
GX : Grid_Dimension := X;
GY : Grid_Dimension := Y;
Len : constant Positive := Length (Word);
begin
for C in 1 .. Len loop
if not Is_Empty (G, GX, GY) and then
G (GX, GY) /= Element (Word, C)
then
return False;
else
GX := GX + Moves (Dir).DX;
GY := GY + Moves (Dir).DY;
end if;
end loop;
return True;
end Can_Place;
procedure Insert_Word (G : in out Matrix;
X, Y : Grid_Dimension;
Dir : Directions;
Word : Unbounded_String) is
-- We assume it fits. You've checked first haven't you!
GX : Grid_Dimension := X;
GY : Grid_Dimension := Y;
begin
for C in 1 .. Length (Word) loop
G (GX, GY) := Element (Word, C);
GX := GX + Moves (Dir).DX;
GY := GY + Moves (Dir).DY;
end loop;
end Insert_Word;
function Try_To_Place_Word (G : in out Matrix; Word : Unbounded_String; Max_Tries : Positive)
return Boolean is
-- Attempt to place the given word in the grid, return success or failure.
X1, Y1 : Grid_Dimension;
Dir : Directions;
Try : Positive := 1;
Place : Placement;
begin
while Try <= Max_Tries loop
X1 := Rand_Dimension.Random (Dimension_Gen);
Y1 := Rand_Dimension.Random (Dimension_Gen);
Dir := Rand_Dir.Random (Dir_Gen);
if Not_Too_Long (X1, Y1, Length (Word), Dir) and then
Can_Place (G, X1, Y1, Word, Dir)
then
Insert_Word (G, X1, Y1, Dir, Word);
Place.Word := Word;
Place.Start := To_Unbounded_String (X1'Image & LC_Chars'Val (Integer (Y1) + 64));
Placings.Append (Place);
return True;
end if;
Try := Try + 1;
end loop;
return False;
end Try_To_Place_Word;
procedure Print_Matrix (M : Matrix) is
begin
Put_Line (" A B C D E F G H I J"); New_Line;
for Row in Grid_Dimension loop
Put (Row'Image);
Set_Col (6);
for Col in Grid_Dimension loop
Put (M (Row, Col) & " ");
end loop;
New_Line;
end loop;
New_Line;
end Print_Matrix;
function Place_Message (G : in out Matrix; Msg : String) return Boolean is
-- Attempt to put message in grid, return False if unable.
Msg_Posn : Positive := 1;
begin
for Row in Grid_Dimension loop
for Col in Grid_Dimension loop
if Is_Empty (G, Row, Col) then
G (Row, Col) := Msg (Msg_Posn);
if Msg_Posn = Msg'Length then
return True;
else
Msg_Posn := Msg_Posn + 1;
end if;
end if;
end loop;
end loop;
return False;
end Place_Message;
Grid : Matrix;
Words_Placed : Natural;
Message_Placed : Boolean;
A_Word : Unbounded_String;
Attempt : Positive;
Col : Positive_Count := 1;
begin
Load_Dictionary (DICT_FILENAME);
Rand_Dimension.Reset (Dimension_Gen);
Rand_Dir.Reset (Dir_Gen);
Rand_Len.Reset (Len_Gen);
Rand_10k.Reset (Ten_K_Gen);
loop
Grid := [others => [others => ' ']];
Words_Placed := 0; Message_Placed := False; Placings.Clear;
Attempt := 1;
Builder :
loop
A_Word := Pick_Random_Word;
if Try_To_Place_Word (Grid, A_Word, 50) then
Words_Placed := @ + 1;
end if;
if Count_Empties (Grid) = MESSAGE'Length then
if Place_Message (Grid, MESSAGE) then
Message_Placed := True;
exit Builder;
end if;
elsif Count_Empties (Grid) < MESSAGE'Length then
-- Put_Line ("No room for message, giving up.");
exit Builder;
elsif Attempt > 1000 then
Put_Line ("Giving up after 1000 tries.");
exit Builder;
end if;
Attempt := Attempt + 1;
end loop Builder;
exit when Words_Placed >= MIN_WORDS and then Message_Placed;
end loop;
Print_Matrix (Grid);
Put_Line ("Words placed:" & Words_Placed'Image);
for P of Placings loop
Set_Col (Col); Put (P.Word);
Set_Col (Col + 9); Put (P.Start);
Col := (if Col < 61 then Col + 20 else 1);
end loop;
end Word_Search;
</syntaxhighlight>
{{out}}
<pre>
A B C D E F G H I J
1 h m s i o r e h R v
2 a p n l a i c i a a
3 l u o s i O S n f t
4 i b t i f m f l a c
5 b f e o m E a y T c
6 u f l u c k n e n o
7 t u e x e n f r o t
8 T m k d i w i r v t
9 A C s f e f e d o n
10 O m p p o n e p D E
Words placed: 26
pew 10H heroism 1H skeleton 9C muff 8B
flake 3I one 10E novo 6I cia 2G
halibut 1A toe 8J slim 1C sioux 3D
can 5J finny 9D fir 9F cot 5J
cia 2G ppm 10D calf 4J pub 2B
fmc 4E vat 1J node 9J ned 10F
sou 3D fro 7G
</pre>
| |||