在 Lisp 中的另一个矩阵中放置一个矩阵

Question

我有一个 5x5 矩阵（二维数组）

#2A((C C C C C)
    (C C C C C)
    (C C C C C)
    (C C C C C)
    (C C C C C))

和一个 3x3 矩阵

#2A((X X X)
    (X X X)
    (X X X))

我想将d 放入索引 1x1 处的m

(defvar *m* (make-array '(5 5) :initial-element 'C ))

(defvar *d* (make-array '(3 3)
            :displaced-to *m*
            :displaced-index-offset (array-row-major-index *m* 1 1)))

(dotimes (i 3)
       (dotimes (j 3)
         (setf (aref *d* i j) 'X)))

输出

#2A((C C C C C) 
    (C X X X X) 
    (X X X X X) 
    (C C C C C) 
    (C C C C C)) 

所需的输出

#2A((C C C C C)
    (C X X X C)
    (C X X X C)
    (C X X X C)
    (C C C C C))

如何尽可能实际地安排代码以获得所需的输出？该代码不需要使用二维数组或其函数。实际上最好不要使用二维数组，因为对于这个特殊问题，它们似乎不合适。我使用二维数组只是因为我认为它们具有解决此问题的适当功能。欢迎任何其他解决问题的方法。

系统：Windows 上的 CLisp

Answer 1

您不能对移位的数组执行此操作。你不能这样做的原因是因为数组（被视为）连续的内存块（因此，一维对象），并且被替换的数组被替换到另一个数组的给定索引被认为是一个连续的块内存 并且它们本身也是内存中的连续对象，它们共享它们被转移到的数组的一些存储空间。而且你想要的数组在它被置换到的数组中并不连续。

为了看到这一点，这里有两个函数：make-self-indexed-array 创建一个二维数组，其元素是它们自身的索引列表。 make-rma-displaced-array 然后创建一个一维数组，该数组被置换到另一个数组：

(defun make-self-indexed-array (r c)
  (let ((a (make-array (list r c))))
    (dotimes (row r a)
      (dotimes (col c)
        (setf (aref a row col) (list row col))))))

(defun make-rma-displaced-array (array)
  (make-array (array-total-size array)
              :displaced-to array))

然后看这个：

> (let* ((a (make-self-indexed-array 5 5))
         (b (make-rma-array a)))
    (pprint a)
    (pprint b))

#2A(((0 0) (0 1) (0 2) (0 3) (0 4))
    ((1 0) (1 1) (1 2) (1 3) (1 4))
    ((2 0) (2 1) (2 2) (2 3) (2 4))
    ((3 0) (3 1) (3 2) (3 3) (3 4))
    ((4 0) (4 1) (4 2) (4 3) (4 4)))
#((0 0) (0 1) (0 2) (0 3) (0 4) (1 0) (1 1) (1 2) (1 3) (1 4) (2 0) (2 1)
  (2 2) (2 3) (2 4) (3 0) (3 1) (3 2) (3 3) (3 4) (4 0) (4 1) (4 2) (4 3)
  (4 4))

您可以看到，您想要的“置换”数组在原始数组中并不连续。

要执行您想要的操作，您需要构造某种对象，该对象执行适当的索引计算以寻址其在内存中的父对象。这是一种非常基本的方法（link mentioned in a comment 可能更通用）。这个

• 只处理二维数组；
• 可能会有糟糕的表现；
• 但会向您展示您需要做的事情。

在现实生活中，您可以将其推广到任意形状的数组，巧妙地计算出您需要的 row-major-aref 索引。

(defclass 2d-subarray ()
  ;; 2d subarrays of other 2d arrays
  ((parent :reader subarray-parent
           :initarg :parent
           :initform (error "need a parent"))
   (row-offset :initform 0
               :initarg :row-offset
               :reader subarray-row-offset)
   (column-offset :initform 0
                  :initarg :column-offset
                  :reader subarray-column-offset)
   (rows :initform 0
         :initarg :rows
         :reader subarray-rows)
   (columns :initform 0
            :initarg :columns
            :reader subarray-columns)))

(defmethod initialize-instance :after ((subarray 2d-subarray) &key)
  ;; do at least some sanity checks
  (let ((p (subarray-parent subarray)))
    (unless (= (length (array-dimensions p)) 2)
      (error "parent not 2d"))
    (unless (<= (+ (subarray-row-offset subarray)
                   (subarray-rows subarray))
                (array-dimension p 0))
      (error "subarray has too many rows"))
    (unless (<= (+ (subarray-column-offset subarray)
                   (subarray-columns subarray))
                (array-dimension p 1))
      (error "subarray has too many columns"))))


(defgeneric subarray-aref (subarray &rest indices))
(defgeneric (setf subarray-aref) (new subarray &rest indices))

(defmethod subarray-aref ((subarray 2d-subarray) &rest indices)
  (declare (dynamic-extent indices))
  (destructuring-bind (row column) indices
    (assert (and (<= 0 row (subarray-rows subarray))
                 (<= 0 column (subarray-columns subarray)))
        (row column) "indices out of range")
    (aref (subarray-parent subarray)
          (+ row (subarray-row-offset subarray))
          (+ column (subarray-column-offset subarray)))))

(defmethod (setf subarray-aref) (new (subarray 2d-subarray) &rest indices)
  (declare (dynamic-extent indices))
  (destructuring-bind (row column) indices
    (assert (and (<= 0 row (subarray-rows subarray))
                 (<= 0 column (subarray-columns subarray)))
        (row column) "indices out of range")
    (setf (aref (subarray-parent subarray)
                (+ row (subarray-row-offset subarray))
                (+ column (subarray-column-offset subarray)))
          new)))