math.matrices.laplace: adding Laplace expansion.
parent
57b7a5fd6f
commit
00eeb07680
|
@ -0,0 +1 @@
|
||||||
|
Doug Coleman
|
|
@ -0,0 +1,19 @@
|
||||||
|
! Copyright (C) 2013 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test kernel ;
|
||||||
|
IN: math.matrices.laplace
|
||||||
|
|
||||||
|
{ -2 } [ { { 1 2 } { 3 4 } } determinant ] unit-test
|
||||||
|
|
||||||
|
{ 0 } [
|
||||||
|
{ { 1 2 3 } { 4 5 6 } { 7 8 9 } } determinant
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
{ -47860032 } [
|
||||||
|
{
|
||||||
|
{ 40 39 38 37 }
|
||||||
|
{ 1 1 1 831 }
|
||||||
|
{ 22 22 1110 299 }
|
||||||
|
{ 13 14 15 17 }
|
||||||
|
} determinant
|
||||||
|
] unit-test
|
|
@ -0,0 +1,40 @@
|
||||||
|
! Copyright (C) 2013 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors arrays fry kernel locals math math.matrices
|
||||||
|
math.vectors sequences sequences.private ;
|
||||||
|
IN: math.matrices.laplace
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: 2x2-determinant ( matrix -- x )
|
||||||
|
first2 [ first2 ] bi@ -rot [ * ] 2bi@ - ;
|
||||||
|
|
||||||
|
! using a virtual "missing element" sequence for performance
|
||||||
|
TUPLE: missing seq i ;
|
||||||
|
C: <missing> missing
|
||||||
|
M: missing nth-unsafe
|
||||||
|
[ i>> dupd >= [ 1 + ] when ] [ seq>> nth-unsafe ] bi ;
|
||||||
|
M: missing length seq>> length 1 - ;
|
||||||
|
INSTANCE: missing immutable-sequence
|
||||||
|
|
||||||
|
: first-sub-matrix ( matrix -- first-row seq )
|
||||||
|
[ unclip-slice swap ] [ length iota ] bi
|
||||||
|
[ '[ _ <missing> ] map ] with map ;
|
||||||
|
|
||||||
|
:: laplace-expansion ( row matrix -- x )
|
||||||
|
matrix length 2 =
|
||||||
|
[ matrix 2x2-determinant ] [
|
||||||
|
matrix first-sub-matrix ! cheat, always expand on first row
|
||||||
|
[ row swap laplace-expansion ] map
|
||||||
|
v* [ odd? [ neg ] when ] map-index sum
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
ERROR: not-a-square-matrix matrix ;
|
||||||
|
|
||||||
|
: check-square-matrix ( matrix -- matrix )
|
||||||
|
dup square-matrix? [ not-a-square-matrix ] unless ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: determinant ( matrix -- x )
|
||||||
|
check-square-matrix 0 swap laplace-expansion ;
|
|
@ -0,0 +1 @@
|
||||||
|
Laplace expansion
|
Loading…
Reference in New Issue