Topology fixes

contrib/topology/matrix.factor

@@ -62,13 +62,16 @@ SYMBOL: matrix
 : pivot-row ( col# row# -- n )
     [ dupd nth-row nth zero? not ] find-row 2nip ;
 
-: (row-reduce) ( -- )
-    0 cols rows min [
-        over pivot-row [ over do-row 1+ ] when*
-    ] each drop ;
+: (row-reduce) ( col# row# -- )
+    over cols < over rows < and [
+        2dup pivot-row [ over do-row 1+ ] when* >r 1+ r>
+        (row-reduce)
+    ] [
+        2drop
+    ] if ;
 
 : row-reduce ( matrix -- matrix' )
-    [ (row-reduce) ] with-matrix ;
+    [ 0 0 (row-reduce) ] with-matrix ;
 
 : null/rank ( matrix -- null rank )
     row-reduce [ [ [ zero? ] all? ] subset ] keep

contrib/topology/test/laplacian.factor

@@ -13,5 +13,5 @@ SYMBOLS: x y z ;
 [ t ] [ y star z x h* = ] unit-test
 [ t ] [ z star x y h* = ] unit-test
 
-[ 1 ] [ x x <,>* ] unit-test
+[ -1 ] [ x x <,>* ] unit-test
 [ 0 ] [ x y <,>* ] unit-test

contrib/topology/test/matrix.factor

@@ -232,3 +232,14 @@ USING: kernel matrices test ;
         { 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