math.matrices: Add some more matrix norms.

diff --git a/basis/math/matrices/matrices-tests.factor b/basis/math/matrices/matrices-tests.factor
index 3855357b4622a76bbe7e01f2d9b11860895a2a70..f82fef7c857f2ffd10d7339f69e81e25d632a157 100644 (file)
--- a/basis/math/matrices/matrices-tests.factor
+++ b/basis/math/matrices/matrices-tests.factor
@@ -383,3 +383,12 @@ CONSTANT: test-points {
 { t } [ { { 1 2 } { 3 4 } } square-matrix? ] unit-test
 { f } [ { { 1 } { 2 3 } } square-matrix? ] unit-test
 { f } [ { { 1 2 } } square-matrix? ] unit-test
+
+{ 9 }
+[ { { 2 -2 1 } { 1 3 -1 } { 2 -4 2 } } m-1norm ] unit-test
+
+{ 8 }
+[ { { 2 -2 1 } { 1 3 -1 } { 2 -4 2 } } m-infinity-norm ] unit-test
+
+{ 2.0 }
+[ { { 1 1 } { 1 1 } } frobenius-norm ] unit-test

diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor
index 0cab9a1472b5309b22ec622a04e24ca255514f86..ef5a06a22f1fbd617043b57129b0d799bf010b83 100644 (file)
--- a/basis/math/matrices/matrices.factor
+++ b/basis/math/matrices/matrices.factor
@@ -141,6 +141,9 @@ IN: math.matrices
 : 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 ;
+: m-infinity-norm ( m -- n ) [ [ abs ] map-sum ] map supremum ;
+: m-1norm ( m -- n ) flip m-infinity-norm ;
+: frobenius-norm ( m -- n ) [ [ sq ] map-sum ] map-sum sqrt ;
 
 : cross ( vec1 vec2 -- vec3 )
     [ [ { 1 2 0 } vshuffle ] [ { 2 0 1 } vshuffle ] bi* v* ]