math.vectors: Implement infinity p-norm and special-case l1-norm and l2-norm.

diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index 7dbea0cbfa0ece193b0dde0264122e22ce6ca6a9..0ceabad82197eda08ed983831da1d44f3c66ba5c 100644 (file)
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -225,11 +225,21 @@ M: object h. [ conjugate * ] [ + ] 2map-reduce ; inline
 GENERIC: norm-sq ( v -- x )
 M: object norm-sq [ absq ] [ + ] map-reduce ; inline
 
+: l1-norm ( v -- x ) [ abs ] map-sum ; inline
+
 : norm ( v -- x ) norm-sq sqrt ; inline
 
-: p-norm ( v p -- x )
+: p-norm-default ( v p -- x )
     [ [ [ abs ] dip ^ ] curry map-sum ] keep recip ^ ; inline
 
+: p-norm ( v p -- x )
+    {
+        { [ dup 1 = ] [ drop l1-norm ] }
+        { [ dup 2 = ] [ drop norm ] }
+        { [ dup fp-infinity? ] [ drop supremum ] }
+        [ p-norm-default ]
+    } cond ;
+
 : normalize ( u -- v ) dup norm v/n ; inline
 
 GENERIC: distance ( u v -- x )