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

math.matrices: adding hilbert-matrix, toeplitz-matrix, hankel-matrix, and box-matrix.

db4
John Benediktsson 2012-05-04 18:01:21 -07:00
parent 4cd54bdf9c
commit 495637a087
2 changed files with 40 additions and 7 deletions

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

@ -85,18 +85,39 @@ USING: math.matrices math.vectors tools.test math ;
4 3 -1 eye
] unit-test
[
{ { 1 1/2 1/3 1/4 }
{ 1/2 1/3 1/4 1/5 }
{ 1/3 1/4 1/5 1/6 }
}
] [ 3 4 hilbert-matrix ] unit-test
[
{ { 1 2 3 4 }
{ 2 1 2 3 }
{ 3 2 1 2 }
{ 4 3 2 1 } }
] [ 4 toeplitz-matrix ] unit-test
[
{ { 1 2 3 4 }
{ 2 3 4 0 }
{ 3 4 0 0 }
{ 4 0 0 0 } }
] [ 4 hankel-matrix ] unit-test
[
{ { 1 0 4 }
{ 0 7 0 }
{ 6 0 3 } }
{ 0 7 0 }
{ 6 0 3 } }
] [
{ { 1 0 0 }
{ 0 2 0 }
{ 0 0 3 } }
{ 0 2 0 }
{ 0 0 3 } }
{ { 0 0 4 }
{ 0 5 0 }
{ 6 0 0 } }
{ 0 5 0 }
{ 6 0 0 } }
m+
] unit-test

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

@ -19,6 +19,18 @@ IN: math.matrices
: eye ( m n k -- matrix )
[ [ iota ] bi@ ] dip neg '[ _ + = 1 0 ? ] cartesian-map ;
: hilbert-matrix ( m n -- matrix )
[ iota ] bi@ [ + 1 + recip ] cartesian-map ;
: toeplitz-matrix ( n -- matrix )
iota dup [ - abs 1 + ] cartesian-map ;
: hankel-matrix ( n -- matrix )
[ iota dup ] keep '[ + abs 1 + dup _ > [ drop 0 ] when ] cartesian-map ;
: box-matrix ( r -- matrix )
2 * 1 + dup '[ _ 1 <array> ] replicate ;
:: rotation-matrix3 ( axis theta -- matrix )
theta cos :> c
theta sin :> s