Data update

This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions

View file

@ -1,192 +0,0 @@
with Ada.Text_IO;
procedure Puzzle_15 is
type Direction is (Up, Down, Left, Right);
type Row_Type is range 0 .. 3;
type Col_Type is range 0 .. 3;
type Tile_Type is range 0 .. 15;
To_Col : constant array (Tile_Type) of Col_Type :=
(3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2);
To_Row : constant array (Tile_Type) of Row_Type :=
(3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3);
type Board_Type is array (Row_Type, Col_Type) of Tile_Type;
Solved_Board : constant Board_Type :=
((1, 2, 3, 4),
(5, 6, 7, 8),
(9, 10, 11, 12),
(13, 14, 15, 0));
type Try_Type is
record
Board : Board_Type;
Move : Direction;
Cost : Integer;
Row : Row_Type;
Col : Col_Type;
end record;
Stack : array (0 .. 100) of Try_Type;
Top : Natural := 0;
Iteration_Count : Natural := 0;
procedure Move_Down is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row + 1, Col);
Penalty : constant Integer :=
(if To_Row (Tile) <= Row then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row + 1, Col) := 0;
Stack (Top + 1) := (Board => Board,
Move => Down,
Row => Row + 1,
Col => Col,
Cost => Stack (Top).Cost + Penalty);
end Move_Down;
procedure Move_Up is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row - 1, Col);
Penalty : constant Integer :=
(if To_Row (Tile) >= Row then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row - 1, Col) := 0;
Stack (Top + 1) := (Board => Board,
Move => Up,
Row => Row - 1,
Col => Col,
Cost => Stack (Top).Cost + Penalty);
end Move_Up;
procedure Move_Left is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row, Col - 1);
Penalty : constant Integer :=
(if To_Col (Tile) >= Col then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row, Col - 1) := 0;
Stack (Top + 1) := (Board => Board,
Move => Left,
Row => Row,
Col => Col - 1,
Cost => Stack (Top).Cost + Penalty);
end Move_Left;
procedure Move_Right is
Board : Board_Type := Stack (Top).Board;
Row : constant Row_Type := Stack (Top).Row;
Col : constant Col_Type := Stack (Top).Col;
Tile : constant Tile_Type := Board (Row, Col + 1);
Penalty : constant Integer :=
(if To_Col (Tile) <= Col then 0 else 1);
begin
Board (Row, Col) := Tile;
Board (Row, Col + 1) := 0;
Stack (Top + 1) := (Board => Board,
Move => Right,
Row => Row,
Col => Col + 1,
Cost => Stack (Top).Cost + Penalty);
end Move_Right;
function Is_Solution return Boolean;
function Test_Moves return Boolean is
begin
if
Stack (Top).Move /= Down and then
Stack (Top).Row /= Row_Type'First
then
Move_Up;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
if
Stack (Top).Move /= Up and then
Stack (Top).Row /= Row_Type'Last
then
Move_Down;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
if
Stack (Top).Move /= Right and then
Stack (Top).Col /= Col_Type'First
then
Move_Left;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
if
Stack (Top).Move /= Left and then
Stack (Top).Col /= Col_Type'Last
then
Move_Right;
Top := Top + 1;
if Is_Solution then return True; end if;
Top := Top - 1;
end if;
return False;
end Test_Moves;
function Is_Solution return Boolean is
use Ada.Text_IO;
begin
if Stack (Top).Board = Solved_Board then
Put ("Solved in " & Top'Image & " moves: ");
for R in 1 .. Top loop
Put (String'(Stack (R).Move'Image) (1));
end loop;
New_Line;
return True;
end if;
if Stack (Top).Cost <= Iteration_Count then
return Test_Moves;
end if;
return False;
end Is_Solution;
procedure Solve (Row : in Row_Type;
Col : in Col_Type;
Board : in Board_Type) is
begin
pragma Assert (Board (Row, Col) = 0);
Top := 0;
Iteration_Count := 0;
Stack (Top) := (Board => Board,
Row => Row,
Col => Col,
Move => Down,
Cost => 0);
while not Is_Solution loop
Iteration_Count := Iteration_Count + 1;
end loop;
end Solve;
begin
Solve (Row => 2,
Col => 0,
Board => ((15, 14, 1, 6),
(9, 11, 4, 12),
(0, 10, 7, 3),
(13, 8, 5, 2)));
end Puzzle_15;

View file

@ -1,41 +1,31 @@
# Solve a 15 puzzle https://rosettacode.org/wiki/15_puzzle_solver#Uiua
# Experimental!
T ← ↯4_4 ↻1⇡16
# Return shuffled copy of the input.
Shuffle ← ⊏⊸(⍏[⍥⚂]⧻)
# Positions of the numbers (not 0)
Pos ← ≡(⊢⊚⌕)↘1⇡16¤
T ← ↯4_4 ↻1⇡16
Pos ← ≡(⊢⊚⌕)↘1⇡16¤ # Positions of the numbers (not 0)
# Applying a very gentle weighting to certain cells massively
# speeds up the algorithm
Weights ← [[2 1 1 2] [2 1 1 2] [2 1 1 2] [2 1 1 1]]
Distance ← /+×⊡:Weights:≡/+⌵-⊙.∩Pos
Weights ← [[2 1 1 2] [2 1 1 2] [2 1 1 2] [2 1 1 1]]
Distance ← /+×⊡: Weights :≡/+⌵-⊙.∩Pos
Heuristic ← Distance T
# Four possible neighbours
Nfour ← [[1 0] [¯1 0] [0 1] [0 ¯1]]
# Actual neighbours at a point.
ValidN ← ≡(⊂)⊙¤:⟜(▽⊸(≥0≡/↧)▽⊸(<4≡/↥)+Nfour)¤
# Precalculate them.
ValidNs ← ⊞(□ ValidN⊟)⇡4 ⇡4
# Get the valid (from to) moves from this cell.
Moves ← °□⊡:ValidNs⊢⊚⌕0
# Swap the values at the indexes [0 1] [a b 2 3] -> [b a 2 3]
Swap ← ⍜(⊡|∘◌) ⊃(⇌⊙∘|⊡)
# List the possible next positions for a position
Next ← ⊙◌≡(Swap ⊙.)⊙¤⊸Moves
ValidN ← ≡⊟⊙¤▽≡/↧×⊃(≡₀<4|≡₀≥0).+Nfour¤. # Actual neighbours at a point.
ValidNs ← ⊞(□ValidN⊟).⇡4 # Precalculate them.
Moves ← °□⊡:ValidNs⊢⊚⌕0 # Get valid (from to) moves from grid.
Swap ← ⍜⊡⇌ # Swap the values at the indexes
Next ← ⊸≡⋅1 ≡Swap⊙¤⊸Moves # Next positions, set costs=1
Solve ← (
&p"Running..."&p.
⍜nowastar(Next|Heuristic|≍T)
&p$"Solving: _".
⍜now (⊢path(Next|≍|Heuristic):T)
&p$"_ seconds"
# Track the movement of the 0 between adjacent steps.
≡(/-)◫2◇≡(⊢⊚⌕0)⇌⊢
# Map each to a direction string and join.
/⊂⇌≡⍣("d" °¯1_0|"u" °1_0|"r" °0_¯1|"l" °0_1|∘)
≡/-⧈∘2◇≡(⊢⊚⌕0)⇌⊢ # Track the movement of the 0
˜≡get¤mapNfour"udlr" # Map to directions
)
# Uncomment one of the following lines to try random grids
# Uncomment one of the following lines to try these grids
# ⍥(Swap⊡⊸(⌊×⚂⧻)⊸Moves)90 T
# [[2 14 6 4] [5 1 3 8] [9 10 7 11] [13 0 15 12]] # Simple 40 shuffles
# [[5 1 2 3] [6 10 7 4] [13 9 11 8] [14 0 15 12]] # Simple 12 steps