2012-05-03 13:57:30 -04:00
|
|
|
! Copyright (C) 2012 John Benediktsson
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license
|
|
|
|
|
|
2017-10-24 20:29:06 -04:00
|
|
|
USING: kernel math math.functions math.statistics math.vectors
|
|
|
|
|
sequences sequences.extras ;
|
2012-05-03 13:57:30 -04:00
|
|
|
|
|
|
|
|
IN: math.similarity
|
|
|
|
|
|
|
|
|
|
: euclidian-similarity ( a b -- n )
|
|
|
|
|
v- norm 1 + recip ;
|
|
|
|
|
|
|
|
|
|
: pearson-similarity ( a b -- n )
|
2012-11-06 10:16:20 -05:00
|
|
|
over length 3 < [ 2drop 1.0 ] [ population-corr 0.5 * 0.5 + ] if ;
|
2012-05-03 13:57:30 -04:00
|
|
|
|
|
|
|
|
: cosine-similarity ( a b -- n )
|
2017-10-24 15:26:39 -04:00
|
|
|
[ v. ] [ [ norm ] bi@ * ] 2bi / ;
|
2017-10-24 20:29:06 -04:00
|
|
|
|
|
|
|
|
<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. ]
|
2018-06-19 20:15:05 -04:00
|
|
|
[ overd [ weighted-norm ] 2bi@ * ] 3bi / ;
|