From 86778b349cb707be43422f117c6380dcd4033189 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 24 Oct 2017 17:29:06 -0700
Subject: [PATCH] math.similarity: adding weighted-cosine-similarity.

---
 extra/math/similarity/similarity-tests.factor |  6 ++++++
 extra/math/similarity/similarity.factor       | 17 ++++++++++++++++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/extra/math/similarity/similarity-tests.factor b/extra/math/similarity/similarity-tests.factor
index e04afc58c4..9904e88a39 100644
--- 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 6f4cfa8935..a2c4a676e3 100644
--- 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 / ;