math.distances: adding a couple more distance functions.

diff --git a/extra/math/distances/distances-tests.factor b/extra/math/distances/distances-tests.factor
index 1e80dcb0f229ffecd8c14b48ecd91996cb241621..4d14fe4613d665ab0aa0b5d390c1c8948f62f488 100644 (file)
--- a/extra/math/distances/distances-tests.factor
+++ b/extra/math/distances/distances-tests.factor
@@ -1,8 +1,16 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: math.distances tools.test ;
+USING: kernel math.distances math.functions tools.test ;
 
 IN: math.distances.tests
 
 { 1 } [ "hello" "jello" hamming-distance ] unit-test
+
+{ 0.0 } [ { 1 2 3 } dup cosine-distance ] unit-test
+{ t } [ { 1 2 3 } { 4 5 6 } cosine-distance 0.02536815380292379 1e-10 ~ ] unit-test
+{ t } [ { 1 2 3 } { 1 -2 3 } cosine-distance 0.5714285714285714 1e-10 ~ ] unit-test
+
+{ 143/105 } [ { 1 2 3 } { 4 5 6 } canberra-distance ] unit-test
+
+{ 3/7 } [ { 1 2 3 } { 4 5 6 } bray-curtis-distance ] unit-test

diff --git a/extra/math/distances/distances.factor b/extra/math/distances/distances.factor
index 31b78f0800a2c272aee494c4c4c3d487b9571d48..2fe3cc11a53b2e7616ed6269a912f53f60d1e288 100644 (file)
--- a/extra/math/distances/distances.factor
+++ b/extra/math/distances/distances.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: kernel math math.functions sequences sequences.extras ;
+USING: kernel math math.functions math.vectors sequences
+sequences.extras ;
 
 IN: math.distances
 
@@ -17,5 +18,14 @@ IN: math.distances
 : manhattan-distance ( a b -- n )
     1 minkowski-distance ;
 
-: chebyshev-distance ( a b -- n )
-    [ - abs ] 2map supremum ;
+: chebyshev-distance ( a b -- n ) ! also chessboard-distance
+    v- vabs supremum ;
+
+: cosine-distance ( a b -- n )
+    [ v* sum ] [ [ norm ] bi@ * ] 2bi / 1 swap - ;
+
+: canberra-distance ( a b -- n )
+    [ v- vabs ] [ [ vabs ] bi@ v+ ] 2bi v/ sum ;
+
+: bray-curtis-distance ( a b -- n )
+    [ v- ] [ v+ ] 2bi [ vabs sum ] bi@ / ;