手始めに1行の行列x1列の行列を行なう関数を作成してみた.

(defun multiple-array (arr1 arr2)
  (let ((arr1-col-num (array-dimension arr1 0))
	(result 0))
    (dotimes (i arr1-col-num result)
      (setf result (+ result
		      (* (aref arr1 i)
			 (aref arr2 i 0)))))))

実行してみる.

> (multiple-array #1a(1 2 3 4 5) #2a((1) (2) (3) (4) (5)))
55
> (multiple-array #1a(1 2 3) #2a((1) (2) (3) (4)))
14
> (multiple-array #1a(1 2 3 4) #2a((1) (2) (3) ))

*** - AREF: subscripts (3 0) for #2A((1) (2) (3)) are out of range

この関数multiple-arrayの第一引数は1次元1行,第二引数は2次元1列でなければならない.関数内では,まず第一引数の列数を取得してあとはdotimesでループして積の和を求めている.この関数を実行してみる.第一引数の列数はarray-dimensionで求めた.

(array-dimension 配列 次数)

この関数は第一引数の配列における第二引数の次数の要素数を返す.第一引数の配列の次元以上(次数は0から始まる)の値を第二引数の次数に指定することはできない.

> (array-dimension (make-array 1) 0)
1
> (array-dimension (make-array 5) 0)
5
> (array-dimension (make-array 1) 1)

*** - ARRAY-DIMENSION: 1 is not an nonnegative integer less than the rank of #(NIL)

次数がnなら次数にはn-1まで選択できる.

> (do ((i 0 (+ i 1)))
         ((> i 5))
           (format t "array-dimension = ~A~%"
                   (array-dimension (make-array '(1 2 3 4 5)) i)))
array-dimension = 1
array-dimension = 2
array-dimension = 3
array-dimension = 4
array-dimension = 5

*** - ARRAY-DIMENSION: 5 is not an nonnegative integer less than the rank of 
#5A(((((NIL NIL NIL NIL NIL)
       (NIL NIL NIL NIL NIL)
...以下省略...

当然ながら,第一引数の列数と第二引数の行数は一致しなければならないので,2,3番目の実行結果は好ましくない.特に2番目の例では入力が過っているにも係わらず結果が正常な場合と同様に出力されているので質が悪い.入力チェックをいれてみる.

(defun multiple-array (arr1 arr2)
  (let ((arr1-dim (cdr (array-dimensions arr1)))
	(arr2-dim (cddr (array-dimensions arr2))))
    (if (or (not (null arr1-dim))
	    (not (null arr2-dim)))
	(progn (format t "arr1-dim ~A arr2-dim ~A~%"
		       arr1-dim arr2-dim)
	       (return-from multiple-array)))
    (let ((arr1-col-num (array-dimension arr1 0))
	  (arr2-row-num (array-dimension arr2 0))
	  (arr2-col-num (array-dimension arr2 1)))
      (if (or (/= arr1-col-num arr2-row-num)
	      (/= arr2-col-num 1))
	  (progn (format t "arr1-col-num=~A arr2-row-num=~A~%"
			 arr1-col-num arr2-row-num)
		 (return-from multiple-array)))
      (let ((result 0))
	(dotimes (i arr1-col-num result)
	  (setf result (+ result
			  (* (aref arr1 i)
			     (aref arr2 i 0)))))))))

実行してみる.

> (multiple-array #1a(1 2 3 4 5) #2a((1) (2) (3) (4) (5)))
55
> (multiple-array #1a(1 2 3) #2a((1) (2) (3) (4)))
arr1-col-num=3 arr2-row-num=4
NIL
> (multiple-array #1a(1 2 3 4) #2a((1) (2) (3) ))
arr1-col-num=4 arr2-row-num=3
NIL
> (multiple-array #2a((1 2 3 4)) #2a((1) (2) (3) (4)))
arr1-dim (4) arr2-dim NIL
NIL
> (multiple-array #1a(1 2 3 4) #3a(((1 2 3 4))))
arr1-dim NIL arr2-dim (4)
NIL

今回の入力チェックでは以下をチェックしている.

• 第一引数が1次元以下かどうか
• 第二引数が2次元以下かどうか
• 第一引数の列数が第二引数の行数と一致するか
• 第二引数の列数が1か

第一引数の行数が1かどうかのチェックでは,array-dimensionを使用できない.そこで,array-dimensionsを使用した.

(array-dimensions 配列)

この関数は,array-dimensionの次元を指定する第二引数に0から順に値を埋めていった際の結果のリストを返す.すなわち各次元でのarray-dimensionの結果を返す.

> (array-dimensions #1a(1 2 3))
(3)
> (array-dimensions #2a((1 2 3))) 
(1 3)
> (array-dimensions (make-array '(1 2 3 4 5)))
(1 2 3 4 5)

これを利用すれば,第一引数が1次元かどうかを確認できる(※).

> (cdr (array-dimensions #1a(1 2 3)))
NIL
> (cdr (array-dimensions #2a((1 2 3))))
(3)
> (cddr (array-dimensions #2a((1 2 3))))
NIL

今回は,第二引数が1次元でないかどうかなどのチェックはしていないが,それらの間違いはエラーになるので検出はできると思う.

> (array-rank #1a(1 2 3))
1
> (array-rank #2a((1 2 3)))
2
> (array-rank #2a((1) (2) (3)))
2
> (array-rank #3a(((1) (2) (3))))
3

今度は2次元行列の積を計算する関数multiple-array2を作成する.2次元行列の積は,1行x1列の積とその結果の和の組み合わせで算出できる.1行x1列の積は前節の関数multiple-arrayを使用する.この関数を使用するために,multiple-array2の引数行列から任意の行や列を取り出す必要がある.そこでまず2次元行列から任意の行を取り出す関数を作成した.

(defun aref-row (arr col)
  (let* ((arr-col (array-dimension arr 1))
	(result-row (make-array (list arr-col))))
	(dotimes (i arr-col result-row)
	  (setf (aref result-row i) (aref arr col i)))))

この関数は,第一引数の二次元配列から第二引数で指定した行を取り出す.特に目新しいことはしていない.実行してみる.

> (aref-row #2a((1 2 3) (4 5 6) (7 8 9)) 0)
#(1 2 3)
> (aref-row #2a((1 2 3) (4 5 6) (7 8 9)) 1)
#(4 5 6)
> (aref-row #2a((1 2 3) (4 5 6) (7 8 9)) 2)
(7 8 9)
> (aref-row #2a((1 2 3) (4 5 6) (7 8 9)) 3)

*** - AREF: subscripts (3 0) for #2A((1 2 3) (4 5 6) (7 8 9)) are out of range

次に二次元配列から列を取り出す関数を作成した.

(defun aref-col (arr row)
  (let* ((arr-row (array-dimension arr 0))
	(result-col (make-array (list arr-row 1))))
	(dotimes (i arr-row result-col)
	  (setf (aref result-col i 0) (aref arr i row)))))

この関数は第一引数の二次元配列から第二引数で指定した列を取り出す.返される配列は二次元で1列である.実行してみる.

> (aref-col #2a((1 2 3) (4 5 6) (7 8 9)) 0)
#2A((1) (4) (7))
> (aref-col #2a((1 2 3) (4 5 6) (7 8 9)) 1)
#2A((2) (5) (8))
> (aref-col #2a((1 2 3) (4 5 6) (7 8 9)) 2)
#2A((3) (6) (9))
> (aref-col #2a((1 2 3) (4 5 6) (7 8 9)) 3)

*** - AREF: subscripts (0 3) for #2A((1 2 3) (4 5 6) (7 8 9)) are out of range

ここまでの関数を使用して二次元配列の積を計算する関数を作成した.

(defun multiple-array2 (arr1 arr2)
  (let ((arr1-row-num (array-dimension arr1 0))
	(arr2-col-num (array-dimension arr2 1)))
    (if (/= arr1-row-num arr2-col-num)
	(progn (format t "arr1-row-num=~A arr2-col-num=~A~%"
		       arr1-row-num arr2-col-num)
	       (return-from multiple-array2 1)))
    (let ((result-array (make-array (list arr1-row-num arr2-col-num))))
      (dotimes (i arr1-row-num result-array)
	(dotimes (j arr2-col-num nil)
	  (setf (aref result-array i j)
		(multiple-array (aref-row arr1 i) (aref-col arr2 j))))))))

計算方法に関しては,特に目新しいものはない.実行してみる.

> (multiple-array2 #2A((1 2 3) (4 5 6)) #2A((1 2) (3 4) (5 6)))
#2A((22 28) (49 64))
> (multiple-array2 #2A((1 2 3) (4 5 6)) #2A((1 2) (3 4)))
arr1-col-num=3 arr2-row-num=2
arr1-col-num=3 arr2-row-num=2
arr1-col-num=3 arr2-row-num=2
arr1-col-num=3 arr2-row-num=2
#2A((NIL NIL) (NIL NIL))
> (multiple-array2 #2A((1 2 3)) #2A((1 2) (3 4)))
arr1-row-num=1 arr2-col-num=2
1

二つ目の実行例は,multiple-array2の入力チェックをすり抜けるが,その後呼び出されるmultiple-arrayの入力チェックで誤りは検出できているので放置.