math.similarity: adding weighted-cosine-similarity.

diff --git a/extra/math/similarity/similarity-tests.factor b/extra/math/similarity/similarity-tests.factor
index e04afc58c4e4cdff7ca3f1de729e150cee4820a4..9904e88a392bc00fd5f2e9861d84ab3bd1662130 100644 (file)
--- a/extra/math/similarity/similarity-tests.factor
+++ b/extra/math/similarity/similarity-tests.factor
@@ -19,3 +19,9 @@ CONSTANT: b { 0 0 0 0 2 3 1 }
 { t } [ a a vneg cosine-similarity -1.0 1e-10 ~ ] unit-test
 { t } [ a b cosine-similarity 0.0944911182523068 1e-10 ~ ] unit-test
 
+
+{ 3/100 } [
+    { 0 0 0 10 10 } { 0 0 1 1 1 } { 0 0 0 1 2 }
+    weighted-cosine-similarity
+] unit-test
+

diff --git a/extra/math/similarity/similarity.factor b/extra/math/similarity/similarity.factor
index 6f4cfa89356af290ff425655b9c05505f3049747..a2c4a676e35c30ebbec9ddca79e9c5bec9a08736 100644 (file)
--- a/extra/math/similarity/similarity.factor
+++ b/extra/math/similarity/similarity.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: kernel math math.statistics math.vectors sequences ;
+USING: kernel math math.functions math.statistics math.vectors
+sequences sequences.extras ;
 
 IN: math.similarity
 
@@ -13,3 +14,17 @@ IN: math.similarity
 
 : cosine-similarity ( a b -- n )
     [ v. ] [ [ norm ] bi@ * ] 2bi / ;
+
+<PRIVATE
+
+: weighted-v. ( w a b -- n )
+    [ * * ] [ + ] 3map-reduce ;
+
+: weighted-norm ( w a -- n )
+    [ absq * ] [ + ] 2map-reduce ;
+
+PRIVATE>
+
+: weighted-cosine-similarity ( w a b -- n )
+    [ weighted-v. ]
+    [ [ over ] dip [ weighted-norm ] 2bi@ * ] 3bi / ;