math.distances: adding some distance functions.

diff --git a/extra/math/distances/authors.txt b/extra/math/distances/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/math/distances/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/math/distances/distances-tests.factor b/extra/math/distances/distances-tests.factor
new file mode 100644 (file)
index 0000000..1e80dcb
--- /dev/null
+++ b/extra/math/distances/distances-tests.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: math.distances tools.test ;
+
+IN: math.distances.tests
+
+{ 1 } [ "hello" "jello" hamming-distance ] unit-test

diff --git a/extra/math/distances/distances.factor b/extra/math/distances/distances.factor
new file mode 100644 (file)
index 0000000..31b78f0
--- /dev/null
+++ b/extra/math/distances/distances.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel math math.functions sequences sequences.extras ;
+
+IN: math.distances
+
+: hamming-distance ( a b -- n )
+    [ = not ] 2count ; inline
+
+: minkowski-distance ( a b p -- n )
+    [ [ [ - abs ] dip ^ ] curry 2map-sum ] keep recip ^ ;
+
+: euclidian-distance ( a b -- n )
+    2 minkowski-distance ; ! also math.vectors.distance
+
+: manhattan-distance ( a b -- n )
+    1 minkowski-distance ;
+
+: chebyshev-distance ( a b -- n )
+    [ - abs ] 2map supremum ;