Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,27 +0,0 @@
|
|||
generic
|
||||
Height : Positive;
|
||||
Width : Positive;
|
||||
package Mazes is
|
||||
|
||||
type Maze_Grid is private;
|
||||
|
||||
procedure Initialize (Maze : in out Maze_Grid);
|
||||
|
||||
procedure Put (Item : Maze_Grid);
|
||||
|
||||
private
|
||||
|
||||
type Directions is (North, South, West, East);
|
||||
|
||||
type Cell_Walls is array (Directions) of Boolean;
|
||||
type Cells is record
|
||||
Walls : Cell_Walls := (others => True);
|
||||
Visited : Boolean := False;
|
||||
end record;
|
||||
|
||||
subtype Height_Type is Positive range 1 .. Height;
|
||||
subtype Width_Type is Positive range 1 .. Width;
|
||||
|
||||
type Maze_Grid is array (Height_Type, Width_Type) of Cells;
|
||||
|
||||
end Mazes;
|
||||
|
|
@ -1,173 +0,0 @@
|
|||
with Ada.Numerics.Discrete_Random;
|
||||
with Ada.Text_IO;
|
||||
|
||||
package body Mazes is
|
||||
package RNG is new Ada.Numerics.Discrete_Random (Positive);
|
||||
package Random_Direction is new Ada.Numerics.Discrete_Random (Directions);
|
||||
|
||||
Generator : RNG.Generator;
|
||||
Dir_Generator : Random_Direction.Generator;
|
||||
|
||||
function "-" (Dir : Directions) return Directions is
|
||||
begin
|
||||
case Dir is
|
||||
when North =>
|
||||
return South;
|
||||
when South =>
|
||||
return North;
|
||||
when East =>
|
||||
return West;
|
||||
when West =>
|
||||
return East;
|
||||
end case;
|
||||
end "-";
|
||||
|
||||
procedure Move
|
||||
(Row : in out Height_Type;
|
||||
Column : in out Width_Type;
|
||||
Direction : Directions;
|
||||
Valid_Move : out Boolean)
|
||||
is
|
||||
begin
|
||||
Valid_Move := False;
|
||||
case Direction is
|
||||
when North =>
|
||||
if Row > Height_Type'First then
|
||||
Valid_Move := True;
|
||||
Row := Row - 1;
|
||||
end if;
|
||||
when East =>
|
||||
if Column < Width_Type'Last then
|
||||
Valid_Move := True;
|
||||
Column := Column + 1;
|
||||
end if;
|
||||
when West =>
|
||||
if Column > Width_Type'First then
|
||||
Valid_Move := True;
|
||||
Column := Column - 1;
|
||||
end if;
|
||||
when South =>
|
||||
if Row < Height_Type'Last then
|
||||
Valid_Move := True;
|
||||
Row := Row + 1;
|
||||
end if;
|
||||
end case;
|
||||
end Move;
|
||||
|
||||
procedure Depth_First_Algorithm
|
||||
(Maze : in out Maze_Grid;
|
||||
Row : Height_Type;
|
||||
Column : Width_Type)
|
||||
is
|
||||
Next_Row : Height_Type;
|
||||
Next_Column : Width_Type;
|
||||
Next_Direction : Directions;
|
||||
Valid_Direction : Boolean;
|
||||
Tested_Wall : array (Directions) of Boolean := (others => False);
|
||||
All_Tested : Boolean;
|
||||
begin
|
||||
-- mark as visited
|
||||
Maze (Row, Column).Visited := True;
|
||||
loop
|
||||
-- use random direction
|
||||
loop
|
||||
Next_Direction := Random_Direction.Random (Dir_Generator);
|
||||
exit when not Tested_Wall (Next_Direction);
|
||||
end loop;
|
||||
Next_Row := Row;
|
||||
Next_Column := Column;
|
||||
Move (Next_Row, Next_Column, Next_Direction, Valid_Direction);
|
||||
if Valid_Direction then
|
||||
if not Maze (Next_Row, Next_Column).Visited then
|
||||
-- connect the two cells
|
||||
Maze (Row, Column).Walls (Next_Direction) :=
|
||||
False;
|
||||
Maze (Next_Row, Next_Column).Walls (-Next_Direction) :=
|
||||
False;
|
||||
Depth_First_Algorithm (Maze, Next_Row, Next_Column);
|
||||
end if;
|
||||
end if;
|
||||
Tested_Wall (Next_Direction) := True;
|
||||
-- continue as long as there are unvisited neighbours left
|
||||
All_Tested := True;
|
||||
for D in Directions loop
|
||||
All_Tested := All_Tested and Tested_Wall (D);
|
||||
end loop;
|
||||
-- all directions are either visited (from here,
|
||||
-- or previously visited), or invalid.
|
||||
exit when All_Tested;
|
||||
end loop;
|
||||
end Depth_First_Algorithm;
|
||||
|
||||
procedure Initialize (Maze : in out Maze_Grid) is
|
||||
Row, Column : Positive;
|
||||
begin
|
||||
-- initialize random generators
|
||||
RNG.Reset (Generator);
|
||||
Random_Direction.Reset (Dir_Generator);
|
||||
-- choose starting cell
|
||||
Row := RNG.Random (Generator) mod Height + 1;
|
||||
Column := RNG.Random (Generator) mod Width + 1;
|
||||
Ada.Text_IO.Put_Line
|
||||
("Starting generation at " &
|
||||
Positive'Image (Row) &
|
||||
" x" &
|
||||
Positive'Image (Column));
|
||||
Depth_First_Algorithm (Maze, Row, Column);
|
||||
end Initialize;
|
||||
|
||||
procedure Put (Item : Maze_Grid) is
|
||||
begin
|
||||
for Row in Item'Range (1) loop
|
||||
if Row = Item'First (1) then
|
||||
Ada.Text_IO.Put ('+');
|
||||
for Col in Item'Range (2) loop
|
||||
if Item (Row, Col).Walls (North) then
|
||||
Ada.Text_IO.Put ("---+");
|
||||
else
|
||||
Ada.Text_IO.Put (" +");
|
||||
end if;
|
||||
end loop;
|
||||
Ada.Text_IO.New_Line;
|
||||
end if;
|
||||
for Col in Item'Range (2) loop
|
||||
if Col = Item'First (2) then
|
||||
if Item (Row, Col).Walls (West) then
|
||||
Ada.Text_IO.Put ('|');
|
||||
else
|
||||
Ada.Text_IO.Put (' ');
|
||||
end if;
|
||||
elsif Item (Row, Col).Walls (West)
|
||||
and then Item (Row, Col - 1).Walls (East)
|
||||
then
|
||||
Ada.Text_IO.Put ('|');
|
||||
elsif Item (Row, Col).Walls (West)
|
||||
or else Item (Row, Col - 1).Walls (East)
|
||||
then
|
||||
Ada.Text_IO.Put ('>');
|
||||
else
|
||||
Ada.Text_IO.Put (' ');
|
||||
end if;
|
||||
if Item (Row, Col).Visited then
|
||||
Ada.Text_IO.Put (" ");
|
||||
else
|
||||
Ada.Text_IO.Put ("???");
|
||||
end if;
|
||||
end loop;
|
||||
if Item (Row, Item'Last (2)).Walls (East) then
|
||||
Ada.Text_IO.Put_Line ("|");
|
||||
else
|
||||
Ada.Text_IO.Put_Line (" ");
|
||||
end if;
|
||||
Ada.Text_IO.Put ('+');
|
||||
for Col in Item'Range (2) loop
|
||||
if Item (Row, Col).Walls (South) then
|
||||
Ada.Text_IO.Put ("---+");
|
||||
else
|
||||
Ada.Text_IO.Put (" +");
|
||||
end if;
|
||||
end loop;
|
||||
Ada.Text_IO.New_Line;
|
||||
end loop;
|
||||
end Put;
|
||||
end Mazes;
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
with Mazes;
|
||||
procedure Main is
|
||||
package Small_Mazes is new Mazes (Height => 8, Width => 11);
|
||||
My_Maze : Small_Mazes.Maze_Grid;
|
||||
begin
|
||||
Small_Mazes.Initialize (My_Maze);
|
||||
Small_Mazes.Put (My_Maze);
|
||||
end Main;
|
||||
|
|
@ -1,56 +0,0 @@
|
|||
use Random;
|
||||
|
||||
config const rows: int = 9;
|
||||
config const cols: int = 16;
|
||||
if rows < 1 || cols < 1 {
|
||||
writeln("Maze must be at least 1x1 in size.");
|
||||
exit(1);
|
||||
}
|
||||
|
||||
enum direction {N = 1, E = 2, S = 3, W = 4};
|
||||
|
||||
record Cell {
|
||||
var spaces: [direction.N .. direction.W] bool;
|
||||
var visited: bool;
|
||||
}
|
||||
|
||||
const dirs = [
|
||||
((-1, 0), direction.N, direction.S), // ((rowDir, colDir), myWall, neighbourWall)
|
||||
((0, 1), direction.E, direction.W),
|
||||
((1, 0), direction.S, direction.N),
|
||||
((0, -1), direction.W, direction.E)
|
||||
];
|
||||
|
||||
var maze: [1..rows, 1..cols] Cell;
|
||||
var startingCell = (choose(maze.dim(0)), choose(maze.dim(1)));
|
||||
|
||||
checkCell(maze, startingCell);
|
||||
displayMaze(maze);
|
||||
|
||||
proc checkCell(ref maze, cell) {
|
||||
maze[cell].visited = true;
|
||||
for dir in permute(dirs) {
|
||||
var (offset, thisDir, neighbourDir) = dir;
|
||||
var neighbour = cell + offset;
|
||||
if maze.domain.contains(neighbour) && !maze[neighbour].visited {
|
||||
maze[cell].spaces[thisDir] = true;
|
||||
maze[neighbour].spaces[neighbourDir] = true;
|
||||
checkCell(maze, neighbour);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc displayMaze(maze) {
|
||||
for row in maze.dim(0) {
|
||||
for col in maze.dim(1) {
|
||||
write(if maze[row, col].spaces[direction.N] then "+ " else "+---");
|
||||
}
|
||||
writeln("+");
|
||||
for col in maze.dim(1) {
|
||||
write(if maze[row, col].spaces[direction.W] then " " else "| ");
|
||||
}
|
||||
writeln("|");
|
||||
}
|
||||
write("+---" * maze.dim(1).size);
|
||||
writeln("+");
|
||||
}
|
||||
|
|
@ -1,193 +0,0 @@
|
|||
(require 'cl-lib)
|
||||
|
||||
(cl-defstruct maze rows cols data)
|
||||
|
||||
(defmacro maze-pt (w r c)
|
||||
`(+ (* (mod ,r (maze-rows ,w)) (maze-cols ,w))
|
||||
(mod ,c (maze-cols ,w))))
|
||||
|
||||
(defmacro maze-ref (w r c)
|
||||
`(aref (maze-data ,w) (maze-pt ,w ,r ,c)))
|
||||
|
||||
(defun new-maze (rows cols)
|
||||
(setq rows (1+ rows)
|
||||
cols (1+ cols))
|
||||
(let ((m (make-maze :rows rows :cols cols :data (make-vector (* rows cols) nil))))
|
||||
|
||||
(dotimes (r rows)
|
||||
(dotimes (c cols)
|
||||
(setf (maze-ref m r c) (copy-sequence '(wall ceiling)))))
|
||||
|
||||
(dotimes (r rows)
|
||||
(maze-set m r (1- cols) 'visited))
|
||||
|
||||
(dotimes (c cols)
|
||||
(maze-set m (1- rows) c 'visited))
|
||||
|
||||
(maze-unset m 0 0 'ceiling) ;; Maze Entrance
|
||||
(maze-unset m (1- rows) (- cols 2) 'ceiling) ;; Maze Exit
|
||||
|
||||
m))
|
||||
|
||||
(defun maze-is-set (maze r c v)
|
||||
(member v (maze-ref maze r c)))
|
||||
|
||||
(defun maze-set (maze r c v)
|
||||
(let ((cell (maze-ref maze r c)))
|
||||
(when (not (member v cell))
|
||||
(setf (maze-ref maze r c) (cons v cell)))))
|
||||
|
||||
(defun maze-unset (maze r c v)
|
||||
(setf (maze-ref maze r c) (delete v (maze-ref maze r c))))
|
||||
|
||||
(defun print-maze (maze &optional marks)
|
||||
(dotimes (r (1- (maze-rows maze)))
|
||||
|
||||
(dotimes (c (1- (maze-cols maze)))
|
||||
(princ (if (maze-is-set maze r c 'ceiling) "+---" "+ ")))
|
||||
(princ "+")
|
||||
(terpri)
|
||||
|
||||
(dotimes (c (1- (maze-cols maze)))
|
||||
(princ (if (maze-is-set maze r c 'wall) "|" " "))
|
||||
(princ (if (member (cons r c) marks) " * " " ")))
|
||||
(princ "|")
|
||||
(terpri))
|
||||
|
||||
(dotimes (c (1- (maze-cols maze)))
|
||||
(princ (if (maze-is-set maze (1- (maze-rows maze)) c 'ceiling) "+---" "+ ")))
|
||||
(princ "+")
|
||||
(terpri))
|
||||
|
||||
(defun shuffle (lst)
|
||||
(sort lst (lambda (a b) (= 1 (random 2)))))
|
||||
|
||||
(defun to-visit (maze row col)
|
||||
(let (unvisited)
|
||||
(dolist (p '((0 . +1) (0 . -1) (+1 . 0) (-1 . 0)))
|
||||
(let ((r (+ row (car p)))
|
||||
(c (+ col (cdr p))))
|
||||
(unless (maze-is-set maze r c 'visited)
|
||||
(push (cons r c) unvisited))))
|
||||
unvisited))
|
||||
|
||||
(defun make-passage (maze r1 c1 r2 c2)
|
||||
(if (= r1 r2)
|
||||
(if (< c1 c2)
|
||||
(maze-unset maze r2 c2 'wall) ; right
|
||||
(maze-unset maze r1 c1 'wall)) ; left
|
||||
(if (< r1 r2)
|
||||
(maze-unset maze r2 c2 'ceiling) ; up
|
||||
(maze-unset maze r1 c1 'ceiling)))) ; down
|
||||
|
||||
(defun dig-maze (maze row col)
|
||||
(let (backup
|
||||
(run 0))
|
||||
(maze-set maze row col 'visited)
|
||||
(push (cons row col) backup)
|
||||
(while backup
|
||||
(setq run (1+ run))
|
||||
(when (> run (/ (+ row col) 3))
|
||||
(setq run 0)
|
||||
(setq backup (shuffle backup)))
|
||||
(setq row (caar backup)
|
||||
col (cdar backup))
|
||||
(let ((p (shuffle (to-visit maze row col))))
|
||||
(if p
|
||||
(let ((r (caar p))
|
||||
(c (cdar p)))
|
||||
(make-passage maze row col r c)
|
||||
(maze-set maze r c 'visited)
|
||||
(push (cons r c) backup))
|
||||
(pop backup)
|
||||
(setq backup (shuffle backup))
|
||||
(setq run 0))))))
|
||||
|
||||
(defun generate (rows cols)
|
||||
(let* ((m (new-maze rows cols)))
|
||||
(dig-maze m (random rows) (random cols))
|
||||
(print-maze m)))
|
||||
|
||||
(defun parse-ceilings (line)
|
||||
(let (rtn
|
||||
(i 1))
|
||||
(while (< i (length line))
|
||||
(push (eq ?- (elt line i)) rtn)
|
||||
(setq i (+ i 4)))
|
||||
(nreverse rtn)))
|
||||
|
||||
(defun parse-walls (line)
|
||||
(let (rtn
|
||||
(i 0))
|
||||
(while (< i (length line))
|
||||
(push (eq ?| (elt line i)) rtn)
|
||||
(setq i (+ i 4)))
|
||||
(nreverse rtn)))
|
||||
|
||||
(defun parse-maze (file-name)
|
||||
(let ((rtn)
|
||||
(lines (with-temp-buffer
|
||||
(insert-file-contents-literally file-name)
|
||||
(split-string (buffer-string) "\n" t))))
|
||||
(while lines
|
||||
(push (parse-ceilings (pop lines)) rtn)
|
||||
(push (parse-walls (pop lines)) rtn))
|
||||
(nreverse rtn)))
|
||||
|
||||
(defun read-maze (file-name)
|
||||
(let* ((raw (parse-maze file-name))
|
||||
(rows (1- (/ (length raw) 2)))
|
||||
(cols (length (car raw)))
|
||||
(maze (new-maze rows cols)))
|
||||
(dotimes (r rows)
|
||||
(let ((ceilings (pop raw)))
|
||||
(dotimes (c cols)
|
||||
(unless (pop ceilings)
|
||||
(maze-unset maze r c 'ceiling))))
|
||||
(let ((walls (pop raw)))
|
||||
(dotimes (c cols)
|
||||
(unless (pop walls)
|
||||
(maze-unset maze r c 'wall)))))
|
||||
maze))
|
||||
|
||||
(defun find-exits (maze row col)
|
||||
(let (exits)
|
||||
(dolist (p '((0 . +1) (0 . -1) (-1 . 0) (+1 . 0)))
|
||||
(let ((r (+ row (car p)))
|
||||
(c (+ col (cdr p))))
|
||||
(unless
|
||||
(cond
|
||||
((equal p '(0 . +1)) (maze-is-set maze r c 'wall))
|
||||
((equal p '(0 . -1)) (maze-is-set maze row col 'wall))
|
||||
((equal p '(+1 . 0)) (maze-is-set maze r c 'ceiling))
|
||||
((equal p '(-1 . 0)) (maze-is-set maze row col 'ceiling)))
|
||||
(push (cons r c) exits))))
|
||||
exits))
|
||||
|
||||
(defun drop-visited (maze points)
|
||||
(let (not-visited)
|
||||
(while points
|
||||
(unless (maze-is-set maze (caar points) (cdar points) 'visited)
|
||||
(push (car points) not-visited))
|
||||
(pop points))
|
||||
not-visited))
|
||||
|
||||
(defun solve-maze (maze)
|
||||
(let (solution
|
||||
(exit (cons (- (maze-rows maze) 2) (- (maze-cols maze) 2)))
|
||||
(pt (cons 0 0)))
|
||||
(while (not (equal pt exit))
|
||||
(maze-set maze (car pt) (cdr pt) 'visited)
|
||||
(let ((exits (drop-visited maze (find-exits maze (car pt) (cdr pt)))))
|
||||
(if (null exits)
|
||||
(setq pt (pop solution))
|
||||
(push pt solution)
|
||||
(setq pt (pop exits)))))
|
||||
(push pt solution)))
|
||||
|
||||
(defun solve (file-name)
|
||||
(let* ((maze (read-maze file-name))
|
||||
(solution (solve-maze maze)))
|
||||
(print-maze maze solution)))
|
||||
|
||||
(generate 20 20)
|
||||
|
|
@ -1,33 +1,29 @@
|
|||
# Build and solve a maze.
|
||||
# Experimental!
|
||||
W ← 10
|
||||
H ← 6
|
||||
W ← 16
|
||||
H ← 8
|
||||
|
||||
GetWall ← -:⊡1:÷2/-.
|
||||
GetWall ← -⊃⋅∘∘⊡1⊃⋅∘∘÷2⊸/-
|
||||
# ([here, next], maze) -> (maze')
|
||||
BreakWall ← ⍜(⊡|⋅@ )GetWall
|
||||
|
||||
Nfour ← +⊙¤[¯2_0 2_0 0_2 0_¯2] # Gives N4
|
||||
Shuffle ← ⊏⍏[⍥⚂]⧻.
|
||||
# (pos maze) -> T if it's already a star.
|
||||
IsVisited ← ≠@.⊡
|
||||
MarkAsVisited ← ⟜(⍜⊡⋅@.)
|
||||
# (pos) -> (bool)
|
||||
InBounds ← ▽⊸≡(↧⊃(/↧≥1_1|/↧< +1 × 2 H_W))
|
||||
N₄ ← +⊙¤[¯2_0 2_0 0_2 0_¯2]
|
||||
Shuffle ← ⊏⍏⍥⚂⊸⧻
|
||||
# (pos maze) -> T if it's already seen (or out of bounds).
|
||||
IsVisited ← ≠@\s⬚@\s⊡
|
||||
MarkAsVisited ← ⟜(⍜⊡⋅@\s)
|
||||
# (here, maze) -> (maze')
|
||||
Walk ← |2 (
|
||||
MarkAsVisited
|
||||
# (here, maze) -> ([[here, next] x(up to)4], maze)
|
||||
≡⊟¤⟜(Shuffle InBounds Nfour)
|
||||
|
||||
≡⊟¤⟜(Shuffle N₄)
|
||||
# Update maze for each in turn. For each, if it
|
||||
# still isn't visited, break the wall, recurse into it.
|
||||
∧(⨬(◌|Walk⊡1⟜BreakWall)IsVisited◌°⊟,,)
|
||||
∧(⨬(◌|Walk⊡1⟜BreakWall)IsVisited◌°⊟⊃⊙∘⊙∘)
|
||||
)
|
||||
|
||||
# Generate a maze.
|
||||
Maze ← (
|
||||
↘¯1☇1↯(+1H)⊟⊂/⊂↯W"+-" @+⊂/⊂↯W"| " @| # Build a filled maze.
|
||||
Walk 1_1 # Walk around breaking walls.
|
||||
↘¯1♭₂↯(+1H)⊟⊂/⊂↯W"+-" @+⊂/⊂↯W"|." @| # Build a filled maze.
|
||||
Walk 1_1 # Walk around eating dots and breaking walls.
|
||||
)
|
||||
Maze
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue