steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.matrices: Add stitch. Add Kronecker product.

db4
Doug Coleman 2012-05-24 08:52:50 -07:00
parent bad2d7e499
commit 78f1ca9f14
2 changed files with 48 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
basis/math/matrices/matrices-tests.factor
View File

@ -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

7
basis/math/matrices/matrices.factor
View File

@ -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 ;