diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index 2d374b2d2e..693205c16a 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -79,6 +79,9 @@ M: sequence (tree-each) [ (tree-each) ] seq-each-with ; : seq-map ( seq quot -- seq | quot: elt -- elt ) swap [ swap nmap ] immutable ; inline +: seq-map-with ( obj list quot -- list ) + swap [ with rot ] seq-map 2nip ; inline + : (2nmap) ( seq1 seq2 i quot -- elt3 ) pick pick >r >r >r 2nth r> call r> r> swap set-nth ; inline @@ -89,7 +92,7 @@ M: sequence (tree-each) [ (tree-each) ] seq-each-with ; ] repeat 3drop ; inline : seq-2map ( seq1 seq2 quot -- seq | quot: elt1 elt2 -- elt3 ) - >r clone r> over >r 2nmap r> ; inline + swap [ swap 2nmap ] immutable ; inline ! Operations : index* ( obj i seq -- n ) diff --git a/library/math/matrices.factor b/library/math/matrices.factor index 24b9fd3fde..a31b5f7fc0 100644 --- a/library/math/matrices.factor +++ b/library/math/matrices.factor @@ -4,19 +4,29 @@ IN: matrices USING: errors generic kernel lists math namespaces prettyprint sequences stdio test vectors ; -! Vector and matrix math use these generics. +! The major dimension is the number of elements per row. +TUPLE: matrix rows cols sequence ; + +! Vector and matrix protocol. GENERIC: v+ GENERIC: v- GENERIC: v* ( element-wise multiplication ) GENERIC: v. ( interior multiplication ) +: v*n ( vec n -- vec ) swap [ * ] seq-map-with ; + ! On numbers, these operations do the obvious thing M: number v+ ( n n -- n ) + ; M: number v- ( n n -- n ) - ; M: number v* ( n n -- n ) * ; -M: number v. ( n n -- n ) * ; + +M: number v. ( n n -- n ) + over vector? [ v*n ] [ * ] ifte ; ! Vector operations +DEFER: +DEFER: + M: object v+ ( v v -- v ) [ v+ ] seq-2map ; M: object v- ( v v -- v ) [ v- ] seq-2map ; M: object v* ( v v -- v ) [ v* ] seq-2map ; @@ -24,12 +34,15 @@ M: object v* ( v v -- v ) [ v* ] seq-2map ; ! Later, this will fixed when seq-2each works properly ! M: object v. ( v v -- x ) 0 swap [ * + ] seq-2each ; : +/ ( seq -- n ) 0 swap [ + ] seq-each ; -M: object v. ( v v -- x ) v* +/ ; -! Matrices. -! The major dimension is the number of elements per row. -TUPLE: matrix rows cols sequence ; +GENERIC: vv. ( obj v -- v ) +M: number vv. ( v n -- v ) v*n ; +M: matrix vv. ( v m -- v ) + swap v. matrix-sequence ; +M: object vv. v* +/ ; +M: object v. ( v v -- x ) swap vv. ; +! Matrices M: matrix clone ( matrix -- matrix ) clone-tuple dup matrix-sequence clone over set-matrix-sequence ; @@ -45,6 +58,14 @@ M: matrix clone ( matrix -- matrix ) : ( rows cols -- matrix ) 2dup * zero-vector ; +: ( vector -- matrix ) + #! Turn a vector into a matrix of one row. + [ 1 swap length ] keep ; + +: ( vector -- matrix ) + #! Turn a vector into a matrix of one column. + [ length 1 ] keep ; + : 2repeat ( i j quot -- | quot: i j -- i j ) rot [ rot [ [ rot dup slip -rot ] repeat ] keep -rot @@ -79,7 +100,8 @@ SYMBOL: matrix-maker TUPLE: row index matrix ; : >row< dup row-index swap row-matrix ; M: row length row-matrix matrix-cols ; -M: row nth ( n row -- ) >row< matrix-get ; +M: row nth ( n row -- ) >row< swapd matrix-get ; +M: row thaw >vector ; ! A sequence of rows. TUPLE: row-seq matrix ; @@ -91,6 +113,7 @@ TUPLE: col index matrix ; : >col< dup col-index swap col-matrix ; M: col length col-matrix matrix-rows ; M: col nth ( n column -- ) >col< swapd matrix-get ; +M: col thaw >vector ; ! A sequence of columns. TUPLE: col-seq matrix ; @@ -128,6 +151,7 @@ M: matrix v* ( m m -- m ) matrix+/- v* ; M: matrix v. ( m1 m2 -- m ) 2dup *dimensions [ + ( m1 m2 row col ) >r >r 2dup r> rot r> rot v. ] make-matrix 2nip ; @@ -136,8 +160,9 @@ M: matrix v. ( m1 m2 -- m ) : M[ f ; parsing : ]M - reverse [ dup car length swap length ] keep - [ [ % ] each ] make-vector swons ; parsing + reverse + [ dup length swap car length ] keep + concat >vector swons ; parsing : row-list ( matrix -- list ) #! A list of lists, where each sublist is a row of the diff --git a/library/test/math/matrices.factor b/library/test/math/matrices.factor new file mode 100644 index 0000000000..d47dc70359 --- /dev/null +++ b/library/test/math/matrices.factor @@ -0,0 +1,77 @@ +IN: temporary +USING: matrices test ; + +[ + M[ [ 0 ] [ 0 ] [ 0 ] ]M +] [ + 3 1 +] unit-test + +[ + M[ [ 1 ] [ 2 ] [ 3 ] ]M +] [ + { 1 2 3 } +] unit-test + +[ + M[ [ 1 0 0 ] + [ 0 1 0 ] + [ 0 0 1 ] ]M +] [ + 3 +] unit-test + +[ + M[ [ 1 0 4 ] + [ 0 7 0 ] + [ 6 0 3 ] ]M +] [ + M[ [ 1 0 0 ] + [ 0 2 0 ] + [ 0 0 3 ] ]M + + M[ [ 0 0 4 ] + [ 0 5 0 ] + [ 6 0 0 ] ]M + + v+ +] unit-test + +[ + M[ [ 1 0 4 ] + [ 0 7 0 ] + [ 6 0 3 ] ]M +] [ + M[ [ 1 0 0 ] + [ 0 2 0 ] + [ 0 0 3 ] ]M + + M[ [ 0 0 -4 ] + [ 0 -5 0 ] + [ -6 0 0 ] ]M + + v- +] unit-test + +[ + { 10 20 30 } +] [ + 10 { 1 2 3 } v. +] unit-test + +[ + { 10 20 30 } +] [ + { 1 2 3 } 10 v. +] unit-test + +[ + { 3 4 } +] [ + M[ [ 1 0 ] + [ 0 1 ] ]M + + { 3 4 } + + v. +] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index c56efaa325..2a2038ef15 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -70,6 +70,7 @@ SYMBOL: failures "stream" "math/bitops" "math/math-combinators" "math/rational" "math/float" "math/complex" "math/irrational" "math/integer" + "math/matrices" "httpd/url-encoding" "httpd/html" "httpd/httpd" "crashes" "sbuf" "threads" "parsing-word" "inference" "dataflow" "interpreter" "alien"