labyrinth.lisp

;; prefered order top-right-bottom-left

;; labyrinth x,y indexed at 0 :
;;            x    
;;         +------>
;;         |       
;;       y |       
;;         v       
;; 
;; dimension always NxN

(defun solve (labyrinth ax ay bx by)
  (cond ((not (is-empty-cell labyrinth ax ay)) nil)
        ((and (= ax bx) (= ay by)) "")
        (t (loop
              for dir in '("T" "R" "B" "L")
              for xy  in '((0 . -1) (1 . 0) (0 . 1) (-1 . 0))
              for path = (solve (add-wall labyrinth ax ay)
                                (+ ax (car xy)) (+ ay (cdr xy))
                                bx by)
              when path
              return (concatenate 'string dir path)))))

(defun add-wall (labyrinth x y)
  (let ((result (copy-seq labyrinth)))
    (setf (char result (pos labyrinth x y)) #\*)
    result))

(defun is-empty-cell (labyrinth x y)
  (let ((size (sqrt (length labyrinth))))
    (and (<= 0 x) (< x size)
         (<= 0 y) (< y size)
         (not (equal #\* (char labyrinth (pos labyrinth x y)))))))

(defun pos (labyrinth x y)
  (+ (* y (sqrt (length labyrinth)))
     x))

;; -----------------------------------------------------------------------------
;; tests
;; -----------------------------------------------------------------------------

(use-package :lisp-unit)

(define-test test-pos
  (let ((labyrinth (concatenate 'string
                                ".."
                                "..")))
    (assert-equal 0 (pos labyrinth 0 0))
    (assert-equal 1 (pos labyrinth 1 0))
    (assert-equal 2 (pos labyrinth 0 1))
    (assert-equal 3 (pos labyrinth 1 1))))

(define-test test-solve
  (assert-equal "RRBB" (solve (concatenate 'string
                                           "A.."
                                           "..."
                                           "..B") 0 0 2 2))
  (assert-equal "" (solve (concatenate 'string
                                           "C.."
                                           "..."
                                           "...") 0 0 0 0))
  (assert-equal "R" (solve (concatenate 'string
                                           "AB."
                                           "..."
                                           "...") 0 0 1 0))
  (assert-equal "RBBLTLT" (solve (concatenate 'string
                                           "BA."
                                           "..."
                                           "...") 1 0 0 0))
  (assert-equal "RR" (solve (concatenate 'string
                                           "A.B"
                                           "..."
                                           "...") 0 0 2 0))
  (assert-equal "RRBBLTL" (solve (concatenate 'string
                                           "A.."
                                           "B.."
                                           "...") 0 0 0 1))
  (assert-equal "BBRR" (solve (concatenate 'string
                                           "A.."
                                           ".**"
                                           "..B") 0 0 2 2))
  (assert-equal "RRRRBBLLLLBBRRRR" (solve (concatenate 'string
                                           "Arrrr"
                                           "***.b"
                                           "llllb"
                                           "b****"
                                           "rrrrB"
                                           ) 0 0 4 4))
  (assert-equal nil (solve (concatenate 'string
                                           "A.."
                                           "***"
                                           "..B") 0 0 2 2)))

(define-test test-solve-into-wall
  (assert-equal nil (solve (concatenate 'string
                                           "*.."
                                           "..."
                                           "..B") 0 0 2 2)))

(define-test test-solve-big
  (let ((big-lab (make-string 10000 :initial-element #\ ))
        (expected (concatenate 'string
                               (make-string 99 :initial-element #\R)
                               (make-string 99 :initial-element #\B))))
    (assert-equal expected (solve big-lab 0 0 99 99))))

(define-test test-is-empty-cell
  (let ((labyrinth (concatenate 'string
                                ".."
                                "*.")))
    (assert-equal t (is-empty-cell labyrinth 0 0))
    (assert-equal t (is-empty-cell labyrinth 1 0))
    (assert-equal nil (is-empty-cell labyrinth 0 1))
    (assert-equal t (is-empty-cell labyrinth 1 1))
    (assert-equal nil (is-empty-cell labyrinth 0 -1))
    (assert-equal nil (is-empty-cell labyrinth 0 2))
    (assert-equal nil (is-empty-cell labyrinth -1 0))
    (assert-equal nil (is-empty-cell labyrinth 2 0))))

(define-test test-add-wall
  (loop
     with input = (concatenate 'string
                                 "..."
                                 "..."
                                 "...")
     for xy in '((1 . 2) (0 . 0) (2 . 2))
     for expected in (list (concatenate 'string
                              "..."
                              "..."
                              ".*.")
                           (concatenate 'string
                              "*.."
                              "..."
                              "...")
                           (concatenate 'string
                              "..."
                              "..."
                              "..*"))
     do
       (assert-equal expected (add-wall input (car xy) (cdr xy)))))

(run-tests)