Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

math.matrices: Add stitch. Add Kronecker product.

  • Loading branch information...
commit 7f8d1cf58ef74c85a3e206890b0ce24938488364 1 parent 3cdbfe8
@erg erg authored
View
42 basis/math/matrices/matrices-tests.factor
@@ -1,5 +1,5 @@
+USING: math.matrices math.vectors tools.test math kernel ;
IN: math.matrices.tests
-USING: math.matrices math.vectors tools.test math ;
[
{ { 0 } { 0 } { 0 } }
@@ -199,3 +199,43 @@ USING: math.matrices math.vectors tools.test math ;
[ { { 4181 6765 } { 6765 10946 } } ]
[ { { 0 1 } { 1 1 } } 20 m^n ] unit-test
+
+{
+ { { 0 5 0 10 } { 6 7 12 14 } { 0 15 0 20 } { 18 21 24 28 } }
+}
+[ { { 1 2 } { 3 4 } } { { 0 5 } { 6 7 } } kron ] unit-test
+
+{
+ {
+ { 1 1 1 1 }
+ { 1 -1 1 -1 }
+ { 1 1 -1 -1 }
+ { 1 -1 -1 1 }
+ }
+} [ { { 1 1 } { 1 -1 } } dup kron ] unit-test
+
+{
+ {
+ { 1 1 1 1 1 1 1 1 }
+ { 1 -1 1 -1 1 -1 1 -1 }
+ { 1 1 -1 -1 1 1 -1 -1 }
+ { 1 -1 -1 1 1 -1 -1 1 }
+ { 1 1 1 1 -1 -1 -1 -1 }
+ { 1 -1 1 -1 -1 1 -1 1 }
+ { 1 1 -1 -1 -1 -1 1 1 }
+ { 1 -1 -1 1 -1 1 1 -1 }
+ }
+} [ { { 1 1 } { 1 -1 } } dup dup kron kron ] unit-test
+
+{
+ {
+ { 1 1 1 1 1 1 1 1 }
+ { 1 -1 1 -1 1 -1 1 -1 }
+ { 1 1 -1 -1 1 1 -1 -1 }
+ { 1 -1 -1 1 1 -1 -1 1 }
+ { 1 1 1 1 -1 -1 -1 -1 }
+ { 1 -1 1 -1 -1 1 -1 1 }
+ { 1 1 -1 -1 -1 -1 1 1 }
+ { 1 -1 -1 1 -1 1 1 -1 }
+ }
+} [ { { 1 1 } { 1 -1 } } dup dup kron swap kron ] unit-test
View
7 basis/math/matrices/matrices.factor
@@ -156,3 +156,10 @@ IN: math.matrices
: m^n ( m n -- n )
make-bits over first length identity-matrix
[ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
+
+
+: stitch ( m -- m' )
+ [ ] [ [ append ] 2map ] map-reduce ;
+
+: kron ( m1 m2 -- m )
+ '[ [ _ n*m ] map ] map stitch stitch ;

0 comments on commit 7f8d1cf

Please sign in to comment.
Something went wrong with that request. Please try again.