基于表:
( define ( accumulate op init seq )
( cond
[ ( null? seq ) init ]
[ else
( op ( car seq )
( accumulate op init ( cdr seq ) ) ) ] ) )
( define ( accumulate-n op init seqs )
( cond
[ ( null? ( car seqs ) ) ‘() ]
[ else
( cons ( accumulate op init ( map car seqs ) )
( accumulate-n op init ( map cdr seqs ) ) ) ] ) )
( define ( dot-product v m )
( accumulate + 0 ( map * v m ) ) )
( define ( mat-*-vec mat vec )
( map ( lambda ( row )( dot-product row vec ) ) mat ) )
( define ( transpose mat )
( accumulate-n cons ‘() mat ) )
( define ( mat-*-mat m n )
( let ( [ n ( transpose n ) ] )
( map ( lambda ( row )( mat-*-vec n row ) ) m ) ) )
基于vector:
#!r6rs
( import ( rnrs ) )
( define type-error
( lambda ( what )
( assertion-violation ‘mul "not a number or matrix" what ) ) )
( define match-error
( lambda ( what1 what2 )
( assertion-violation ‘mul "incompatible operands" what1 what2 ) ) )
( define make-matrix
( lambda ( rows cols )
( do ( [ mat ( make-vector rows ) ]
[ r 0 ( + r 1 ) ] )
( ( = r rows ) mat )
( vector-set! mat r ( make-vector cols ) ) ) ) )
( define matrix?
( lambda ( mat )
( and ( vector? mat )
( vector? ( vector-ref mat 0 ) )
( > ( vector-length mat ) 0 ) ) ) )
( define matrix-ref
( lambda ( mat row col )
( vector-ref ( vector-ref mat row ) col ) ) )
( define matrix-set!
( lambda ( mat row col val )
( vector-set! ( vector-ref mat row ) col val ) ) )
( define matrix-rows ( lambda ( mat )( vector-length mat ) ) )
( define matrix-cols ( lambda ( mat )( vector-length ( vector-ref mat 0 ) ) ) )
( define mat-*-vec
( lambda ( mat vec )
( let* ( [ rows ( matrix-rows mat ) ]
[ cols ( matrix-cols mat ) ]
[ res ( make-matrix rows cols ) ] )
( do ( [ r 0 ( + r 1 ) ] )
( ( = r rows ) res )
( do ( [ c 0 ( + c 1 ) ] )
( = c cols )
( vector-set! res r c ( * vec ( matrix-ref mat r c ) ) ) ) ) ) ) )
( define mat-*-mat
( lambda ( mat1 mat2 )
( let* ( [ rows1 ( matrix-rows mat1 ) ]
[ cols1 ( matrix-cols mat1 ) ]
[ rows2 ( matrix-rows mat2 ) ]
[ cols2 ( matrix-cols mat2 ) ]
[ res ( make-matrix rows1 cols2 ) ] )
( unless ( = cols1 rows2 )
( match-error mat1 mat2 ) )
( do ( [ r 0 ( + r 1 ) ] )
( ( = r rows1 ) res )
( do ( [ c 0 ( + c 1 ) ] )
( ( = c cols2 ) )
( do ( [ k 0 ( + k 1 ) ]
[ val 0 ( + val
( * ( matrix-ref mat1 r k )
( matrix-ref mat2 k c ) ) ) ] )
( ( = k rows2 )
( matrix-set! res r c val ) ) ) ) ) ) ) )
( define mul
( lambda ( x y )
( cond
[ ( number? x )
( cond
[ ( number? y )( * x y ) ]
[ ( matrix? y )( mat-*-vec y x ) ]
[ else ( type-error y ) ] ) ]
[ ( matrix? x )
( cond
[ ( number? y )( mat-*-vec x y ) ]
[ ( matrix? x )( mat-*-mat x y ) ]
[ else ( type-error x ) ] ) ]
[ else ( type-error x ) ] ) ) )