clojure.core.logicでPrologのような論理型プログラミング

clojure.core.logicというClojureProlog化するライブラリがある。

Prologとは、論理型プログラミング言語
下記のサイトで詳しい説明をしている方がいらっしゃるので、論理型言語についての説明は省略。
http://www.geocities.jp/m_hiroi/prolog/

このPrologのようなことが、論理型言語ではなく関数型言語Clojureで、ライブラリ clojure.core.logic をロードするだけでできてしまう。
https://github.com/clojure/core.logic

The Reasoned Schemer という本は、Schemeで論理型プログラミングを実現する内容だが、 clojure.core.logic はこの本の内容をClojureに移植したもの。

The Reasoned Schemer

The Reasoned Schemer

まずは環境のセットアップでLeiningenを使いますが、このLeiningenの使い方は過去のエントリをご参考に。
http://d.hatena.ne.jp/t2ru/20100123/1264199643

まずは、project.cljに clojure.core.logic を使うように記述し・・・、

(defproject prolog-clojure "1.0.0-SNAPSHOT"
  :description "prolog clojure"
  :dependencies [[org.clojure/clojure "1.3.0"]
                 [org.clojure/core.logic "0.6.7"]])

依存するライブラリをダウンロードしてくる。

$ lein deps

これで準備完了。

簡単な例

早速 src/prolog-clojure/fruits.clj に論理を書いてみる。

(ns prolog-clojure.fruits
  (:refer-clojure :exclude [==]) ;; == がclojure.coreとかぶるので、除外する。
  (:use [clojure.core.logic]))

(defrel shape f s) ;; 果物の形を定義します

(fact shape :apple :sphere)    ;; リンゴは丸い
(fact shape :orange :sphere)   ;; オレンジも丸い
(fact shape :banana :stick)    ;; バナナは棒状
(fact shape :strawberry :cone) ;; イチゴは錐

(defrel color f c) ;; 果物の色を定義します

(fact color :apple :red)      ;; リンゴは赤い
(fact color :orange :orange)  ;; オレンジはオレンジ
(fact color :banana :yellow)  ;; バナナは黄色い
(fact color :strawberry :red) ;; イチゴは赤い

(defn -main []
  (println "丸い果物は?")
  (prn (run* [q]
         (shape q :sphere)))
  (println "赤い果物は?")
  (prn (run* [q]
         (color q :red)))
  (println "丸くて赤い果物は?")
  (prn (run* [q]
         (shape q :sphere)
         (color q :red)))
  (println "丸いか赤い果物は?")
  (prn (run* [q]
         (conde
           [(shape q :sphere)]
           [(color q :red)])))
  )

そして実行。

~/work/prolog-clojure$ lein run -m prolog-clojure.fruits
丸い果物は?
(:apple :orange)
赤い果物は?
(:strawberry :apple)
丸くて赤い果物は?
(:apple)
丸いか赤い果物は?
(:apple :strawberry :orange :apple)
~/work/prolog-clojure$ 

正解!
ifも再帰もループも使っていないのに、答えをちゃんと出してくれました。
appleがかぶっていますが、shapeとcolorの両方探してどちらでも見つかったからです。

このように、事実を書いて問いを入力すれば、計算ロジックは裏で勝手に考えてくれて、ありうる答えを全部出してくれる、というのが論理型プログラミングというやつです。

経路探索問題

さて、では経路探索をやってみましょう。

(ns prolog-clojure.pathsearch
  (:refer-clojure :exclude [==]) ;; == がclojure.coreとかぶるので、除外する。
  (:use [clojure.core.logic]))

;; http://www.geocities.jp/m_hiroi/prolog/prolog06.html
;; の経路探索問題の丸パクリです

(defrel neighbor a b)

;;  H -- I -- J -- K
;;  |    | / |
;;  E -- F -- G
;;  | / |    |
;;  A -- B -- C -- D

(fact neighbor :a :b) (fact neighbor :a :f) (fact neighbor :a :e)
(fact neighbor :b :f) (fact neighbor :b :c) (fact neighbor :c :d)
(fact neighbor :c :g) (fact neighbor :e :f) (fact neighbor :e :h)
(fact neighbor :f :g) (fact neighbor :f :i) (fact neighbor :f :j)
(fact neighbor :g :j) (fact neighbor :h :i) (fact neighbor :i :j)
(fact neighbor :j :k)

(defn nexto [x y]
  (conde
    [(neighbor x y)]
    [(neighbor y x)]))

(defn noto [x]
  (conda [x fail] [succeed succeed]))

(defne depth-search [node end path ans]
  ([?end ?end _ _] (conso end path ans))
  ([_ _ _ _]
   (fresh [nxt new-path]
     (noto (membero node path))
     (nexto node nxt)
     (conso node path new-path)
     (depth-search nxt end new-path ans))))

(defn -main []
  (println "bの隣は?")
  (prn (run* [q] (nexto :b q)))
  (println "aからkまでのループしない全経路は?")
  (doseq [x (run* [q] (depth-search :a :k [] q))]
    (prn x))
  )

そして実行

~/work/prolog-clojure$ lein run -m prolog-clojure.pathsearch
bの隣は?
(:c :a :f)
aからkまでのループしない全経路は?
(:k :j :g :f :a)
(:k :j :g :c :b :a)
(:k :j :f :b :a)
(:k :j :g :f :b :a)
(:k :j :f :a)
(:k :j :i :h :e :a)
(:k :j :g :f :e :a)
(:k :j :f :g :c :b :a)
(:k :j :f :e :a)
(:k :j :i :f :b :a)
(:k :j :g :c :b :f :a)
(:k :j :g :f :i :h :e :a)
(:k :j :i :f :g :c :b :a)
(:k :j :i :f :a)
(:k :j :f :i :h :e :a)
(:k :j :i :h :e :f :b :a)
(:k :j :i :f :e :a)
(:k :j :i :h :e :f :a)
(:k :j :g :c :b :f :e :a)
(:k :j :i :h :e :f :g :c :b :a)
(:k :j :g :c :b :f :i :h :e :a)
~/work/prolog-clojure$ 

最後に答えをreverseしていないので全部逆順に出ていますが、Prologの場合と同じ答えが出ているはずです。(答えの順序が違うのは、clojure.core.logicの中の探索アルゴリズムがPrologと違ってインターリーブする為です。miniKANRENのcondiと同じ結果になります。)

condaとかcondeとかdefneとか、よくわからないものが出てきましたね。下記にまとめます。

条件系のマクロ
(conde     ;; [場合分け] (The Reasoned Schemerのcondiにあたる)
  [a b c]  ;; a b c が全て成り立つ場合と、
  [d e f]  ;; d e f が全て成り立つ場合と、
  [g h i]) ;; g h i が全て成り立つ場合の結果をそれぞれ出す。

(condu     ;; [選択]
  [a b c]  ;; a b c が全て成り立つならこれを全体の結果とする。
  [d e f]  ;; 上が成り立たず、d e f が全て成り立つならこれを全体の結果とする。
  [g h i]) ;; 上が成り立たず、g h i が全て成り立つならこれを全体の結果とする。

(conda     ;; [条件分岐]
  [a b c]  ;; a が成り立てば、 a b c の結果を全体の結果とする。
  [d e f]  ;; a が成り立たず、d が成り立てば、 d e f の結果を全体の結果とする。
  [g h i]) ;; a と d が成り立たず、g が成り立てば、 g h i の結果を全体の結果とする。

(matche [a b c]
  ([?x ?x ?x] ...) ;; a, b, c が同じ場合にマッチ
  ([?x ?x _] ...)  ;; a, b が同じ場合にマッチ
  ([_ ?x ?x] ...)) ;; b, c が同じ場合にマッチ

(defne funcname [a b c] ...)
;; (defn funcname [a b c] (matche [a b c] ...)) と同じ

;; 下記は同じ関係にある
;; conde  <--> condu  <--> conda
;; matche <--> matchu <--> matcha
;; defne  <--> defnu  <--> defna
その他
fail    ;; 無条件に失敗
succeed ;; 無条件に成功

(== x y)         ;; x と y が同じなら成功
(membero x xs)   ;; リストxsにxが含まれる場合に成功
(conso x rxs xs) ;; (== (cons x rxs) xs) の場合に成功

;; condaとfail, succeedでnotが作れる
(defn noto [x] (conda [x fail] [succeed]))
;; xが成功したら失敗、xが失敗したら成功となる。

;; conduとfail, succeedで、最初の1個だけを出す条件が作れる。
;; The Reasoned Schemer 10-19
(defn onceo [x] (condu [x succeed] [fail]))