The code is base (loosely) on the Bellman's flood algorithm.
Here's some info .. pretty basic, but gives the idea
http://micromouse.cannock.ac.uk/maze/fastfloodsolver.htmIt's still a bit rough, but I <think> it will handle most data patterns.
Nice problem Evgeniy
... took a little longer than I'd anticipated.
Regards
Kerry
;;-----------------------------
;;
;; CodeHimBelonga kdub@theSwamp (20091121)
(defun kdub_labyrinth (l /
BP1
CELL
CELLCOUNT
COL
FRONTIERMAP
HEIGHT
INDEX
INGATE
LST
OFFSETMAP
OUTGATE
P0
P1
PPT
PREVIOUSCELL
ROW
ROWWALL
ROWWIDTH
SINGLEARRAY
TRIPMAP
XCELL
;;
_checkfrontier
_replace_nth
_DrawGate
_DrawCube
)
;;-----------------------------
;; LIBRARY
(defun _checkfrontier (cell offset / )
(if (and (not (minusp (setq index (+ cell offset))))
(= 1 (nth index FrontierMap))
)
(progn ; if the cell is an unvisited corridor cell
(setq FrontierMap (_replace_nth FrontierMap previousCell index)
previousCell index
OffsetMap (_replace_nth OffsetMap index (- offset))
)
;;; (princ (strcat "\n Frontier Cell :" (itoa index)))
;;; (princ (strcat "\n FrontierMap: "
;;; (vl-princ-to-string FrontierMap)
;;; )
;;; )
;;; (princ (strcat "\n OffsetMap : "
;;; (vl-princ-to-string OffsetMap)
;;; "\n"
;;; )
;;; )
)
)
)
;;-----------------------------
(defun _replace_nth (lst i itm)
(if lst
(if (> i 0)
(cons (car lst) (_replace_nth (cdr lst) (1- i) itm))
(cons itm (cdr lst))
)
)
)
;;-----------------------------
(defun _DrawGate (PT ST /)
(entmakex (list (cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 1 ST)
(cons 10 (polar PT 2.35619 0.7071))
;;(cons 11 (polar PT 5.49779 0.7071))
(cons 11 PT)
'(40 . 0.5)
'(41 . 1.0)
'(50 . 0.0)
'(51 . 0.0)
'(71 . 1)
'(72 . 1)
'(73 . 2)
)
)
)
;;-----------------------------
(defun _DrawCube (PT /)
(command "._rectang"
"_non"
(polar PT 2.35619 0.7071)
"_non"
(polar PT 5.49779 0.7071)
)
)
;;-----------------------------
;;-----------------------------
;;
(repeat (+ 2 (length (car l))) (setq rowWall (cons 0 rowWall)))
(setq lst (append (list rowWall)
(mapcar (function (lambda (x) (append '(0) x '(0)))) l)
(list rowWall)
)
height (length lst)
rowWidth (length (car lst))
SingleArray (apply 'append lst)
cellcount (length SingleArray)
InGate (vl-position 2 SingleArray) ; zero based
OutGate (vl-position -1 SingleArray) ; zero based
)
(setq FrontierMap (_replace_nth SingleArray InGate 1)
FrontierMap (_replace_nth FrontierMap OutGate 1)
OffsetMap FrontierMap
cell OutGate
previousCell Cell
)
(while (/= cell InGate)
;; (princ (strcat "\nCell :" (itoa cell)))
;; Find the Cells Neighbours
(_checkfrontier cell 1)
(_checkfrontier cell -1)
(_checkfrontier cell rowWidth)
(_checkfrontier cell (- rowWidth))
(setq cell (nth cell FrontierMap))
)
(setq xcell (+ cell (nth cell OffsetMap)))
(while (/= xcell OutGate)
(setq TripMap (cons xcell TripMap)
xcell (+ xcell (nth xcell OffsetMap))
)
)
;;-----------------------------
(setq P0 (getpoint)
P1 P0
)
(foreach n lst
(foreach x n
(if (= x 0)
(_Drawcube P1)
)
(setq p1 (list (+ (car p1) 1.0) (cadr p1) (caddr p1)))
)
(setq p1 (list (car P0) (- (cadr p1) 1.0) (caddr p1)))
)
;;-----------------------------
(_DrawGate (polar (polar P0 (* PI 1.5) (/ InGate rowWidth))
0.0
(rem InGate rowWidth)
)
"S"
)
(_DrawGate (polar (polar P0 (* PI 1.5) (/ OutGate rowWidth))
0.0
(rem OutGate rowWidth)
)
"E"
)
;;-----
(setvar "PDMODE" 34)
(setvar "PDSIZE" 0.25)
(foreach x TripMap
(setq row (/ x rowWidth)
col (rem x rowWidth)
ppt (polar (polar P0 (* PI 1.5) (/ x rowWidth))
0.0
(rem x rowWidth)
)
)
(entmake (list (cons 0 "POINT") (cons 10 ppt) (cons 62 2)))
)
(princ)
)
(princ)
