use reject instead of [ ... not ] filter.

[factor.git] / basis / math / matrices / elimination / elimination.factor

diff --git a/basis/math/matrices/elimination/elimination.factor b/basis/math/matrices/elimination/elimination.factor
index 4dc29ad951445fa378af0dd5c4c78434c69c1486..168274a12e82ed9b3d6f84b187c794e2405439d1 100644 (file)
--- a/basis/math/matrices/elimination/elimination.factor
+++ b/basis/math/matrices/elimination/elimination.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel locals math math.vectors math.matrices
 namespaces sequences fry sorting ;
@@ -7,11 +7,11 @@ IN: math.matrices.elimination
 SYMBOL: matrix
 
 : with-matrix ( matrix quot -- )
-    [ swap matrix set call matrix get ] with-scope ; inline
+    matrix swap [ matrix get ] compose with-variable ; inline
 
 : nth-row ( row# -- seq ) matrix get nth ;
 
-: change-row ( row# quot: ( seq -- seq ) -- )
+: change-row ( ..a row# quot: ( ..a seq -- ..b seq ) -- ..b )
     matrix get swap change-nth ; inline
 
 : exchange-rows ( row# row# -- ) matrix get exchange ;
@@ -42,7 +42,7 @@ SYMBOL: matrix
     [ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ;
 
 : rows-from ( row# -- slice )
-    rows dup <slice> ;
+    rows dup iota <slice> ;
 
 : clear-col ( col# row# rows -- )
     [ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ;
@@ -52,8 +52,11 @@ SYMBOL: matrix
     [ 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 )
-    rows-from swap '[ [ _ ] dip nth-row nth abs ] sort-with last ;
+    [ dupd nth-row nth zero? not ] find-row 2nip ;
 
 : (echelon) ( col# row# -- )
     over cols < over rows < and [
@@ -67,7 +70,7 @@ SYMBOL: matrix
     [ 0 0 (echelon) ] with-matrix ;
 
 : nonzero-rows ( matrix -- matrix' )
-    [ [ zero? ] all? not ] filter ;
+    [ [ zero? ] all? ] reject ;
 
 : null/rank ( matrix -- null rank )
     echelon dup length swap nonzero-rows length [ - ] keep ;
@@ -76,9 +79,9 @@ SYMBOL: matrix
 
 : reduced ( matrix' -- matrix'' )
     [
-        rows <reversed> [
+        rows iota <reversed> [
             dup nth-row leading drop
-            dup [ swap dup clear-col ] [ 2drop ] if
+            dup [ swap dup iota clear-col ] [ 2drop ] if
         ] each
     ] with-matrix ;