Představte si, že máte obrovské množství obsahu, který potřebuje roztřídit. Rozhodit do kategorií nebo třeba otegovat. Něco jako dělá Google s vašimi maily, kdy se snaží co nejlépe určit, do jaké kategorie příchozí zpráva patří. Kategorie mohou být například "práce", "sociální sítě" nebo nejklasičtější příklad "spam". Jak to dělá? Možných způsobů je samozřejmě několik. Tomu s uživatelskou definicí pravidel se věnovat nebudeme, ale představíme si statistické řešení založené na Bayesově větě.

Trénink

Základem bude následující datová struktura obsahující všechny vlastnosti (v tomto případě slova) a kategorie, přičemž každá vlastnost obsahuje informaci kolikrát byla zařazena do dané kategorie; kategorie si udržuje informaci kolik obsahuje vlastností celkem:

{:features   {"clojure" {"good" 5 "bad" 0}
              "casino"  {"good" 2 "bad" 6}}
 :categories {"good" 7 "bad" 6}}

Funkce train přijímá seznam vlastností a kategorií, do které tyto vlastnosti spadají. Protože funkce train je pure, data nikam neukládá, jenom vrací. Abychom mohli použít více dokumentů, seznamů vlastností s určením kategorie, musíme implementovat funkci merge-trainings, která vezme dva sety a spojí je vhodně dohromady.

(def empty-training-set {:features {} :categories {}})

(defn train
  [features category]
  (reduce #(assoc-in %1 [:features %2] {category 1})
          (assoc-in empty-training-set [:categories category] 1)
          features))

(defn merge-trainings
  [a b]
  (merge-with (fn [a b]
                (merge-with #(if (map? %1) (merge-with + %1 %2) (+ %1 %2)) a b)) a b))

Použití pak může vypadat následovně:

(defn get-words
  [sentence]
  (->> (str/split sentence " ")
       (filter #(let [l (count %)]
                  (and (> l 1) (< l 20))))
       (map str/lower-case)
       (distinct)))

(def raw-data [["make quick money now" "bad"]
               ["Hi Honza how are you" "good"]])

(def trained-data (reduce
                    #(merge-trainings %1 (train (get-words (nth %2 0)) (nth %2 1)))
                    empty-training-set
                    raw-data))

Bayesova věta

Bayesova věta je věta teorie pravděpodobnosti, která udává, jak podmíněná pravděpodobnost nějakého jevu souvisí s opačnou podmíněnou pravděpodobností, bežně zapsaná jako P(A|B) = P(B|A) * P(A) / P(B). V našem případě P(category|document) = P(document|category)*P(category)/P(document).

Než postoupíme k výpočtu samotné pravděpodobnosti, definujme si pár pomocných funkcí, pomocí kterých získáme: kolikrát se daná vlastnost nacházela v dané kategorii (count-feature), kolik vlastností kategorie obsahuje (count-category) a počet vlastností celkem (count-total):

(defn get-categories
  [training-set]
  (keys (:categories training-set)))

(defn count-feature
  [training-set feature category]
  (if (and
        (contains? (:features training-set) feature)
        (contains? (:categories training-set) category))
    (get-in training-set [:features feature category])
    0))

(defn count-category
  [training-set category]
  (if (contains? (:categories training-set) category)
    (get-in training-set [:categories category])
    0))

(defn count-total
  [training-set]
  (reduce + 0 (vals (:categories training-set))))

Pravděpodobnost

Teď, když máme přístup k počtům, potřebujeme je nějak ztransformovat do pravděpodobností. Pravděpodobnost je číslo od 0 do 1 včetně, určující jak moc velká šance je, že vybraný jev nastane. V našem případě můžeme spočítat pravděpodobnost výskytu slova v kategorii (feature-probability) vydělením počtu, kolikrát se daná vlastnost nacházela v dané kategorii, počtem kolik vlastností kategorie obsahuje. Tento proces se zapisuje jako P(A|B), v našem případě P(feature|category):

(defn feature-probability
  [training-set feature category]
  (let [c (count-category training-set category)
        f (count-feature training-set feature category)]
    (if (= c 0)
      0
      (/ f c))))

Nicméně i přesto, že funkce počítá pravděpodobnost správně, chová se trochu moc extrémně. Slovo "money" se objevilo jenom jednou a to v kategorii "bad". Proto když se zeptáte jaká je pravděpodobnost, že "money" patří do kategorie "good", dostanete 0, což prostě nemusí být pravda - i slovo "money" může být občas víc než dobré nebo minimálně neutrální. Chtělo by to výpočet upravit tak, aby nezačínal na nule, ale ideálně třeba v polovině, což zajistí mnohem reálnější výsledky:

(defn weighted-probability
  [training-set feature category f]
  (let [totals      (reduce #(+ %1 (count-feature training-set feature %2))
                            0
                            (get-categories training-set))
        probability (f training-set feature category)
        start       0.5]
    (/ (+ start (* totals probability)) (+ totals 1))))

Bayesův filtr

Nyní potřebujeme vypočítat pravděpodobnost, jak moc daný dokument patří do dané kategorie. Jako první si ukážeme Naïve Bayesian classifier. Prvně vypočítámě pravděpodobnost celého dokumentu P(document|category):

(defn document-probability
  [training-set features category]
  (reduce #(* %1 (weighted-probability training-set %2 category feature-probability)) 1 features))

A pak použijeme Bayesovu větu a vypočítáme výslednou pravděpodobnost:

(defn naive-probability
  [training-set features category]
  (* (document-probability training-set features category)
     (/ (count-category training-set category) (count-total training-set))))

Fisherova metoda

Fisherova metoda na to jde jinak a ve výsledku je přesnější. Potřebujeme funkci category-probability, která spočítá pravděpodobnost výskytu dané položky v dané kategorii:

(defn category-probability
  [training-set feature category]
  (let [fp (feature-probability training-set feature category)]
    (if (= fp 0)
      0
      (/ fp (reduce #(+ %1 (feature-probability training-set feature %2)) 0 (get-categories training-set))))))

Nakonec musíme výsledky zkombinovat:

(defn inv-chi2
  [chi, df]
  (let [m    (* chi 0.5)
        exp  (.exp js/Math (- m))
        to   (.floor js/Math (* df 0.5))
        term (reduce #(conj %1 (* (first %1) (/ m %2))) (conj '() exp) (range 1 to))]
    (min (reduce + 0 term) 1)))

(defn fisher-probability
  [training-set features category]
  (inv-chi2
    (* -2 (js/Math.log (reduce #(* %1 (weighted-probability training-set %2 category category-probability)) 1 features)))
    (* 2 (count features))))

Klasifikace

(defn clasify
  [f training-set features]
  (reduce #(assoc %1 %2 (f training-set features %2)) {} (get-categories training-set)))

Správné rozhodování záleží především na uživateli - v případě, že dokumenty rozřazuje náhodně, pak samozřejmě úspěšnost algoritmu bude nízká. Avšak v případě, že dokumenty rozřazuje uváženě, úspěšnost bude vysoká a může dosáhnout až 100%.

Kompletní kód je k dispozici jako gist. Alternativně se dají k řešení tohoto problému použít neuronové sítě nebo SVM. Výhoda tohoto řešení spočívá v relativně jednoduché možnosti ručního ověření.