Clojure Обход матрицы по спирали

(defun Spiral-Matrix (n)
  (let ((arr (make-array (list n n) :initial-element nil))
        (count 0)
        (top   0) (bottom (1- n))
        (left  0) (right  (1- n)))
    (loop (if (= count (* n n)) (return arr))
      ;; top
      (dotimes (i n)
        (if (null (aref arr top i))
            (setf (aref arr top i)
                  (incf count))))
      (incf top)
 
      ;; right
      (dotimes (j n)
        (if (null (aref arr j right))
            (setf (aref arr j right)
                  (incf count))))
      (decf right)
 
      ;; bottom
      (dotimes (i n)
        (if (null (aref arr bottom (- n i 1)))
            (setf (aref arr bottom (- n i 1))
                  (incf count))))
      (decf bottom)
 
      ;; left
      (dotimes (j n)
        (if (null (aref arr (- n j 1) left))
            (setf (aref arr (- n j 1) left)
                  (incf count))))
      (incf left)
    )))
 
> (Spiral-Matrix 7)
=>
#2A(
( 1  2  3  4  5  6  7)
(24 25 26 27 28 29  8)
(23 40 41 42 43 30  9)
(22 39 48 49 44 31 10)
(21 38 47 46 45 32 11)
(20 37 36 35 34 33 12)
(19 18 17 16 15 14 13)
)
 
> (Spiral-Matrix 6)
=>
#2A(
( 1  2  3  4  5  6)
(20 21 22 23 24  7)
(19 32 33 34 25  8)
(18 31 36 35 26  9)
(17 30 29 28 27 10)
(16 15 14 13 12 11)
)

(defun gen-list (i j pi pj b e)
(cons (list i j b e)
 (cond 
   ((= b e) nil)
   ((= pj 1)  (apply 'gen-list (if (< j e) (list i (+ j 1) 0 1 b e)  (list (+ i 1) j 1 0 b e))))
   ((= pi 1)  (apply 'gen-list (if (< i e) (list (+ i 1) j 1 0 b e)  (list i (- j 1) 0 -1 b e))))
   ((= pj -1) (apply 'gen-list (if (> j b) (list i (- j 1) 0 -1 b e) (list (- i 1) j -1 0 (+ b 1) e))))
   ((= pi -1) (apply 'gen-list (if (> i b) (list (- i 1) j -1 0 b e) (list i (+ j 1) 0 1 b (- e 1))))))))
 
(defun task (n)
  (let ((matr (iter (for i from 1 to n) 
                    (collecting (iter (for j from 1 to n) (collecting 0)))))
        (lst (gen-list 0 0 0 1 0 (- n 1))))
       (iter (for k in lst) (for p from 1 to (length lst))
         (let ((i (car k))
               (j (cadr k)))
              (setf (nth j (nth i matr)) p))) matr )) 
 
==> task
 
(task 5)
 
==> (( 1   2  3   4 5) 
       (16 17 18 19 6) 
       (15 24 25 20 7) 
       (14 23 22 21 8) 
       (13 12 11 10 9))

(defun walk-spiral (a fn)
  (let ((top    0)
        (left   0)
        (bottom (1- (array-dimension a 0)))
        (right  (1- (array-dimension a 1))))
    (loop :until (or (> top bottom) (> left right)) :do
      (loop :for j :from left :to right :do
        (funcall fn a top j))
      (incf top)
      (loop :for i :from top :to bottom :do
        (funcall fn a i right))
      (decf right)
      (loop :for j :from right :downto left :do
        (funcall fn a bottom j))
      (decf bottom)
      (loop :for i :from bottom :downto top :do
        (funcall fn a i left))
      (incf left))))
 
(defun make-2d-array-indexer (&key (from 0))
  #'(lambda (a i j)
      (setf (aref a i j) from)
      (incf from)))
 
(defun pprint-2d-array (a &key (format "~a"))
  (dotimes (i (array-dimension a 0))
    (format t ";")
    (dotimes (j (array-dimension a 1))
      (format t format (aref a i j)))
    (terpri)))
 
(defun test-spiral (m n)
  (terpri)
  (format t "; ~dx~d:~%" m n)
  (let ((a (make-array (list m n)))
        (f (make-2d-array-indexer :from 1)))
    (walk-spiral a f)
    (pprint-2d-array a :format " ~3d")))
 
(defun test ()
  (test-spiral 7 7)
  (test-spiral 8 8)
  (test-spiral 3 7)
  (test-spiral 7 3)
  (test-spiral 4 6)
  (test-spiral 6 4))

(test)
 
; 7x7:
;   1   2   3   4   5   6   7
;  24  25  26  27  28  29   8
;  23  40  41  42  43  30   9
;  22  39  48  49  44  31  10
;  21  38  47  46  45  32  11
;  20  37  36  35  34  33  12
;  19  18  17  16  15  14  13
 
; 8x8:
;   1   2   3   4   5   6   7   8
;  28  29  30  31  32  33  34   9
;  27  48  49  50  51  52  35  10
;  26  47  60  61  62  53  36  11
;  25  46  59  64  63  54  37  12
;  24  45  58  57  56  55  38  13
;  23  44  43  42  41  40  39  14
;  22  21  20  19  18  17  16  15
 
; 3x7:
;   1   2   3   4   5   6   7
;  16  25  24  23  22  21   8
;  15  14  13  12  11  10   9
 
; 7x3:
;   1   2   3
;  16  17   4
;  15  24   5
;  14  23   6
;  13  22   7
;  12  21   8
;  11  10   9
 
; 4x6:
;   1   2   3   4   5   6
;  16  17  18  19  20   7
;  15  24  23  22  21   8
;  14  13  12  11  10   9
 
; 6x4:
;   1   2   3   4
;  16  17  18   5
;  15  24  19   6
;  14  23  20   7
;  13  22  21   8
;  12  11  10   9

(defn spiral-matrix [m n start]
  (let [row (list (map #(+ % start) (range m)))]
    (if (= n 1)
      row
      (->> (spiral-matrix (dec n) m (+ start m))
           (apply map list)
           (map reverse)
           (concat row)))))
;; => #'user/spiral-matrix
 
(doseq [v (spiral-matrix 7 7 1)]
  (clojure.pprint/cl-format true "~{~4d~^~}~%" v))
;;    1   2   3   4   5   6   7
;;   24  25  26  27  28  29   8
;;   23  40  41  42  43  30   9
;;   22  39  48  49  44  31  10
;;   21  38  47  46  45  32  11
;;   20  37  36  35  34  33  12
;;   19  18  17  16  15  14  13
;; => nil