;;; -*- Mode:LISP; Package:LISP-INTERNALS; Readtable:CL; Base:10 -*- (defvar *board*) (defvar *sequence*) (defvar *a*) (defvar *b*) (defvar *c*) (defvar *answer*) (defvar *final*) (defun setup-triang () (setq *board* (make-array 16.)) (dotimes (i 16.) (setf (svref *board* i) 1)) (setq *sequence* (make-array 14.)) (dotimes (i 14.) (setf (svref *sequence* i) 0)) (setq *a* (make-array 37.)) (setq *b* (make-array 37.)) (setq *c* (make-array 37.)) (do ((i 0 (1+ i)) (aa '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6) (cdr aa)) (bb '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5) (cdr bb)) (cc '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6 1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4) (cdr cc))) ((= i 37.)) (setf (aref *a* i) (car aa)) (setf (aref *b* i) (car bb)) (setf (aref *c* i) (car cc))) (setf (aref *board* 5) 0)) (defun last-position () (do ((i 1 (1+ i))) ((= i 16.) 0) (cond ((= 1 (aref *board* i)) (return i))))) (defun try (i depth) (cond ((= depth 14) (let ((lp (last-position))) (unless (member lp *final*) (push lp *final*))) (push (cdr (map 'list #'quote *sequence*)) *answer*) t) ((and (= 1 (aref *board* (aref *a* i))) (= 1 (aref *board* (aref *b* i))) (= 0 (aref *board* (aref *c* i)))) (setf (aref *board* (aref *a* i)) 0) (setf (aref *board* (aref *b* i)) 0) (setf (aref *board* (aref *c* i)) 1) (setf (aref *sequence* depth) i) (do ((j 0 (1+ j)) (depth (1+ depth))) ((or (= j 36.) (try j depth)) ())) (setf (aref *board* (aref *a* i)) 1) (setf (aref *board* (aref *b* i)) 1) (setf (aref *board* (aref *c* i)) 0)()))) (defun gogogo (i) (let ((*answer* ()) (*final* ())) (try i 1))) (defun quote (x) (cons 'quote x)) (defun test-triang () (boot-stack-groups) (setup-triang) (hw:write-microsecond-clock (hw:unboxed-constant 0)) (error "TRIANG" (gogogo 22.) (hw:read-microsecond-clock)) (loop))