Bei der Klassifikation mit nächsten Nachbarn geht es darum, einem Merkmalsvektor einen Wert zuzuordnen. Dabei werden gelernte Zuordnungen herangezogen - mehrere Zuordnungen, deren Merkmalsvektoren in der Nachbarschaft des neuen, zu klassifizierenden Merkmalsvektors liegen.

Das Verfahren wird durch die Klasse nearest-neighbours, ihre Methoden und Hilfsfunktionen realisiert.

(defclass nearest-neighbours nil)

Mit dem Konstruktor werden die Zahl der betrachteten Nachbarn neighbour-count und die Funktion measure zur Abstandsmessung der Merkmalsvektoren festgelegt.

(defmethod initialize ((this nearest-neighbours) neighbour-count measure)
  (and
    (integer? neighbour-count)
    (> neighbour-count 0)
    (= (type-of measure) (quote lambda)))
  (progn
    (.= this neighbour-count neighbour-count)
    (.= this measure measure)
    this))

Gelernt wird, indem ein Paar aus einem Merkmalsvektor vector und dem zugeordnete Wert label in der Liste training-set abgelegt wird.

(defmethod learn ((this nearest-neighbours) vector label)
  (list? vector)
  (with-slots (training-set vector-length) this
    (if
      training-set
      (if
        (= (length vector) vector-length)
        (push (list vector label) training-set)
        (throw (quote error) "vector has wrong number of elements"))
      (progn
        (setq training-set (list (list vector label)))
        (setq vector-length (length vector))))))

Die Methode get-neighbours liefert neighbour-count Paare aus Abstand und zugeordnetem Wert für einen Merkmalsvektor vector. Es werden die Paare geliefert, für die der Abstand zum Merkmalsvektor am geringsten ist.

(defmethod get-neighbours ((this nearest-neighbours) vector)
  (list? vector)
  (with-slots-read-only (training-set neighbour-count measure) this
    (take
      neighbour-count
      (sort
        (map-with
          (lambda (pair) (list (measure vector (get-vector pair)) (get-label pair)))
          training-set)
        less-distance?))))

(defproc take (n l)
  (if
    (or (= n 0) (null? l))
    nil
    (cons (first l) (take (- n 1) (rest l)))))

(defproc less-distance? (pair-1 pair-2)
  (< (get-distance pair-1) (get-distance pair-2)))

(setq get-distance first)

(setq get-vector first)

(setq get-label second)

Für die Klassifikation wird das Merkmal geliefert, das am Häufigsten unter den Nachbarn vertreten ist. Dabei haben nähere Nachbarn ein höheres Gewicht als entferntere.

(defmethod classify ((this nearest-neighbours) vector)
  (list? vector)
  (majority (get-neighbours this vector)))

(defproc majority (pair-list)
  (second
    (or
      (find-if zero-distance? pair-list)
      (first
        (sort
          (group
            (map-with to-weight-pair pair-list))
          greater-weight?)))))

(defproc group (pair-list)
  (sum-adjacent
    (sort pair-list less-label?)))

(defproc sum-adjacent (pair-list)
  (cond
    ((null? pair-list)
      nil)
    ((single? pair-list)
      pair-list)
    ((= (get-label (first pair-list)) (get-label (second pair-list)))
      (sum-adjacent
        (cons
          (list
            (+ (get-weight (first pair-list)) (get-weight (second pair-list)))
            (get-label (first pair-list)))
          (rest (rest pair-list)))))
    (t
      (cons
        (first pair-list)
        (sum-adjacent (rest pair-list))))))

(defproc zero-distance? (pair)
  (= (get-distance pair) 0))

(defproc to-weight-pair (pair)
  (list
    (to-weight pair)
    (get-label pair)))

(defproc to-weight (pair)
  (/ (get-distance pair)))

(defproc greater-weight? (pair-1 pair-2)
  (> (get-weight pair-1) (get-weight pair-2)))

(defproc less-label? (pair-1 pair-2)
  (< (get-label pair-1) (get-label pair-2)))

(setq get-weight first)

Die nächsten Nachbarn können auch für eine Regression herangezogen werden. Dafür wird das gewichtete Mittel der benachbarten Werte berechnet. Wie bei der Klassifikation haben nähere Nachbarn ein höheres Gewicht.

(defmethod estimate ((this nearest-neighbours) vector)
  (list? vector)
  (arithmetic-average (get-neighbours this vector)))

(defproc arithmetic-average (pair-list)
  (aif
    (find-if zero-distance? pair-list)
    (get-label it)
    (/
      (apply + (map-with to-weighted-label pair-list))
      (apply + (map-with to-weight pair-list)))))

(defproc to-weighted-label (pair)
  (/ (get-label pair) (get-distance pair)))

Zwei Funktionen zur Abstandsmessung sind vordefiniert. Die Manhattan-Distanz und das Quadrat der euklidischen Distanz.

(defproc manhattan-distance (v w)
  (apply +
    (zip-with
      (lambda (x1 x2) (abs (- x1 x2)))
      v
      w)))

(defproc euclidean-distance (v w)
  (apply +
    (zip-with
      (lambda (x1 x2) (square (- x1 x2)))
      v
      w)))

(defproc square (x) (* x x))