From 64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:38 -0800 Subject: Import Upstream version 3a5 --- determ.scm | 48 ++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 38 insertions(+), 10 deletions(-) (limited to 'determ.scm') diff --git a/determ.scm b/determ.scm index 0962e4a..30dabbc 100644 --- a/determ.scm +++ b/determ.scm @@ -114,18 +114,46 @@ matrix)))) ;;@body -;;Returns the product of matrices @1 and @2. -(define (matrix:product m1 m2) +;;Returns the element-wise sum of matricies @1 and @2. +(define (matrix:sum m1 m2) (define mat1 (matrix->lists m1)) (define mat2 (matrix->lists m2)) - (define (dot-product v1 v2) (apply + (map * v1 v2))) - (coerce-like-arg - (map (lambda (arow) - (apply map - (lambda bcol (dot-product bcol arow)) - mat2)) - mat1) - m1)) + (coerce-like-arg (map (lambda (row1 row2) (map + row1 row2)) mat1 mat2) + m1)) + +;;@body +;;Returns the element-wise difference of matricies @1 and @2. +(define (matrix:difference m1 m2) + (define mat1 (matrix->lists m1)) + (define mat2 (matrix->lists m2)) + (coerce-like-arg (map (lambda (row1 row2) (map - row1 row2)) mat1 mat2) + m1)) + +(define (matrix:scale m1 scl) + (coerce-like-arg (map (lambda (row1) (map (lambda (x) (* scl x)) row1)) + (matrix->lists m1)) + m1)) + +;;@args m1 m2 +;;Returns the product of matrices @1 and @2. +;;@args m1 z +;;Returns matrix @var{m1} times scalar @var{z}. +;;@args z m1 +;;Returns matrix @var{m1} times scalar @var{z}. +(define (matrix:product m1 m2) + (cond ((number? m1) (matrix:scale m2 m1)) + ((number? m2) (matrix:scale m1 m2)) + (else + (let ((mat1 (matrix->lists m1)) + (mat2 (matrix->lists m2))) + (define (dot-product v1 v2) (apply + (map * v1 v2))) + (coerce-like-arg + (map (lambda (arow) + (apply map + (lambda bcol (dot-product bcol arow)) + mat2)) + mat1) + m1))))) ;;@body ;;@1 must be a square matrix. -- cgit v1.2.3