From 242cbda33c815d2a0d11e247e6f7a799e2764bdd Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Fri, 13 Dec 2019 20:10:55 -0500 Subject: Add (net ricketyspace sicp two thirtyseven). --- net/ricketyspace/sicp/two/thirtyseven.scm | 40 +++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 net/ricketyspace/sicp/two/thirtyseven.scm diff --git a/net/ricketyspace/sicp/two/thirtyseven.scm b/net/ricketyspace/sicp/two/thirtyseven.scm new file mode 100644 index 0000000..19e38b3 --- /dev/null +++ b/net/ricketyspace/sicp/two/thirtyseven.scm @@ -0,0 +1,40 @@ +;;;; License: CC0-1.0 + +(define-module (net ricketyspace sicp two thirtyseven) + #:use-module (net ricketyspace sicp two thirtysix) + #:export (dot-product + matrix-*-vector + transpose + matrix-*-matrix)) + +(define (accumulate op initial sequence) + (if (null? sequence) + initial + (op (car sequence) + (accumulate op initial (cdr sequence))))) + +(define (dot-product v w) + (accumulate + 0 (map * v w))) + +(define (matrix-*-vector m v) + (map (lambda (r) (dot-product r v)) m)) + +(define (transpose mat) + (accumulate-n cons '() mat)) + +(define (matrix-*-matrix m n) + (let ((cols (transpose n))) + (map (lambda (row) + (matrix-*-vector cols row)) m))) + +;;; Guile REPL +;;; +;;; scheme@(guile-user)> ,re (net ricketyspace sicp two thirtyseven) +;;; scheme@(guile-user)> (dot-product '(1 2 3) '(4 5 6)) +;;; $14 = 32 +;;; scheme@(guile-user)> (matrix-*-vector '((1 2 3) (3 2 1) (1 2 3)) '(1 10 100)) +;;; $15 = (321 123 321) +;;; scheme@(guile-user)> (transpose '((1 2 3 4) (4 5 6 6) (6 7 8 9))) +;;; $16 = ((1 4 6) (2 5 7) (3 6 8) (4 6 9)) +;;; scheme@(guile-user)> (matrix-*-matrix '((1 2 3) (3 2 1) (1 2 3)) '((4 5 6) (6 5 4) (4 6 5))) +;;; $17 = ((28 33 29) (28 31 31) (28 33 29)) -- cgit v1.2.3