集合知プログラミングの勉強(3)

いくつかユーティリティ関数を書いて整理。これで ２章の半分(2.4アイテムを推薦する)まで終わり。
推薦される映画のタイトルや人名が自分になじみが無いものばかりなのが惜しい。どこかにデータさえあれば、パーズして取り込むのだけど。

;; 2.3.1 euclid distance

(defun prefs-for (all-prefs who)
  (or (cdr (assoc who all-prefs :test #'equal))
      (error "fail to ~a's prefs in: ~a" who all-prefs)))

(defun score-for (whos-prefs title) ;; return score or nil
  (cdr (find title whos-prefs :key #'car :test #'equal)))

(defun square (x) (expt x 2))

(defun sim-distance (prefs person1 person2)
  "Euclid 距離を計算する"
  (loop with pref1 = (prefs-for prefs person1)
     with pref2 = (prefs-for prefs person2)
     for (title1 . score1) in pref1
     for score2 = (score-for pref2 title1)
     if score2
     collect title1 into shared-titles and
     sum (expt (- score1 score2) 2) into sum-of-squares
     finally
     (if (zerop (length shared-titles))
         (return 0)
         (return (/ 1 (1+ sum-of-squares))))))

;; 2.3.2 pierson
(defun sim-pearson (prefs person1 person2)
  "pearson相関係数を返す"
  (loop
     with pref1 = (prefs-for prefs person1)
     with pref2 = (prefs-for prefs person2)
     for (title1 . score1) in pref1
     for score2 = (score-for pref2 title1)
     if score2
     collect title1 into shared-titles and ; 互いに評価しているアイテムのリスト
     sum score1 into sum1 and              ; 全ての嗜好を合計する
     sum score2 into sum2 and              ; 全ての嗜好を合計する
     sum (square score1) into sum1sq and   ; 平方を合計する
     sum (square score2) into sum2sq and   ; 平方を合計する
     sum (* score1 score2) into psum       ; 積を合計する
     finally
     (if (null shared-titles)
         (return 0)        ; 共に評価しているアイテムがなければ0を返す
         (let* ((n (length shared-titles))
                (num (- psum (/ (* sum1 sum2) n)))
                (den (sqrt (* (- sum1sq (/ (square sum1) n))
                              (- sum2sq (/ (square sum2) n))))))
           (if (zerop den)              ; 未定義になる場合
               (return 0)
               (return (/ num den)))))))

(defun top-matches (prefs person &optional (n 5) (similarity #'sim-pearson))
  (loop for other in (mapcar #'car prefs)
     unless (equal person other)
     collect (cons (funcall similarity prefs person other) other) into scores
     finally
       (return
         (subseq (sort (copy-seq scores) #'> :key #'car)
                 0 (min n (length scores))))))

(defun get-recommendations (prefs person &optional (similarity #'sim-pearson))
  (let ((totals (make-hash-table :test #'equal))
        (sim-sums (make-hash-table :test #'equal)))
    (loop for other in (mapcar #'car prefs)
       unless (equal person other)      ; 自分自身とは比較しない
       do
       (let ((sim (funcall similarity prefs person other)))
         (when (> sim 0)                ; 0 以下の類似度は無視する
           (loop with prefs-other = (prefs-for prefs other)
              with prefs-person = (prefs-for prefs person)
              for (title . score) in prefs-other
              ;; まだ見ていない映画の得点のみを算出
              unless (score-for prefs-person title)
              do
              ;; 類似度 * スコア
              (setf (gethash title totals)
                    (+ (gethash title totals 0) (* score sim)))
              (setf (gethash title sim-sums)
                    (+ (gethash title sim-sums 0) sim))))))
    ;; 正規化したリストを作る
    (loop for title being the hash-keys in totals using (hash-value total)
       collect (cons (/ total (gethash title sim-sums 0)) title) into rankings
       finally
       ;; ソート済みのリストを返す
       (return (sort rankings #'> :key #'car)))))

2.5 似ている製品。データ構造をひっくり返すと似ている製品を探せる、というもの。なるほど。
作業としては alist を別の形の alist にするだけ。面倒なのでハッシュテーブルを利用。こういう形のデータ構造の変換は何度も書いている気がする。

;; 2.5 似ている製品
(defun transform-prefs (prefs)
  (let ((ht (make-hash-table :test #'equal)))
    (loop for (person . pref) in prefs
       do
       (loop for (title . score) in pref
          do
          (if (gethash title ht)
              (push (cons person score) (gethash title ht))
              (setf (gethash title ht) (list (cons person score)))))
       finally
       (return
         (loop for title being the hash-keys in ht using (hash-value lst)
            collect (cons title lst))))))

2.6,　2.7, 2.8, 2.9, 2.10 はどうしよう。後回しにするか。