Common Lisp Вставка столбца в матрицу

(defun extend-matrix (a k v)
  (let ((m (array-dimension a 0))
        (n (array-dimension a 1)))
    (let ((b (make-array (list m (1+ n)))))
      (dotimes (i m)
        (dotimes (j k)
          (setf (aref b i j) (aref a i j))))
      (loop
        :for i :below m
        :for x :in v
        :do (setf (aref b i k) x))
      (dotimes (i m)
        (loop :for j :from k :to (1- n) :do
          (setf (aref b i (1+ j)) (aref a i j))))
      b)))
 
(defun print-matrix (a &optional (format "~a"))
  (dotimes (i (array-dimension a 0))
    (dotimes (j (array-dimension a 1))
      (format t format (aref a i j)))
    (terpri)))
 
(defun test-extend-matrix (k format)
  (let ((n (+ k (random k))))
    (let ((a (make-array (list n n)))
          (v (loop :for i :below n :collect i)))
      (dotimes (i (array-dimension a 0))
        (dotimes (j (array-dimension a 1))
          (setf (aref a i j) (random (* n n)))))
      (print-matrix a format)
      (terpri)
      (print-matrix (extend-matrix a k v) format))))

(test-extend-matrix 6 "~3d ")
; 13  21  10  33   1  19 
; 19  22   0  20  17   5 
;  7  35  14  10   7  21 
; 16  14  23  29  10  26 
;  1  13  21  20  15   1 
; 30  32   7  34  29   1 
;
; 13  21  10  33   1  19   0 
; 19  22   0  20  17   5   1 
;  7  35  14  10   7  21   2 
; 16  14  23  29  10  26   3 
;  1  13  21  20  15   1   4 
; 30  32   7  34  29   1   5 
 
(test-extend-matrix 6 "~3d ")
;  0  57   1  36  52  58  27  12 
; 15  11  29  58   5  11  37  28 
; 18  55  50  42  48  18  63  48 
; 27  31  11  38  23  31  32  25 
; 45  63  62  61  61  41  59   7 
; 22  16  59   6  55  15  46  31 
; 59  49  35  43  56  48  41   1 
; 18  20  22  60   9  35  40  26 
;
;  0  57   1  36  52  58   0  27  12 
; 15  11  29  58   5  11   1  37  28 
; 18  55  50  42  48  18   2  63  48 
; 27  31  11  38  23  31   3  32  25 
; 45  63  62  61  61  41   4  59   7 
; 22  16  59   6  55  15   5  46  31 
; 59  49  35  43  56  48   6  41   1 
; 18  20  22  60   9  35   7  40  26

;; matr - матрица; 
;; col-new - новый столбец;
;; after - после какого вставлять
 
(defun col-ins (matr col-new after)
  (mapcar #'(lambda (row el) (append (subseq row 0 after) (list el) (subseq row after))) matr col-new))
 
==> col-ins
 
(col-ins '((1 2 3) (4 5 6) (7 8 9)) '(a b c) 2)
 
==> ((1 2 a 3) 
       (4 5 b 6) 
       (7 8 c 9))
 
(col-ins '((1 2 3) (4 5 6) (7 8 9)) '(a b c) 1)
 
==> ((1 a 2 3) 
       (4 b 5 6)
       (7 c 8 9))
 
(col-ins '((1 2 3) (4 5 6) (7 8 9)) '(a b c) 3)
 
==> ((1 2 3 a) 
       (4 5 6 b)
       (7 8 9 c))

INSOMNIA> (defparameter
              mx-ar
            (loop with matrix = (make-array '(10000 10000))
                 for l to 9999
                 do
                 (loop for c to 9999
                      do
                      (setf (aref matrix l c)
                            (1+ (random 100))))
                 finally (return matrix)))
MX-AR
INSOMNIA> (time (arrayp
                 (matrix-copy mx-ar)))
Evaluation took:
  1.442 seconds of real time
  1.312000 seconds of total run time (0.809000 user, 0.503000 system)
  [ Run times consist of 0.427 seconds GC time, and 0.885 seconds non-GC time. ]
  90.98% CPU
  3,452,467,487 processor cycles
  800,000,016 bytes consed
  
T