Example of using Racket graph library to generate mazelike things

amaze.rkt

#lang racket/base
(require graph racket/match racket/list racket/sequence)
(require racket/draw racket/gui) 


(define (cell-up c) (list (car c) (sub1 (cadr c))))
(define (cell-right c) (list (add1 (car c)) (cadr c)))
(define (cell-down c) (list (car c) (add1 (cadr c))))
(define (cell-left c) (list (sub1 (car c)) (cadr c)))

(define (map-procs x procs)
  (map (λ(proc) (proc x)) procs))

(define (get-possible-neighbors c)
  (map-procs c (list cell-up cell-right cell-down cell-left)))

(define (get-expansion-neighbors c)
  (define x (car c))
  (define y (cadr c))
  (list (list (- x 0.5) (- y 0.5)) (list (+ x 0.5) (- y 0.5)) (list (- x 0.5) (+ y 0.5)) (list (+ x 0.5) (+ y 0.5))))

(define (plan->graph p)
  (define graph (unweighted-graph/undirected null))
  (for* ([col (length p)][row (length (list-ref p col))])
    (define plan-node (list-ref (list-ref p col) row))
    (when plan-node
      (add-vertex! graph (list row col))))
  (fill-graph-edges graph)
  graph)


(define (make-grid-graph x-max y-max)
  (plan->graph (make-list y-max (make-list x-max #t))))


(define (fill-graph-edges g)
  (for ([v (in-vertices g)])
    (map (λ(c) (when (has-vertex? g c) (add-edge! g v c)))
         (get-possible-neighbors v)))
  g)


(define (get-grid-max-coordinates g)
  (define x-max (apply max (map car (sequence->list (in-vertices g)))))
  (define y-max (apply max (map cadr (sequence->list (in-vertices g)))))
  (values x-max y-max))

(define (get-grid-min-coordinates g)
  (define x-min (apply min (map car (sequence->list (in-vertices g)))))
  (define y-min (apply min (map cadr (sequence->list (in-vertices g)))))
  (values x-min y-min))


;; Returns a maze of a given size
;; build-maze :: Index Index -> Maze
(define (graph->maze guide-graph)
  (define maze-graph (unweighted-graph/undirected null))  
  (let move-to-cell ([c (car (shuffle (sequence->list (in-vertices guide-graph))))])
    (for ([n (shuffle (sequence->list (in-neighbors guide-graph c)))] 
          #:unless (has-vertex? maze-graph n))
      (add-edge! maze-graph c n)
      (move-to-cell n)))
  maze-graph)

; up = 1 ; right = 2 ; bottom = 4 ; left = 8

(define thin   " ╵╶└╷│┌├╴┘─┴┐┤┬┼")
(define curve  " ╵╶╰╷│╭├╴╯─┴╮┤┬┼")
(define double " ║═╚║║╔╠═╝═╩╗╣╦╬")
(define thick  " ╹╺┗╻┃┏┣╸┛━┻┓┫┳╋")
(define horiz  " ╵╺┕╷│┍┝╸┙━┷┑┥┯┿")
(define vert   " ╹╶┖╻┃┎┠╴┚─┸┒┨┰╂")
(define mickey " ╹╺└╻┃┌├╸┘━┴┐┤┬┼")
(define mouse  " ╵╶┗╷│┏┣╴┛─┻┓┫┳╋")
(define donald " ╵╶╚╷│╔╠╴╝─╩╗╣╦╬")
(define duck   " ╹╺╚╻┃╔╠╸╝━╩╗╣╦╬")
(define alpha  " '-Li1r}-f—Tn{t+")

(define shade  " ░░░░░▒▒▒▒▒▓▓▓▓▓")

(define (map-bdc str bdc-in bdc-out)
  (define str-list (string->list str))
  (define bdc-in-list (string->list bdc-in))
  (define bdc-out-list (string->list bdc-out))
  (displayln (list->string 
              (for/list ([c str-list])
                (define index (and (member c bdc-in-list) (- (length bdc-in-list) (length (member c bdc-in-list)))))
                (if index
                    (list-ref bdc-out-list index)
                    c)))))




(define (graph->bdc g [cs thin] #:vstretch [vstretch 1] #:hstretch [hstretch 2])
  (define chars (string->list cs))
  (define blank-char (list-ref chars 0))
  (define vert-char (list-ref chars 5))
  (define horiz-char (list-ref chars 10))
  (display "\n")
  (define-values (x-max y-max) (get-grid-max-coordinates g))
  (define-values (x-min y-min) (get-grid-min-coordinates g))
  (for ([y (range y-min (add1 y-max))])
    (display "  ")
    (for ([x (range x-min (add1 x-max))]) ; row showing horiz connections
      (define current-cell (list x y))
      (define current-neighbors (and (has-vertex? g current-cell) (sequence->list (in-neighbors g current-cell))))
      (if (has-vertex? g current-cell)
          (let* ([possible-neighbors (get-possible-neighbors current-cell)]
                 [result (for/sum ([i (length possible-neighbors)]) ; convert junction to hex value
                           (* (expt 2 i) (if (member (list-ref possible-neighbors i) current-neighbors) 1 0)))])
            (display (list-ref chars result)))
          (display (list-ref chars 0))) ; blank
      
      (for ([h hstretch])
        (if (has-vertex? g current-cell)
            (if (member (cell-right current-cell) current-neighbors) 
                (if (has-vertex? g current-cell)
                    (display horiz-char)
                    (display (list-ref chars 15))) ; four-way
                (display (list-ref chars 0))) ; blank
            (display blank-char))))
    
    (display "\n")
    (for ([v vstretch])
      (display "  ")
      (for ([x (range x-min (add1 x-max))]) ; row showing vert connections
        (define current-cell (list x y))
        
        (define current-neighbors (and (has-vertex? g current-cell) (sequence->list (in-neighbors g current-cell))))
        (if (has-vertex? g current-cell)
            (if (member (cell-down current-cell) current-neighbors) 
                (display vert-char)
                (display blank-char)) 
            (display blank-char))
        (for ([h (sub1 hstretch)])
          (display blank-char))
        (display blank-char))
      (display "\n"))))



(define (expand-maze g)
  (define g-maze (expand-graph g))
  
  ; use g as a guide to cut connections in g2
  (for ([g-maze-cell (in-vertices g-maze)])
    ;; expanded graph has coordinates that are shifted by half a unit
    (define g-cell (map (λ(v) (inexact->exact (+ v 0.5))) g-maze-cell))
    ;; connected to right?
    (when (has-edge? g g-cell (cell-right g-cell))
      (remove-edge! g-maze (cell-right g-maze-cell) (cell-down (cell-right g-maze-cell))))
    ;; connected to down?
    (when (has-edge? g g-cell (cell-down g-cell))
      (remove-edge! g-maze (cell-down g-maze-cell) (cell-right (cell-down g-maze-cell)))))
  g-maze)


(define (graph-has-no-orphans? g)
  ;; a graph has no orphans if every vertex has a neighbor.
  (andmap (λ(v) (not (equal? null (in-neighbors g v)))) (in-vertices g)))

(define (delete-random-edges g num #:orphans [orphans-allowed? #t])
  (for ([i num])
    (define possible-edges (shuffle (sequence->list (in-edges g))))
    (define edge
      (if orphans-allowed? ; as in, orphan vertices
          (car possible-edges)
          (andmap (λ(e) (let ([g+ (graph-copy g)]) 
                          (apply remove-edge! g+ e) 
                          (and (graph-has-no-orphans? g+) e))) possible-edges)))
    (apply remove-edge! g edge))
  g)

(define (delete-random-vertices g num)
  (for ([i num])
    (remove-vertex! g (car (shuffle (sequence->list (in-vertices g))))))
  g)

(define (triangular-plan n)
  (let ([steps n])
    `(,@(for/list ([x steps])
          (make-list (+ x 2) #t))
      ,(make-list (add1 steps) #t))))


(define (pyramid-plan n)
  (define width (- (* n 2) 1))
  (let ([steps n])
    `(,@(for/list ([x (range 1 (add1 steps))])
          (define row-width (- (* x 2) 1))
          (define edge (/ (- width row-width) 2))
          `(,@(make-list edge #f) ,@(make-list row-width #t) ,@(make-list edge #f))))))


(define (expand-graph g)
  (define new-g (unweighted-graph/undirected null))
  (for ([v (in-vertices g)])
    (map (λ(n) (add-vertex! new-g n)) (get-expansion-neighbors v)))
  (fill-graph-edges new-g))

(define (make-maze-from-plan p)
  (expand-maze (graph->maze (plan->graph p))))
(define (make-step-maze n)
  (make-maze-from-plan (triangular-plan n)))

(define q 
  '((1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
    (0 0 1 1 1 1 1)
    (0 0 1 1 1 1 1)
    (0 0 1 1 1 0 0 0 0 1 1 1)
    (0 0 1 1 1 0 0 0 0 1 1 1)
    (0 0 1 1 1 0 0 0 0 1 1 1)
    (0 0 1 1 1 1 1 1 1 1 1 1 1 1)
    (0 0 1 1 1 1 1 1 1 1 1 1 1 1)
    (0 0 1 1 1 1 1 1 1 1 1 1 1 1)
    (0 0 1 1 1 1 1 1 1 1 1 1 1 1)
    (0 0 1 1 1 1 1)
    (0 0 1 1 1 1 1)
    (0 0 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1)
    (1 1 1 1 1 1 1 1 1)))

(define (graph->bitmap g)
  (define x-max 500)
  (define y-max 500)
  (define target (make-bitmap x-max y-max))
  (define dc (new bitmap-dc% [bitmap target]))
  
  (send dc set-pen "black" 1 'solid)
  
  (for ([e (in-edges g)])
    (set! e (map (λ(e2) (* 10 e2)) (flatten e)))
    (send dc draw-line (first e) (second e) (third e) (fourth e)))
  
  
  (make-object image-snip% target))


(define (scale-plan p n)
  (define p2 '())
  (for ([row p])
    (let ([big-row (flatten (map (λ(e) (make-list n e)) row))])
      (for ([i n])
        (set! p2 (cons big-row p2)))))
  (reverse p2))

(define (string->plan str)
  (define charlists (map string->list (string-split str)))
  (map (λ(cl) (map (λ(c) (string->number (format "~a" c))) cl)) charlists))

(define outer-maze
  `(,@(make-list 5 (make-list 48 #t))
  ,@(make-list 9 (make-list 62 #t))
  ,@(make-list 23 `(,@(make-list 4 #f) ,@(make-list 12 #t) ,@(make-list 42 #f) ,@(make-list 4 #t)))
  ,@(make-list 4 `(,@(make-list 4 #f) ,@(make-list 12 #t) ,@(make-list 30 #f) ,@(make-list 16 #t)))
  ,@(make-list 1 `(,@(make-list 4 #f) ,@(make-list 58 #t)))
  ,@(make-list 4 `(,@(make-list 4 #f) ,@(make-list 45 #t)))))

(define inner-maze
  `(,@(make-list 5 (make-list 48 #t))
  ,@(make-list 8 (make-list 61 #t))
  ,@(make-list 24 `(,@(make-list 4 #f) ,@(make-list 11 #t) ,@(make-list 43 #f) ,@(make-list 3 #t)))
  ,@(make-list 4 `(,@(make-list 4 #f) ,@(make-list 11 #t) ,@(make-list 31 #f) ,@(make-list 15 #t)))
  ,@(make-list 4 `(,@(make-list 4 #f) ,@(make-list 44 #t)))))

(define g (expand-maze (graph->maze (plan->graph outer-maze))))
(graph->bdc g double #:hstretch 1 #:vstretch 0)

(graph->bdc (expand-maze (graph->maze (plan->graph inner-maze))) curve #:hstretch 1 #:vstretch 0)

• A “plan” is a list of lists of booleans that determine where the maze cells appear. This allows me to specify non-rectangular areas to fill.

• This plan is turned into a graph with plan->graph. The graph models the inside of the maze — that is, the “walking paths”.

• expand-maze takes this graph and computes a new graph that models the walls of the maze.

• graph->bdc then renders the walls. bdc stands for “box-drawing characters”. You can see around lines 67–79 that there are different sets of box-drawing characters you can use.