math.matrices.laplace: adding Laplace expansion.

diff --git a/extra/math/matrices/laplace/authors.txt b/extra/math/matrices/laplace/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/extra/math/matrices/laplace/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/extra/math/matrices/laplace/laplace-tests.factor b/extra/math/matrices/laplace/laplace-tests.factor
new file mode 100644 (file)
index 0000000..e1c3a7f
--- /dev/null
+++ b/extra/math/matrices/laplace/laplace-tests.factor
@@ -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

diff --git a/extra/math/matrices/laplace/laplace.factor b/extra/math/matrices/laplace/laplace.factor
new file mode 100644 (file)
index 0000000..817fa89
--- /dev/null
+++ b/extra/math/matrices/laplace/laplace.factor
@@ -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 ;

diff --git a/extra/math/matrices/laplace/summary.txt b/extra/math/matrices/laplace/summary.txt
new file mode 100644 (file)
index 0000000..69bc31c
--- /dev/null
+++ b/extra/math/matrices/laplace/summary.txt
@@ -0,0 +1 @@
+Laplace expansion