矩阵相乘

鬼子兵

; '  函数名：MMul
; '  功能：  计算矩阵的乘法
; '  参数：  m   - Integer型变量，相乘的左边矩阵的行数
; '          n   - Integer型变量，相乘的左边矩阵的列数和右边矩阵的行数
; '          l   -  Integer型变量，相乘的右边矩阵的列数
; '          mtxA  - Double型m x n二维数组，存放相乘的左边矩阵
; '          mtxB  - Double型n x l二维数组，存放相乘的右边矩阵
; '          mtxC  - Double型m x l二维数组，返回矩阵乘积矩阵
(defun m_mul(mtxa mtxb / mtxa mtxb m_1 n_1 n_2 l_2 mtxa_mb mtxb_mb mtxc_mb count_i count_j count_k mtxc_mb_z mtxa_mb_z mtxb_mb_z)
        ;(setq mtxa (list (list 5 2 4) (list 3 8 2) (list 6 0 4)  (list 0 1 6)))
        ;(setq mtxb (list (list 2 4) (list 1 3) (list 3 2)))
        (setq mtxa mtxa)
        (setq mtxb mtxb)
        ;;查询 m n l
        (setq m_1 (length mtxa))
        (setq n_1 (length (car mtxa)))
        (setq n_2  (length mtxb))
        (if (/= n_1 n_2)
                (progn
                        (princ "\n无法进行矩阵乘法！")
                        (exit)
                )
        )
        (setq l_2 (length (car mtxb)))
        (princ (strcat "\n会生成" (itoa m_1) "x" (itoa l_2) "的矩阵！\n"))
        ;;生成位置码表
        (setq mtxa_mb (m_mabiao mtxa))
        (setq mtxb_mb (m_mabiao mtxb))
        ;;矩阵的乘法
        (setq mtxc_mb '())
        (setq count_i 1)
        (while (<= count_i m_1)
                (setq count_j 1)
                (while (<= count_j l_2)
                        (setq count_k 1)
                        (while (<= count_k n_1)
                                ;;计算
                                ;;通过索引表看mtxc_mb中(i,j)是否有值
                                (if (not (assoc (list count_i count_j) mtxc_mb))
                                        (progn
                                        (setq mtxc_mb_z 0)
                                        )
                                )
                                (if (assoc (list count_i count_j) mtxc_mb)
                                        (progn
                                                (setq mtxc_mb_z (last (assoc (list count_i count_j) mtxc_mb)))
                                                (setq mtxc_mb (vl-remove (assoc (list count_i count_j) mtxc_mb)  mtxc_mb))
                                        )
                                       
                                )
                                ;;读mtxa_mb(j,k)
                                (setq mtxa_mb_z (last (assoc (list count_i count_k) mtxa_mb)))
                                ;;读mtxb_mb(k,j)                               
                                (setq mtxb_mb_z (last (assoc (list count_k count_j) mtxb_mb)))
                                ;; mtxC(i, j) = mtxC(i, j) + mtxA(i, k) * mtxB(k, j)
                                (setq mtxc_mb_z (+ mtxc_mb_z (* mtxa_mb_z mtxb_mb_z)))
                                ;;将值加入mtxc_mb
                                (setq mtxc_mb (append mtxc_mb (list (list (list count_i count_j) mtxc_mb_z))))
                               
                                (setq count_k (1+ count_k))
                        )
                (setq count_j (1+ count_j))
                )
        (setq count_i (1+ count_i))
        )
        ;;返回矩阵码表
        (setq  mtxc_mb  mtxc_mb)
        ;;返回矩阵表
        (setq count_i 1)
        (setq mtxc '())
        (while (<= count_i m_1)
                (setq count_j 1)
                (setq mtxc_h '())
                (while (<= count_j l_2)
                        (setq mtxc_h (append mtxc_h (list (last (assoc (list count_i count_j) mtxc_mb)))))
                        (setq  count_j (1+ count_j))
                )
                (setq mtxc (append mtxc  (list mtxc_h )))
                (setq count_i (1+ count_i))
        )
        (setq mtxc mtxc)
)

(defun m_mabiao( mtx_1 / mtx_1 mtx_mb count_i mtx_1 count_j sj_h)
        ;;生成数组位置码表
        (setq  mtx_1  mtx_1)
        (setq mtx_mb '())
        (setq count_i 1)
        (foreach sj_h mtx_1
                (setq count_j 1)
                (foreach sj_l sj_h
                        (setq mtx_mb (append mtx_mb (list (list (list count_i count_j) sj_l))))
                        (setq count_j (1+ count_j))
                )
                (setq count_i (1+ count_i))
        )
        (setq mtx_mb mtx_mb)
)

aimisiyou

给些建议：
1、设置自定义函数(某行乘以某列)，简化演算过程；
2、数据存储直接用表(不用嵌套表)。

pxr201419

;;先将第2个矩阵转置
;;然后用第1个矩阵的第i行与第2个矩阵的转置矩阵的第j行(相当于原矩阵的第j列)对应相乘，乘数相加即为结果矩阵的第ij个数

(defun turn (lst / lst0);矩阵转置, 例((a1 a2 a3)(b1 b2 b3))->((a1 b1)(a2 b2)(a3 b3))
   (setq lst0 (mapcar 'list (car lst))
         lst   (cdr lst))
   (while (car lst)
      (setq lst0 (mapcar 'append lst0 (mapcar 'list (car lst)))
            lst (cdr lst)))
   lst0)
(defun multiply (lst1 lst2 / i alst j tst1 tst2 jzlst);矩阵相乘
      (setq i 0 alst nil lst2 (turn lst2))
      (while (< i (length lst1))
         (setq j 0 jzlst nil tst1 (nth i lst1) i (1+ i))
         (while (< j (length lst2))
            (setq tst2 (nth j lst2) j (1+ j)
                  jzlst (append jzlst (list (apply '+ (mapcar '* tst1 tst2))))))
         (setq alst (append alst (list jzlst)))))

;;举例
(setq lsta (list '(1 2 3)
                 '(3 2 1))
      lstb (list '(4 5 6 7)
                 '(7 6 5 4)
                 '(4 3 2 1)))
(turn lstb);;矩阵2转置，结果 ((4 7 4) (5 6 3) (6 5 2) (7 4 1))
(multiply lsta lstb);矩阵相乘，结果 ((30 26 22 18) (30 30 30 30))
;;期待各位老师给出更简洁的程序

aimisiyou

pxr201419 发表于 2020-2-19 09:19
;;先将第2个矩阵转置
;;然后用第1个矩阵的第i行与第2个矩阵的转置矩阵的第j行(相当于原矩阵的第j列)对应相 ...

;;;lst1='((1 2 3 3 2 1) 2)  lst2='((4 5 6 7 7 6 5 4 4 3 2 1) 3)
(defun f (num)(setq k num plst nil)(while (> k 0)(setq k (- k 1))(setq plst (cons k plst))))
(defun fp (lsti i lstj j)(apply '+ (mapcar '* (vl-remove nil (mapcar '(lambda (nn) (if (= i (/ (car nn) (/ (length (car lsti)) (cadr lsti)))) (cadr nn) nil))
(mapcar '(lambda (x y) (list x y)) (f (length (car lsti)))(car lsti))))
(vl-remove nil (mapcar '(lambda (nn) (if (= j (rem (car nn) (/ (length (car lstj)) (cadr lstj)))) (cadr nn) nil))
(mapcar '(lambda (x y) (list x y)) (f (length (car lstj)))(car lstj)))))))
(defun mult (lstii lstjj)(setq ic (/ (length (car lstii)) (cadr lstii)) jc (/ (length (car lstjj)) (cadr lstjj)))(if (/= ic (cadr lstjj))(princ "两矩阵不能相乘！！！")(mapcar '(lambda (x) (mapcar '(lambda (y) (fp lstii x lstjj y)) (f jc))) (f (cadr lstii)))))

(mult  '((1 2 3 3 2 1) 2)  '((4 5 6 7 7 6 5 4 4 3 2 1) 3))



如果是多个矩阵连乘，最好是把结果转化为统一格式，如lst1='((1 2 3 3 2 1) 2) .可能用列数表示矩阵更直观（符合从左到右的顺序）。

aimisiyou

_$ ;;;(setq lst1 '((1 2 3 3 2 1) 3)  lst2 '((4 5 6 7 7 6 5 4 4 3 2 1) 4))
(defun f (num)(setq k num plst nil)(while (> k 0)(setq k (- k 1))(setq plst (cons k plst))))
(defun fp (lsti i lstj j)
(apply '+ (mapcar '*
   (vl-remove nil (mapcar '(lambda (nn) (if (= i (/ (car nn) (cadr lsti))) (cadr nn) nil)) (mapcar '(lambda (x y) (list x y)) (f (length (car lsti))) (car lsti))))
   (vl-remove nil (mapcar '(lambda (nn) (if (= j (rem (car nn) (cadr lstj))) (cadr nn) nil)) (mapcar '(lambda (x y) (list x y)) (f (length (car lstj))) (car lstj)))))
  )
)
(defun mult (lstii lstjj)
  (setq ir (/ (length (car lstii)) (cadr lstii)) jr (/ (length (car lstjj)) (cadr lstjj)))
  (if (/= (cadr lstii) jr )
      (princ "两矩阵不能相乘！！！")
      (list (apply 'append (mapcar '(lambda (x) (mapcar '(lambda (y) (fp lstii x lstjj y)) (f (cadr lstjj)))) (f ir))) (cadr lstjj))
   )
)
(mult '((1 2 3 3 2 1) 3) '((4 5 6 7 7 6 5 4 4 3 2 1) 4))
F
FP
MULT
((30 26 22 18 30 30 30 30) 4)
_$ (mult (mult '((1 2 3 3 2 1) 3) '((4 5 6 7 7 6 5 4 4 3 2 1) 4)) '((1 2 3 4 5 6 7 8) 2))
((344 440 480 600) 2)
_$