(FILECREATED "27-Jun-86 18:16:28" {QV}<PEDERSEN>LISP>EARRAY-MATRIXFNS.;3 6769
changes to: (FNS EARRAY-MATRIX-TIMES)
previous date: "16-Jun-86 18:36:42" {QV}<PEDERSEN>LISP>EARRAY-MATRIXFNS.;2)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT EARRAY-MATRIXFNSCOMS)
(RPAQQ EARRAY-MATRIXFNSCOMS ((* File created by Coms Manager.)
(FNS EARRAY-MATRIX-DIAG EARRAY-MATRIX-INVERSE EARRAY-MATRIX-REGRESS
EARRAY-MATRIX-SOLVE EARRAY-MATRIX-TIMES EARRAY-MATRIX-TRACE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (LOCALVARS . T))))
(* File created by Coms Manager.)
(DEFINEQ
(EARRAY-MATRIX-DIAG
[LAMBDA (MATRIX RESULT) (* jop: "15-Jun-86 19:10")
(* *)
(if (NOT (EQ (EARRAY-RANK MATRIX)
2))
then (ERROR "Not a matrix" MATRIX))
(SETQ RESULT (EARRAY-TEST-RESULT RESULT (LIST (IMIN (EARRAY-DIMENSION MATRIX 0)
(EARRAY-DIMENSION MATRIX 1)))
(EARRAY-ELEMENT-TYPE MATRIX)))
(for I from 0 upto (IMIN (EARRAY-DIMENSION MATRIX 0)
(EARRAY-DIMENSION MATRIX 1))
do (ASET (AREF MATRIX I I)
RESULT I))
RESULT])
(EARRAY-MATRIX-INVERSE
[LAMBDA (MATRIX RESULT) (* jop: "15-Jun-86 18:56")
(* *)
(if (NOT (EQ (EARRAY-RANK MATRIX)
2))
then (ERROR "Not a matrix" MATRIX))
(if (NOT (EQ (EARRAY-DIMENSION MATRIX 0)
(EARRAY-DIMENSION MATRIX 1)))
then (ERROR "Matrix not square" MATRIX))
(SETQ RESULT (EARRAY-TEST-RESULT RESULT (EARRAY-DIMENSIONS MATRIX)
(QUOTE SINGLE-FLOAT)))
(LET [(MRESULT (MINVERT (if (EQ (EARRAY-ELEMENT-TYPE MATRIX)
(QUOTE SINGLE-FLOAT))
then MATRIX
else (EARRAY-FLOAT MATRIX))
(if (EQ (EARRAY-ELEMENT-TYPE RESULT)
(QUOTE SINGLE-FLOAT))
then RESULT
else (EARRAY-FLOAT RESULT]
(if (NEQ MRESULT RESULT)
then (EARRAY-BLT MRESULT NIL RESULT))
RESULT])
(EARRAY-MATRIX-REGRESS
[LAMBDA (YVECTOR MATRIX RESULT) (* jop: "15-Jun-86 19:06")
(* *)
(if (NOT (EQ (EARRAY-RANK MATRIX)
2))
then (ERROR "Not a matrix" MATRIX))
(if (NOT (EQ (EARRAY-RANK YVECTOR)
1))
then (ERROR "Not a vector" YVECTOR))
(if (NOT (EQ (EARRAY-DIMENSION MATRIX 0)
(EARRAY-DIMENSION YVECTOR 0)))
then (ERROR "Args not conformable"))
(SETQ RESULT (EARRAY-TEST-RESULT RESULT (EARRAY-DIMENSION MATRIX 1)
(QUOTE SINGLE-FLOAT)))
(LET [(MRESULT (MREGRESS (if (EQ (EARRAY-ELEMENT-TYPE YVECTOR)
(QUOTE SINGLE-FLOAT))
then YVECTOR
else (EARRAY-FLOAT YVECTOR))
(if (EQ (EARRAY-ELEMENT-TYPE MATRIX)
(QUOTE SINGLE-FLOAT))
then MATRIX
else (EARRAY-FLOAT MATRIX))
(if (EQ (EARRAY-ELEMENT-TYPE RESULT)
(QUOTE SINGLE-FLOAT))
then RESULT
else (EARRAY-FLOAT RESULT]
(if (NEQ MRESULT RESULT)
then (EARRAY-BLT MRESULT NIL RESULT))
RESULT])
(EARRAY-MATRIX-SOLVE
[LAMBDA (MATRIX CVECTOR RESULT) (* jop: "15-Jun-86 19:01")
(* *)
(if (NOT (EQ (EARRAY-RANK MATRIX)
2))
then (ERROR "Not a matrix" MATRIX))
(if (NOT (EQ (EARRAY-RANK CVECTOR)
1))
then (ERROR "Not a vector" CVECTOR))
(if (NOT (EQ (EARRAY-DIMENSION MATRIX 0)
(EARRAY-DIMENSION MATRIX 1)))
then (ERROR "Matrix not square" MATRIX))
(if (NOT (EQ (EARRAY-DIMENSION MATRIX 0)
(EARRAY-DIMENSION CVECTOR 0)))
then (ERROR "Args not conformable"))
(SETQ RESULT (EARRAY-TEST-RESULT RESULT (EARRAY-DIMENSIONS CVECTOR)
(QUOTE SINGLE-FLOAT)))
(LET [(MRESULT (MSOLVE (if (EQ (EARRAY-ELEMENT-TYPE MATRIX)
(QUOTE SINGLE-FLOAT))
then MATRIX
else (EARRAY-FLOAT MATRIX))
(if (EQ (EARRAY-ELEMENT-TYPE CVECTOR)
(QUOTE SINGLE-FLOAT))
then CVECTOR
else (EARRAY-FLOAT CVECTOR))
(if (EQ (EARRAY-ELEMENT-TYPE RESULT)
(QUOTE SINGLE-FLOAT))
then RESULT
else (EARRAY-FLOAT RESULT]
(if (NEQ MRESULT RESULT)
then (EARRAY-BLT MRESULT NIL RESULT))
RESULT])
(EARRAY-MATRIX-TIMES
[LAMBDA (MATRIX1 MATRIX2 RESULT) (* jop: "27-Jun-86 16:31")
(* *)
(if (NOT (ILESSP (EARRAY-RANK MATRIX1)
3))
then (ERROR "Not a matrix" MATRIX1))
(if (NOT (ILESSP (EARRAY-RANK MATRIX2)
3))
then (ERROR "Not a matrix" MATRIX2))
(LET ((DIMS1 (EARRAY-DIMENSIONS MATRIX1))
(ELTTYPE1 (EARRAY-ELEMENT-TYPE MATRIX1))
(DIMS2 (EARRAY-DIMENSIONS MATRIX2))
(ELTTYPE2 (EARRAY-ELEMENT-TYPE MATRIX2)))
(if (NOT (EQ (CAR (LAST DIMS1))
(CAR DIMS2)))
then (ERROR "Matrices not conformable"))
(SETQ RESULT (EARRAY-TEST-RESULT RESULT (APPEND (LDIFF DIMS1 (LAST DIMS1))
(CDR DIMS2))
(EARRAY-ARITH-TYPE ELTTYPE1 ELTTYPE2)))
(if [AND (EQ ELTTYPE1 (QUOTE SINGLE-FLOAT))
(EQ ELTTYPE2 (QUOTE SINGLE-FLOAT))
(OR (EARRAY-SCALARP RESULT)
(EQ (EARRAY-ELEMENT-TYPE RESULT)
(QUOTE SINGLE-FLOAT]
then (MTIMES MATRIX1 MATRIX2 RESULT)
else (EARRAY-INNER-PRODUCT (QUOTE PLUS)
(QUOTE TIMES)
MATRIX1 MATRIX2 RESULT NIL NIL (EARRAY-ARITH-TYPE
ELTTYPE1
ELTTYPE2])
(EARRAY-MATRIX-TRACE
[LAMBDA (MATRIX) (* jop: "15-Jun-86 19:11")
(* *)
(if (NOT (EQ (EARRAY-RANK MATRIX)
2))
then (ERROR "Not a matrix" MATRIX))
(EARRAY-PLUS-REDUCE (EARRAY-MATRIX-DIAG MATRIX])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(PUTPROPS EARRAY-MATRIXFNS COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (658 6578 (EARRAY-MATRIX-DIAG 668 . 1300) (EARRAY-MATRIX-INVERSE 1302 . 2261) (
EARRAY-MATRIX-REGRESS 2263 . 3502) (EARRAY-MATRIX-SOLVE 3504 . 4892) (EARRAY-MATRIX-TIMES 4894 . 6262)
(EARRAY-MATRIX-TRACE 6264 . 6576)))))
STOP