363 lines
7.4 KiB
Factor
363 lines
7.4 KiB
Factor
! Copyright (C) 2005, 2010, 2018 Slava Pestov, Joe Groff, and Cat Stevens.
|
|
USING: arrays combinators.short-circuit grouping kernel math
|
|
math.matrices math.matrices.extras math.matrices.extras.private
|
|
math.statistics math.vectors sequences sequences.deep sets
|
|
tools.test ;
|
|
IN: math.matrices.extras
|
|
|
|
<PRIVATE
|
|
: call-eq? ( obj quots -- ? )
|
|
[ call( x -- x ) ] with map all-eq? ; ! inline
|
|
PRIVATE>
|
|
|
|
{ {
|
|
{ 4181 6765 }
|
|
{ 6765 10946 }
|
|
} } [
|
|
{ { 0 1 } { 1 1 } } 20 m^n
|
|
] unit-test
|
|
|
|
[ { { 0 1 } { 1 1 } } -20 m^n ] [ negative-power-matrix? ] must-fail-with
|
|
[ { { 0 1 } { 1 1 } } -8 m^n ] [ negative-power-matrix? ] must-fail-with
|
|
|
|
{ { 1 -2 3 -4 } } [ { 1 2 3 4 } t alternating-sign ] unit-test
|
|
{ { -1 2 -3 4 } } [ { 1 2 3 4 } f alternating-sign ] unit-test
|
|
|
|
|
|
{ t } [ 50 <box-matrix> dup transpose = ] unit-test
|
|
{ t } [ 50 <box-matrix> dup anti-transpose = ] unit-test
|
|
{ f } [ 4 <box-matrix> zero-matrix? ] unit-test
|
|
|
|
{ t } [ 2 4 15 <random-integer-matrix> mabs {
|
|
[ flatten [ 15 <= ] all? ]
|
|
[ regular-matrix? ]
|
|
[ length 2 = ]
|
|
[ first length 4 = ]
|
|
} 1&& ] unit-test
|
|
|
|
{ t } [ 4 4 -45 <random-integer-matrix> mabs {
|
|
[ flatten [ 45 <= ] all? ]
|
|
[ regular-matrix? ]
|
|
[ length 4 = ]
|
|
[ first length 4 = ]
|
|
} 1&& ] unit-test
|
|
|
|
{ t } [ 2 2 1 <random-integer-matrix> mabs {
|
|
[ flatten [ 1 <= ] all? ]
|
|
[ regular-matrix? ]
|
|
[ length 2 = ]
|
|
[ first length 2 = ]
|
|
} 1&& ] unit-test
|
|
|
|
{ t } [ 2 4 .89 <random-unit-matrix> mabs {
|
|
[ flatten [ .89 <= ] all? ]
|
|
[ regular-matrix? ]
|
|
[ length 2 = ]
|
|
[ first length 4 = ]
|
|
} 1&& ] unit-test
|
|
|
|
{ t } [ 2 4 -45.89 <random-unit-matrix> mabs {
|
|
[ flatten [ 45.89 <= ] all? ]
|
|
[ regular-matrix? ]
|
|
[ length 2 = ]
|
|
[ first length 4 = ]
|
|
} 1&& ] unit-test
|
|
|
|
{ t } [ 4 4 .89 <random-unit-matrix> mabs {
|
|
[ flatten [ .89 <= ] all? ]
|
|
[ regular-matrix? ]
|
|
[ length 4 = ]
|
|
[ first length 4 = ]
|
|
} 1&& ] 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 1 1 }
|
|
{ 4 2 1 }
|
|
{ 9 3 1 }
|
|
{ 25 5 1 } }
|
|
} [
|
|
{ 1 2 3 5 } 3 <vandermonde-matrix>
|
|
] 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 }
|
|
} kronecker-product ] unit-test
|
|
|
|
{ {
|
|
{ 1 1 1 1 }
|
|
{ 1 -1 1 -1 }
|
|
{ 1 1 -1 -1 }
|
|
{ 1 -1 -1 1 }
|
|
} } [ {
|
|
{ 1 1 }
|
|
{ 1 -1 }
|
|
} dup kronecker-product ] 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 kronecker-product kronecker-product ] 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 kronecker-product swap kronecker-product ] unit-test
|
|
|
|
|
|
! kronecker-product is not generally commutative, make sure we have the right order
|
|
{ {
|
|
{ 1 2 3 4 5 1 2 3 4 5 }
|
|
{ 6 7 8 9 10 6 7 8 9 10 }
|
|
{ 1 2 3 4 5 -1 -2 -3 -4 -5 }
|
|
{ 6 7 8 9 10 -6 -7 -8 -9 -10 }
|
|
} } [ {
|
|
{ 1 1 }
|
|
{ 1 -1 }
|
|
} {
|
|
{ 1 2 3 4 5 }
|
|
{ 6 7 8 9 10 }
|
|
} kronecker-product ] unit-test
|
|
|
|
{ {
|
|
{ 1 1 2 2 3 3 4 4 5 5 }
|
|
{ 1 -1 2 -2 3 -3 4 -4 5 -5 }
|
|
{ 6 6 7 7 8 8 9 9 10 10 }
|
|
{ 6 -6 7 -7 8 -8 9 -9 10 -10 }
|
|
} } [ {
|
|
{ 1 1 }
|
|
{ 1 -1 }
|
|
} {
|
|
{ 1 2 3 4 5 }
|
|
{ 6 7 8 9 10 }
|
|
} swap kronecker-product ] unit-test
|
|
|
|
{ {
|
|
{ 5 10 15 }
|
|
{ 6 12 18 }
|
|
{ 7 14 21 }
|
|
} } [
|
|
{ 5 6 7 }
|
|
{ 1 2 3 }
|
|
outer-product
|
|
] unit-test
|
|
|
|
|
|
CONSTANT: test-points {
|
|
{ 80 27 89 } { 80 27 88 } { 75 25 90 }
|
|
{ 62 24 87 } { 62 22 87 } { 62 23 87 }
|
|
{ 62 24 93 } { 62 24 93 } { 58 23 87 }
|
|
{ 58 18 80 } { 58 18 89 } { 58 17 88 }
|
|
{ 58 18 82 } { 58 19 93 } { 50 18 89 }
|
|
{ 50 18 86 } { 50 19 72 } { 50 19 79 }
|
|
{ 50 20 80 } { 56 20 82 } { 70 20 91 }
|
|
}
|
|
|
|
{ {
|
|
{ 84+2/35 22+23/35 24+4/7 }
|
|
{ 22+23/35 9+104/105 6+87/140 }
|
|
{ 24+4/7 6+87/140 28+5/7 }
|
|
} } [ test-points sample-covariance-matrix ] unit-test
|
|
|
|
{ {
|
|
{ 80+8/147 21+85/147 23+59/147 }
|
|
{ 21+85/147 9+227/441 6+15/49 }
|
|
{ 23+59/147 6+15/49 27+17/49 }
|
|
} } [ test-points covariance-matrix ] unit-test
|
|
|
|
{
|
|
{
|
|
{ 80+8/147 21+85/147 23+59/147 }
|
|
{ 21+85/147 9+227/441 6+15/49 }
|
|
{ 23+59/147 6+15/49 27+17/49 }
|
|
}
|
|
} [
|
|
test-points population-covariance-matrix
|
|
] unit-test
|
|
|
|
{ t } [ { { 1 } }
|
|
{ [ drop 1 ] [ (1determinant) ] [ 1 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ 0 } [ { { 0 } } determinant ] unit-test
|
|
|
|
{ t } [ {
|
|
{ 4 6 } ! order is significant
|
|
{ 3 8 }
|
|
} { [ drop 14 ] [ (2determinant) ] [ 2 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 3 8 }
|
|
{ 4 6 }
|
|
} { [ drop -14 ] [ (2determinant) ] [ 2 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 2 5 }
|
|
{ 1 -3 }
|
|
} { [ drop -11 ] [ (2determinant) ] [ 2 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 1 -3 }
|
|
{ 2 5 }
|
|
} { [ drop 11 ] [ (2determinant) ] [ 2 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 3 0 -1 }
|
|
{ 2 -5 4 }
|
|
{ -3 1 3 }
|
|
} { [ drop -44 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 3 0 -1 }
|
|
{ -3 1 3 }
|
|
{ 2 -5 4 }
|
|
} { [ drop 44 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 2 -3 1 }
|
|
{ 4 2 -1 }
|
|
{ -5 3 -2 }
|
|
} { [ drop -19 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 2 -3 1 }
|
|
{ -5 3 -2 }
|
|
{ 4 2 -1 }
|
|
} { [ drop 19 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 4 2 -1 }
|
|
{ 2 -3 1 }
|
|
{ -5 3 -2 }
|
|
} { [ drop 19 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 5 1 -2 }
|
|
{ -1 0 4 }
|
|
{ 2 -3 3 }
|
|
} { [ drop 65 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 6 1 1 }
|
|
{ 4 -2 5 }
|
|
{ 2 8 7 }
|
|
} { [ drop -306 ] [ (3determinant) ] [ 3 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ -5 4 -3 2 }
|
|
{ -2 1 0 -1 }
|
|
{ -2 -3 -4 -5 }
|
|
{ 0 2 0 4 }
|
|
} { [ drop -24 ] [ 4 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ t } [ {
|
|
{ 2 4 2 2 }
|
|
{ 5 1 -6 10 }
|
|
{ 4 3 -1 7 }
|
|
{ 9 8 7 3 }
|
|
} { [ drop 272 ] [ 4 swap (ndeterminant) ] [ determinant ] }
|
|
call-eq?
|
|
] unit-test
|
|
|
|
{ {
|
|
{ 2 2 2 }
|
|
{ -2 3 3 }
|
|
{ 0 -10 0 }
|
|
} } [ {
|
|
{ 3 0 2 }
|
|
{ 2 0 -2 }
|
|
{ 0 1 1 }
|
|
} >minors ] unit-test
|
|
|
|
! i think this unit test is wrong
|
|
! { {
|
|
! { 1 -6 -13 }
|
|
! { 0 0 0 }
|
|
! { 1 -6 -13 }
|
|
! } } [ {
|
|
! { 1 2 1 }
|
|
! { 6 -1 0 }
|
|
! { 1 -2 -1 }
|
|
! } >minors ] unit-test
|
|
|
|
{ {
|
|
{ 1 6 -13 }
|
|
{ 0 0 0 }
|
|
{ 1 6 -13 }
|
|
} } [ {
|
|
{ 1 -6 -13 }
|
|
{ 0 0 0 }
|
|
{ 1 -6 -13 }
|
|
} >cofactors ] unit-test
|