Move math.matrices to basis

diff --git a/basis/math/matrices/authors.txt b/basis/math/matrices/authors.txt
new file mode 100644 (file)
index 0000000..1901f27
--- /dev/null
+++ b/basis/math/matrices/authors.txt
@@ -0,0 +1 @@
+Slava Pestov

diff --git a/basis/math/matrices/elimination/authors.txt b/basis/math/matrices/elimination/authors.txt
new file mode 100644 (file)
index 0000000..1901f27
--- /dev/null
+++ b/basis/math/matrices/elimination/authors.txt
@@ -0,0 +1 @@
+Slava Pestov

diff --git a/basis/math/matrices/elimination/elimination-tests.factor b/basis/math/matrices/elimination/elimination-tests.factor
new file mode 100644 (file)
index 0000000..7c83339
--- /dev/null
+++ b/basis/math/matrices/elimination/elimination-tests.factor
@@ -0,0 +1,168 @@
+IN: math.matrices.elimination.tests
+USING: kernel math.matrices math.matrices.elimination
+tools.test sequences ;
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 1 0 }
+        { 0 0 0 1 }
+    }
+] [
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 1 0 }
+        { 0 0 0 1 }
+    } echelon
+] unit-test
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 1 0 }
+        { 0 0 0 1 }
+    }
+] [
+    {
+        { 1 0 0 0 }
+        { 1 1 0 0 }
+        { 1 0 1 0 }
+        { 1 0 0 1 }
+    } echelon
+] unit-test
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 1 0 }
+        { 0 0 0 1 }
+    }
+] [
+    {
+        { 1 0 0 0 }
+        { 1 1 0 0 }
+        { 1 0 1 0 }
+        { 1 1 0 1 }
+    } echelon
+] unit-test
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 1 0 }
+        { 0 0 0 1 }
+    }
+] [
+    {
+        { 1 0 0 0 }
+        { 1 1 0 0 }
+        { 1 1 0 1 }
+        { 1 0 1 0 }
+    } echelon
+] unit-test
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 0 0 }
+        { 0 0 0 0 }
+    }
+] [
+    {
+        { 0 1 0 0 }
+        { 1 0 0 0 }
+        { 1 0 0 0 }
+        { 1 0 0 0 }
+    } [
+        [ 1 ] [ 0 0 pivot-row ] unit-test
+        1 0 do-row
+    ] with-matrix
+] unit-test
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 0 0 }
+        { 0 0 0 0 }
+    }
+] [
+    {
+        { 0 1 0 0 }
+        { 1 0 0 0 }
+        { 1 0 0 0 }
+        { 1 0 0 0 }
+    } echelon
+] unit-test
+
+[
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 0 0 0 1 }
+        { 0 0 0 0 }
+    }
+] [
+    {
+        { 1 0 0 0 }
+        { 0 1 0 0 }
+        { 1 0 0 1 }
+        { 1 0 0 1 }
+    } echelon
+] unit-test
+
+[
+    {
+        { 1 0 0 1 }
+        { 0 1 0 1 }
+        { 0 0 0 -1 }
+        { 0 0 0 0 }
+    }
+] [
+    {
+        { 0 1 0 1 }
+        { 1 0 0 1 }
+        { 1 0 0 0 }
+        { 1 1 0 1 }
+    } echelon
+] unit-test
+
+[
+    2
+] [
+    {
+        { 0 0 }
+        { 0 0 }
+    } nullspace length
+] unit-test
+
+[
+    1 3
+] [
+    {
+        { 0 1 0 1 }
+        { 1 0 0 1 }
+        { 1 0 0 0 }
+        { 1 1 0 1 }
+    } null/rank
+] unit-test
+
+[
+    1 3
+] [
+    {
+        { 0 0 0 0 0 1 0 1 }
+        { 0 0 0 0 1 0 0 1 }
+        { 0 0 0 0 1 0 0 0 }
+        { 0 0 0 0 1 1 0 1 }
+    } null/rank
+] unit-test
+
+[ { { 1 0 -1 } { 0 1 2 } } ]
+[ { { 1 2 3 } { 4 5 6 } } solution ] unit-test

diff --git a/basis/math/matrices/elimination/elimination.factor b/basis/math/matrices/elimination/elimination.factor
new file mode 100755 (executable)
index 0000000..0368dd5
--- /dev/null
+++ b/basis/math/matrices/elimination/elimination.factor
@@ -0,0 +1,114 @@
+! Copyright (C) 2006, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.vectors math.matrices namespaces
+sequences ;
+IN: math.matrices.elimination
+
+SYMBOL: matrix
+
+: with-matrix ( matrix quot -- )
+    [ swap matrix set call matrix get ] with-scope ; inline
+
+: nth-row ( row# -- seq ) matrix get nth ;
+
+: change-row ( row# quot: ( seq -- seq ) -- )
+    matrix get swap change-nth ; inline
+
+: exchange-rows ( row# row# -- ) matrix get exchange ;
+
+: rows ( -- n ) matrix get length ;
+
+: cols ( -- n ) 0 nth-row length ;
+
+: skip ( i seq quot -- n )
+    over [ find-from drop ] dip length or ; inline
+
+: first-col ( row# -- n )
+    #! First non-zero column
+    0 swap nth-row [ zero? not ] skip ;
+
+: clear-scale ( col# pivot-row i-row -- n )
+    [ over ] dip nth dup zero? [
+        3drop 0
+    ] [
+        [ nth dup zero? ] dip swap [
+            2drop 0
+        ] [
+            swap / neg
+        ] if
+    ] if ;
+
+: (clear-col) ( col# pivot-row i -- )
+    [ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ;
+
+: rows-from ( row# -- slice )
+    rows dup <slice> ;
+
+: clear-col ( col# row# rows -- )
+    [ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ;
+
+: do-row ( exchange-with row# -- )
+    [ exchange-rows ] keep
+    [ first-col ] keep
+    dup 1+ rows-from clear-col ;
+
+: find-row ( row# quot -- i elt )
+    [ rows-from ] dip find ; inline
+
+: pivot-row ( col# row# -- n )
+    [ dupd nth-row nth zero? not ] find-row 2nip ;
+
+: (echelon) ( col# row# -- )
+    over cols < over rows < and [
+        2dup pivot-row [ over do-row 1+ ] when*
+        [ 1+ ] dip (echelon)
+    ] [
+        2drop
+    ] if ;
+
+: echelon ( matrix -- matrix' )
+    [ 0 0 (echelon) ] with-matrix ;
+
+: nonzero-rows ( matrix -- matrix' )
+    [ [ zero? ] all? not ] filter ;
+
+: null/rank ( matrix -- null rank )
+    echelon dup length swap nonzero-rows length [ - ] keep ;
+
+: leading ( seq -- n elt ) [ zero? not ] find ;
+
+: reduced ( matrix' -- matrix'' )
+    [
+        rows <reversed> [
+            dup nth-row leading drop
+            dup [ swap dup clear-col ] [ 2drop ] if
+        ] each
+    ] with-matrix ;
+
+: basis-vector ( row col# -- )
+    [ clone ] dip
+    [ swap nth neg recip ] 2keep
+    [ 0 spin set-nth ] 2keep
+    [ n*v ] dip
+    matrix get set-nth ;
+
+: nullspace ( matrix -- seq )
+    echelon reduced dup empty? [
+        dup first length identity-matrix [
+            [
+                dup leading drop
+                dup [ basis-vector ] [ 2drop ] if
+            ] each
+        ] with-matrix flip nonzero-rows
+    ] unless ;
+
+: 1-pivots ( matrix -- matrix )
+    [ dup leading nip [ recip v*n ] when* ] map ;
+
+: solution ( matrix -- matrix )
+    echelon nonzero-rows reduced 1-pivots ;
+
+: inverse ( matrix -- matrix ) ! Assumes an invertible matrix
+    dup length
+    [ identity-matrix [ append ] 2map solution ] keep
+    [ tail ] curry map ;

diff --git a/basis/math/matrices/elimination/summary.txt b/basis/math/matrices/elimination/summary.txt
new file mode 100644 (file)
index 0000000..83972ab
--- /dev/null
+++ b/basis/math/matrices/elimination/summary.txt
@@ -0,0 +1 @@
+Solving systems of linear equations

diff --git a/basis/math/matrices/matrices-tests.factor b/basis/math/matrices/matrices-tests.factor
new file mode 100644 (file)
index 0000000..2094235
--- /dev/null
+++ b/basis/math/matrices/matrices-tests.factor
@@ -0,0 +1,109 @@
+IN: math.matrices.tests
+USING: math.matrices math.vectors tools.test math ;
+
+[
+    { { 0 } { 0 } { 0 } }
+] [
+    3 1 zero-matrix
+] unit-test
+
+[
+    { { 1 0 0 }
+       { 0 1 0 }
+       { 0 0 1 } }
+] [
+    3 identity-matrix
+] unit-test
+
+[
+    { { 1 0 4 }
+       { 0 7 0 }
+       { 6 0 3 } }
+] [
+    { { 1 0 0 }
+       { 0 2 0 }
+       { 0 0 3 } }
+       
+    { { 0 0 4 }
+       { 0 5 0 }
+       { 6 0 0 } }
+
+    m+
+] unit-test
+
+[
+    { { 1 0 4 }
+       { 0 7 0 }
+       { 6 0 3 } }
+] [
+    { { 1 0 0 }
+       { 0 2 0 }
+       { 0 0 3 } }
+       
+    { { 0 0 -4 }
+       { 0 -5 0 }
+       { -6 0 0 } }
+
+    m-
+] unit-test
+
+[
+    { 10 20 30 }
+] [
+    10 { 1 2 3 } n*v
+] unit-test
+
+[
+    { 3 4 }
+] [
+    { { 1 0 }
+       { 0 1 } }
+
+    { 3 4 }
+
+    m.v
+] unit-test
+
+[
+    { 4 3 }
+] [
+    { { 0 1 }
+       { 1 0 } }
+
+    { 3 4 }
+
+    m.v
+] unit-test
+
+[
+    { { 6 } }
+] [
+    { { 3 } } { { 2 } } m.
+] unit-test
+
+[
+    { { 11 } }
+] [
+    { { 1 3 } } { { 5 } { 2 } } m.
+] unit-test
+
+[
+    { { 28 } }
+] [
+    { { 2 4 6 } }
+
+    { { 1 }
+       { 2 }
+       { 3 } }
+    
+    m.
+] unit-test
+
+[ { 0 0 -1 } ] [ { 1 0 0 } { 0 1 0 } cross ] unit-test
+[ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
+[ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
+
+[ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test
+
+[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
+[ { 1 2 } { "a" "b" } cross-zip ] unit-test
\ No newline at end of file

diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor
new file mode 100755 (executable)
index 0000000..7c687d7
--- /dev/null
+++ b/basis/math/matrices/matrices.factor
@@ -0,0 +1,62 @@
+! Copyright (C) 2005, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math math.order math.vectors sequences ;
+IN: math.matrices
+
+! Matrices
+: zero-matrix ( m n -- matrix )
+    [ nip 0 <array> ] curry map ;
+
+: identity-matrix ( n -- matrix )
+    #! Make a nxn identity matrix.
+    dup [ [ = 1 0 ? ] with map ] curry map ;
+
+! Matrix operations
+: mneg ( m -- m ) [ vneg ] map ;
+
+: n*m ( n m -- m ) [ n*v ] with map ;
+: m*n ( m n -- m ) [ v*n ] curry map ;
+: n/m ( n m -- m ) [ n/v ] with map ;
+: m/n ( m n -- m ) [ v/n ] curry map ;
+
+: m+   ( m m -- m ) [ v+ ] 2map ;
+: m-   ( m m -- m ) [ v- ] 2map ;
+: m*   ( m m -- m ) [ v* ] 2map ;
+: m/   ( m m -- m ) [ v/ ] 2map ;
+
+: v.m ( v m -- v ) flip [ v. ] with map ;
+: m.v ( m v -- v ) [ v. ] curry map ;
+: m.  ( m m -- m ) flip [ swap m.v ] curry map ;
+
+: mmin ( m -- n ) [ 1/0. ] dip [ [ min ] each ] each ;
+: mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ;
+: mnorm ( m -- n ) dup mmax abs m/n ;
+
+<PRIVATE
+
+: x ( seq -- elt ) first ; inline
+: y ( seq -- elt ) second ; inline
+: z ( seq -- elt ) third ; inline
+
+: i ( seq1 seq2 -- n ) [ [ y ] [ z ] bi* * ] [ [ z ] [ y ] bi* * ] 2bi - ;
+: j ( seq1 seq2 -- n ) [ [ z ] [ x ] bi* * ] [ [ x ] [ z ] bi* * ] 2bi - ;
+: k ( seq1 seq2 -- n ) [ [ y ] [ x ] bi* * ] [ [ x ] [ y ] bi* * ] 2bi - ;
+
+PRIVATE>
+
+: cross ( vec1 vec2 -- vec3 ) [ i ] [ j ] [ k ] 2tri 3array ;
+
+: proj ( v u -- w )
+    [ [ v. ] [ norm-sq ] bi / ] keep n*v ;
+
+: (gram-schmidt) ( v seq -- newseq )
+    [ dupd proj v- ] each ;
+
+: gram-schmidt ( seq -- orthogonal )
+    V{ } clone [ over (gram-schmidt) over push ] reduce ;
+
+: norm-gram-schmidt ( seq -- orthonormal )
+    gram-schmidt [ normalize ] map ;
+
+: cross-zip ( seq1 seq2 -- seq1xseq2 )
+    [ [ 2array ] with map ] curry map ;
\ No newline at end of file

diff --git a/basis/math/matrices/summary.txt b/basis/math/matrices/summary.txt
new file mode 100644 (file)
index 0000000..0e9fa9a
--- /dev/null
+++ b/basis/math/matrices/summary.txt
@@ -0,0 +1 @@
+Matrix arithmetic

diff --git a/extra/math/matrices/authors.txt b/extra/math/matrices/authors.txt
deleted file mode 100644 (file)
index 1901f27..0000000
--- a/extra/math/matrices/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov

diff --git a/extra/math/matrices/elimination/authors.txt b/extra/math/matrices/elimination/authors.txt
deleted file mode 100644 (file)
index 1901f27..0000000
--- a/extra/math/matrices/elimination/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov

diff --git a/extra/math/matrices/elimination/elimination-tests.factor b/extra/math/matrices/elimination/elimination-tests.factor
deleted file mode 100644 (file)
index 7c83339..0000000
--- a/extra/math/matrices/elimination/elimination-tests.factor
+++ /dev/null
@@ -1,168 +0,0 @@
-IN: math.matrices.elimination.tests
-USING: kernel math.matrices math.matrices.elimination
-tools.test sequences ;
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 1 0 }
-        { 0 0 0 1 }
-    }
-] [
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 1 0 }
-        { 0 0 0 1 }
-    } echelon
-] unit-test
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 1 0 }
-        { 0 0 0 1 }
-    }
-] [
-    {
-        { 1 0 0 0 }
-        { 1 1 0 0 }
-        { 1 0 1 0 }
-        { 1 0 0 1 }
-    } echelon
-] unit-test
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 1 0 }
-        { 0 0 0 1 }
-    }
-] [
-    {
-        { 1 0 0 0 }
-        { 1 1 0 0 }
-        { 1 0 1 0 }
-        { 1 1 0 1 }
-    } echelon
-] unit-test
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 1 0 }
-        { 0 0 0 1 }
-    }
-] [
-    {
-        { 1 0 0 0 }
-        { 1 1 0 0 }
-        { 1 1 0 1 }
-        { 1 0 1 0 }
-    } echelon
-] unit-test
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 0 0 }
-        { 0 0 0 0 }
-    }
-] [
-    {
-        { 0 1 0 0 }
-        { 1 0 0 0 }
-        { 1 0 0 0 }
-        { 1 0 0 0 }
-    } [
-        [ 1 ] [ 0 0 pivot-row ] unit-test
-        1 0 do-row
-    ] with-matrix
-] unit-test
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 0 0 }
-        { 0 0 0 0 }
-    }
-] [
-    {
-        { 0 1 0 0 }
-        { 1 0 0 0 }
-        { 1 0 0 0 }
-        { 1 0 0 0 }
-    } echelon
-] unit-test
-
-[
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 0 0 0 1 }
-        { 0 0 0 0 }
-    }
-] [
-    {
-        { 1 0 0 0 }
-        { 0 1 0 0 }
-        { 1 0 0 1 }
-        { 1 0 0 1 }
-    } echelon
-] unit-test
-
-[
-    {
-        { 1 0 0 1 }
-        { 0 1 0 1 }
-        { 0 0 0 -1 }
-        { 0 0 0 0 }
-    }
-] [
-    {
-        { 0 1 0 1 }
-        { 1 0 0 1 }
-        { 1 0 0 0 }
-        { 1 1 0 1 }
-    } echelon
-] unit-test
-
-[
-    2
-] [
-    {
-        { 0 0 }
-        { 0 0 }
-    } nullspace length
-] unit-test
-
-[
-    1 3
-] [
-    {
-        { 0 1 0 1 }
-        { 1 0 0 1 }
-        { 1 0 0 0 }
-        { 1 1 0 1 }
-    } null/rank
-] unit-test
-
-[
-    1 3
-] [
-    {
-        { 0 0 0 0 0 1 0 1 }
-        { 0 0 0 0 1 0 0 1 }
-        { 0 0 0 0 1 0 0 0 }
-        { 0 0 0 0 1 1 0 1 }
-    } null/rank
-] unit-test
-
-[ { { 1 0 -1 } { 0 1 2 } } ]
-[ { { 1 2 3 } { 4 5 6 } } solution ] unit-test

diff --git a/extra/math/matrices/elimination/elimination.factor b/extra/math/matrices/elimination/elimination.factor
deleted file mode 100755 (executable)
index 0368dd5..0000000
--- a/extra/math/matrices/elimination/elimination.factor
+++ /dev/null
@@ -1,114 +0,0 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.vectors math.matrices namespaces
-sequences ;
-IN: math.matrices.elimination
-
-SYMBOL: matrix
-
-: with-matrix ( matrix quot -- )
-    [ swap matrix set call matrix get ] with-scope ; inline
-
-: nth-row ( row# -- seq ) matrix get nth ;
-
-: change-row ( row# quot: ( seq -- seq ) -- )
-    matrix get swap change-nth ; inline
-
-: exchange-rows ( row# row# -- ) matrix get exchange ;
-
-: rows ( -- n ) matrix get length ;
-
-: cols ( -- n ) 0 nth-row length ;
-
-: skip ( i seq quot -- n )
-    over [ find-from drop ] dip length or ; inline
-
-: first-col ( row# -- n )
-    #! First non-zero column
-    0 swap nth-row [ zero? not ] skip ;
-
-: clear-scale ( col# pivot-row i-row -- n )
-    [ over ] dip nth dup zero? [
-        3drop 0
-    ] [
-        [ nth dup zero? ] dip swap [
-            2drop 0
-        ] [
-            swap / neg
-        ] if
-    ] if ;
-
-: (clear-col) ( col# pivot-row i -- )
-    [ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ;
-
-: rows-from ( row# -- slice )
-    rows dup <slice> ;
-
-: clear-col ( col# row# rows -- )
-    [ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ;
-
-: do-row ( exchange-with row# -- )
-    [ exchange-rows ] keep
-    [ first-col ] keep
-    dup 1+ rows-from clear-col ;
-
-: find-row ( row# quot -- i elt )
-    [ rows-from ] dip find ; inline
-
-: pivot-row ( col# row# -- n )
-    [ dupd nth-row nth zero? not ] find-row 2nip ;
-
-: (echelon) ( col# row# -- )
-    over cols < over rows < and [
-        2dup pivot-row [ over do-row 1+ ] when*
-        [ 1+ ] dip (echelon)
-    ] [
-        2drop
-    ] if ;
-
-: echelon ( matrix -- matrix' )
-    [ 0 0 (echelon) ] with-matrix ;
-
-: nonzero-rows ( matrix -- matrix' )
-    [ [ zero? ] all? not ] filter ;
-
-: null/rank ( matrix -- null rank )
-    echelon dup length swap nonzero-rows length [ - ] keep ;
-
-: leading ( seq -- n elt ) [ zero? not ] find ;
-
-: reduced ( matrix' -- matrix'' )
-    [
-        rows <reversed> [
-            dup nth-row leading drop
-            dup [ swap dup clear-col ] [ 2drop ] if
-        ] each
-    ] with-matrix ;
-
-: basis-vector ( row col# -- )
-    [ clone ] dip
-    [ swap nth neg recip ] 2keep
-    [ 0 spin set-nth ] 2keep
-    [ n*v ] dip
-    matrix get set-nth ;
-
-: nullspace ( matrix -- seq )
-    echelon reduced dup empty? [
-        dup first length identity-matrix [
-            [
-                dup leading drop
-                dup [ basis-vector ] [ 2drop ] if
-            ] each
-        ] with-matrix flip nonzero-rows
-    ] unless ;
-
-: 1-pivots ( matrix -- matrix )
-    [ dup leading nip [ recip v*n ] when* ] map ;
-
-: solution ( matrix -- matrix )
-    echelon nonzero-rows reduced 1-pivots ;
-
-: inverse ( matrix -- matrix ) ! Assumes an invertible matrix
-    dup length
-    [ identity-matrix [ append ] 2map solution ] keep
-    [ tail ] curry map ;

diff --git a/extra/math/matrices/elimination/summary.txt b/extra/math/matrices/elimination/summary.txt
deleted file mode 100644 (file)
index 83972ab..0000000
--- a/extra/math/matrices/elimination/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Solving systems of linear equations

diff --git a/extra/math/matrices/matrices-tests.factor b/extra/math/matrices/matrices-tests.factor
deleted file mode 100644 (file)
index 2094235..0000000
--- a/extra/math/matrices/matrices-tests.factor
+++ /dev/null
@@ -1,109 +0,0 @@
-IN: math.matrices.tests
-USING: math.matrices math.vectors tools.test math ;
-
-[
-    { { 0 } { 0 } { 0 } }
-] [
-    3 1 zero-matrix
-] unit-test
-
-[
-    { { 1 0 0 }
-       { 0 1 0 }
-       { 0 0 1 } }
-] [
-    3 identity-matrix
-] unit-test
-
-[
-    { { 1 0 4 }
-       { 0 7 0 }
-       { 6 0 3 } }
-] [
-    { { 1 0 0 }
-       { 0 2 0 }
-       { 0 0 3 } }
-       
-    { { 0 0 4 }
-       { 0 5 0 }
-       { 6 0 0 } }
-
-    m+
-] unit-test
-
-[
-    { { 1 0 4 }
-       { 0 7 0 }
-       { 6 0 3 } }
-] [
-    { { 1 0 0 }
-       { 0 2 0 }
-       { 0 0 3 } }
-       
-    { { 0 0 -4 }
-       { 0 -5 0 }
-       { -6 0 0 } }
-
-    m-
-] unit-test
-
-[
-    { 10 20 30 }
-] [
-    10 { 1 2 3 } n*v
-] unit-test
-
-[
-    { 3 4 }
-] [
-    { { 1 0 }
-       { 0 1 } }
-
-    { 3 4 }
-
-    m.v
-] unit-test
-
-[
-    { 4 3 }
-] [
-    { { 0 1 }
-       { 1 0 } }
-
-    { 3 4 }
-
-    m.v
-] unit-test
-
-[
-    { { 6 } }
-] [
-    { { 3 } } { { 2 } } m.
-] unit-test
-
-[
-    { { 11 } }
-] [
-    { { 1 3 } } { { 5 } { 2 } } m.
-] unit-test
-
-[
-    { { 28 } }
-] [
-    { { 2 4 6 } }
-
-    { { 1 }
-       { 2 }
-       { 3 } }
-    
-    m.
-] unit-test
-
-[ { 0 0 -1 } ] [ { 1 0 0 } { 0 1 0 } cross ] unit-test
-[ { 1 0 0 } ] [ { 0 1 0 } { 0 0 1 } cross ] unit-test
-[ { 0 1 0 } ] [ { 0 0 1 } { 1 0 0 } cross ] unit-test
-
-[ { 1 0 0 } ] [ { 1 1 0 } { 1 0 0 } proj ] unit-test
-
-[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
-[ { 1 2 } { "a" "b" } cross-zip ] unit-test
\ No newline at end of file

diff --git a/extra/math/matrices/matrices.factor b/extra/math/matrices/matrices.factor
deleted file mode 100755 (executable)
index 7c687d7..0000000
--- a/extra/math/matrices/matrices.factor
+++ /dev/null
@@ -1,62 +0,0 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math math.order math.vectors sequences ;
-IN: math.matrices
-
-! Matrices
-: zero-matrix ( m n -- matrix )
-    [ nip 0 <array> ] curry map ;
-
-: identity-matrix ( n -- matrix )
-    #! Make a nxn identity matrix.
-    dup [ [ = 1 0 ? ] with map ] curry map ;
-
-! Matrix operations
-: mneg ( m -- m ) [ vneg ] map ;
-
-: n*m ( n m -- m ) [ n*v ] with map ;
-: m*n ( m n -- m ) [ v*n ] curry map ;
-: n/m ( n m -- m ) [ n/v ] with map ;
-: m/n ( m n -- m ) [ v/n ] curry map ;
-
-: m+   ( m m -- m ) [ v+ ] 2map ;
-: m-   ( m m -- m ) [ v- ] 2map ;
-: m*   ( m m -- m ) [ v* ] 2map ;
-: m/   ( m m -- m ) [ v/ ] 2map ;
-
-: v.m ( v m -- v ) flip [ v. ] with map ;
-: m.v ( m v -- v ) [ v. ] curry map ;
-: m.  ( m m -- m ) flip [ swap m.v ] curry map ;
-
-: mmin ( m -- n ) [ 1/0. ] dip [ [ min ] each ] each ;
-: mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ;
-: mnorm ( m -- n ) dup mmax abs m/n ;
-
-<PRIVATE
-
-: x ( seq -- elt ) first ; inline
-: y ( seq -- elt ) second ; inline
-: z ( seq -- elt ) third ; inline
-
-: i ( seq1 seq2 -- n ) [ [ y ] [ z ] bi* * ] [ [ z ] [ y ] bi* * ] 2bi - ;
-: j ( seq1 seq2 -- n ) [ [ z ] [ x ] bi* * ] [ [ x ] [ z ] bi* * ] 2bi - ;
-: k ( seq1 seq2 -- n ) [ [ y ] [ x ] bi* * ] [ [ x ] [ y ] bi* * ] 2bi - ;
-
-PRIVATE>
-
-: cross ( vec1 vec2 -- vec3 ) [ i ] [ j ] [ k ] 2tri 3array ;
-
-: proj ( v u -- w )
-    [ [ v. ] [ norm-sq ] bi / ] keep n*v ;
-
-: (gram-schmidt) ( v seq -- newseq )
-    [ dupd proj v- ] each ;
-
-: gram-schmidt ( seq -- orthogonal )
-    V{ } clone [ over (gram-schmidt) over push ] reduce ;
-
-: norm-gram-schmidt ( seq -- orthonormal )
-    gram-schmidt [ normalize ] map ;
-
-: cross-zip ( seq1 seq2 -- seq1xseq2 )
-    [ [ 2array ] with map ] curry map ;
\ No newline at end of file

diff --git a/extra/math/matrices/summary.txt b/extra/math/matrices/summary.txt
deleted file mode 100644 (file)
index 0e9fa9a..0000000
--- a/extra/math/matrices/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-Matrix arithmetic