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,73 +0,0 @@
|
|||
with Ada.Text_IO;
|
||||
|
||||
procedure Maze_Solver is
|
||||
|
||||
X_Size: constant Natural := 45;
|
||||
Y_Size: constant Natural := 17;
|
||||
|
||||
subtype X_Range is Natural range 1 .. X_Size;
|
||||
subtype Y_Range is Natural range 1 .. Y_Size;
|
||||
|
||||
East: constant X_Range := 2;
|
||||
South: constant Y_Range := 1;
|
||||
|
||||
X_Start: constant X_Range := 3; -- start at the upper left
|
||||
Y_Start: constant Y_Range := 1;
|
||||
X_Finish: constant X_Range := X_Size-East; -- go to the lower right
|
||||
Y_Finish: constant Y_Range := Y_Size;
|
||||
|
||||
type Maze_Type is array (Y_Range) of String(X_Range);
|
||||
|
||||
function Solved(X: X_Range; Y: Y_Range) return Boolean is
|
||||
begin
|
||||
return (X = X_Finish) and (Y = Y_Finish);
|
||||
end Solved;
|
||||
|
||||
procedure Output_Maze(M: Maze_Type; Message: String := "") is
|
||||
begin
|
||||
if Message /= "" then
|
||||
Ada.Text_IO.Put_Line(Message);
|
||||
end if;
|
||||
for I in M'Range loop
|
||||
Ada.Text_IO.Put_Line(M(I));
|
||||
end loop;
|
||||
end Output_Maze;
|
||||
|
||||
procedure Search(M: in out Maze_Type; X: X_Range; Y:Y_Range) is
|
||||
begin
|
||||
M(Y)(X) := '*';
|
||||
if Solved(X, Y) then
|
||||
Output_Maze(M, "Solution found!");
|
||||
else
|
||||
if Integer(Y)-South >= 1 and then M(Y-South)(X) = ' ' then
|
||||
Search(M, X, Y-South);
|
||||
end if;
|
||||
if Integer(Y)+South <= Y_Size and then M(Y+South)(X) = ' ' then
|
||||
Search(M, X, Y+South);
|
||||
end if;
|
||||
if Integer(X)-East >= 1 and then M(Y)(X-East) = ' ' then
|
||||
Search(M, X-East, Y);
|
||||
end if;
|
||||
if Integer(Y)+East <= Y_Size and then M(Y)(X+East) = ' ' then
|
||||
Search(M, X+East, Y);
|
||||
end if;
|
||||
end if;
|
||||
M(Y)(X) := ' ';
|
||||
end Search;
|
||||
|
||||
Maze: Maze_Type;
|
||||
X: X_Range := X_Start;
|
||||
Y: Y_Range := Y_Start;
|
||||
|
||||
begin
|
||||
for I in 1 .. Y_Size loop
|
||||
Maze(I) := Ada.Text_IO.Get_Line;
|
||||
end loop;
|
||||
Maze(Y_Start)(X_Start) := ' '; -- Start from
|
||||
Maze(Y_Finish)(X_Finish) := ' '; -- Go_To
|
||||
Output_Maze(Maze, "The Maze:");
|
||||
Ada.Text_IO.New_Line;
|
||||
|
||||
Search(Maze, X, Y) ; -- Will output *all* Solutions.
|
||||
-- If there is no output, there is no solution.
|
||||
end Maze_Solver;
|
||||
|
|
@ -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)))
|
||||
|
||||
(solve "maze.txt")
|
||||
|
|
@ -1,26 +1,8 @@
|
|||
# You can delete from here to SOLVE THE MAZE
|
||||
# if you're appending this to the maze generator code.
|
||||
# Experimental!
|
||||
["+-+-+-+-+-+-+"
|
||||
"|. . .|. . .|"
|
||||
"+-+-+ + + + +"
|
||||
"|.|. .|.|.|.|"
|
||||
"+ + +-+-+ + +"
|
||||
"|.|. . . .|.|"
|
||||
"+ +-+-+-+-+ +"
|
||||
"|. . . . . .|"
|
||||
"+-+-+-+-+-+-+"]
|
||||
H ← 4
|
||||
W ← 6
|
||||
Nfour ← +⊙¤[¯2_0 2_0 0_2 0_¯2] # Gives N4
|
||||
InBounds ← ▽⊸≡(↧⊃(/↧≥1_1|/↧< +1 × 2 H_W))
|
||||
GetWall ← -:⊡1:÷2/-.
|
||||
# S O L V E T H E M A Z E #
|
||||
.
|
||||
~ "maze-generation.ua" ~ GetWall H Maze N₄ W
|
||||
Maze
|
||||
Start ← 1_1
|
||||
End ← -Start ×2 H_W
|
||||
Heur ← /+⌵-End # Manhattan distance.
|
||||
# (pos grid) -> 1-4 next steps, in bounds, without walls in the way.
|
||||
Ns ← ≡⊡1▽:⟜(≡(=@ ⊡)⊙¤≡GetWall)≡⊟¤:InBounds Nfour.
|
||||
astar(Ns|Heur|≍End) Start # Solve (costs = 1 => djikstra)
|
||||
$"_ moves" ⊙⟜(⍜(⊡|+33)):°□⊢
|
||||
End ← -Start ×2 H_W
|
||||
# (pos grid) -> 1-4 next steps, without walls in the way.
|
||||
Ns ← ≡⊡1▽:⟜(≡(=@ ⊡)⊙¤≡GetWall)≡⊟¤⊃⋅∘∘ ⊸N₄
|
||||
path(Ns|≍End) Start # Solve (djikstra)
|
||||
$"_ moves"⧻⟜(∧⍜⊡⋅@O)⊢
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue