cluster/distance.lisp

   1 (in-package :cluster)
   2
   3 (declaim (optimize (speed 3) (debug 0)))
   4
   5 (declaim (inline diff-of-squares))
   6 (declaim (ftype (function (number number) float) square-of-difference))
   7 (defun square-of-difference (a b)
   8   (sq (- a b)))
   9
  10
  11 (declaim (inline diff-of-squares))
  12 (declaim (ftype (function (number number) float) absolute-difference))
  13 (defun absolute-difference (a b)
  14   (abs (- a b)))
  15
  16 (defmacro def-vec2fun ((name) documentation &body body)
  17   "Declare a function 'name' of two vectors, a and b.
  18 Add the optiomization declare and array dimension verification"
  19   `(declaim (ftype (function (simple-array simple-array) float) ,name))
  20   `(defun ,name (a b)
  21      ,documentation
  22      (assert (= (array-dimension a 0)
  23                 (array-dimension b 0)))
  24      ,@body))
  25
  26
  27
  28 ;;; Simple Distances
  29
  30 (def-vec2fun (euclidean-distance)
  31   "Calculate the Euclidean distance between two vectors"
  32   (sqrt (reduce '+ (map 'vector #'square-of-difference a b))))
  33
  34 (def-vec2fun (manhatan-distance)
  35   "Manhatan, or city block, or norm-1 distance"
  36   (reduce '+ (map 'vector #'absolute-difference a b)))
  37
  38
  39 ;; Pearson distance
  40
  41 (defun vectors-statistics (a b)
  42   (loop for i from 0 to (1- (array-dimension a 0))
  43        for x = (aref a i)
  44        for y = (aref b i)
  45      summing x into Sx
  46      summing y into Sy
  47      summing (sq x) into Sx2
  48      summing (sq y) into Sy2
  49      summing (* x y) into Sxy
  50      finally (return (values Sx Sy Sx2 Sy2 Sxy))))
  51
  52
  53 (def-vec2fun (pearson-correlation)
  54     "Pearson correlation"
  55   (let ((N (array-dimension a 0)))
  56     (mvbind (Sx Sy Sx2 Sy2 Sxy) (vectors-statistics a b)
  57             (/ (- Sxy (/ (* Sx Sy) N))
  58                (sqrt (* (- Sx2 (/ (sq Sx) N))
  59                         (- Sy2 (/ (sq Sy) N))))))))
  60
  61 (def-vec2fun (pearson-distance)
  62     "Pearson distance"
  63     (- 1.0 (pearson-correlation a b)))
  64
  65 (def-vec2fun (absolute-pearson-distance)
  66     "Absolute Pearson distance"
  67     (- 1.0 (abs (pearson-correlation a b))))
  68
  69 (def-vec2fun (square-pearson-distance)
  70     "Square Pearson distance"
  71     (- 1.0 (sq (pearson-correlation a b))))