M.Hiroi's Home Page

Clojure Programming

お気楽 Clojure プログラミング超入門


Copyright (C) 2025 Makoto Hiroi
All rights reserved.

二分探索木 (mutable 版)

前回は immutable な二分探索木を作りました。今回は前回のプログラムを改造して、 mutabe な二分探索木を作ってみましょう。

●mutable な Node

最初に節 Node のフィールド変数を mutable に変更します。

リスト : 節の定義

;; 終端
(def empty-node)

;; 終端か?
(defn empty-node? [node] (= empty-node node))

;; 節の定義
(deftype Node [^:unsynchronized-mutable item
               ^:unsynchronized-mutable left
               ^:unsynchronized-mutable right]
  PNode
  ・・・略・・・ )

;; 初期化
(def empty-node (Node. nil nil nil))

次にプロトコル PNode を定義します。

リスト : プロトコル

(defprotocol PNode
  (search-node [this x])
  (insert-node! [this x])
  (delete-node! [this x])
  (search-node-min [this])
  (search-node-max [this])
  (delete-node-min! [this])
  (delete-node-max! [this])
  (foreach-node [this proc]))

これらのメソッドは節 Node を操作します。基本的には、前回作成した変数名や関数名 xxxx-tree を xxxx-node に変更したものです。名前の最後に ! を付けたメソッドは、フィールド変数を破壊的に修正します。それ以外のメソッドは、前回作成したメソッドとほとんど同じです。

●データの挿入

次は、データを挿入する関数 insert-node! を作ります。この関数は木を引数として受け取り、データを挿入した新しい木を返します。たとえば、フィールド変数 root に木が格納されている場合、データを挿入するときは次のように呼び出します。

(set! root (insert-node root x))

この処理は再帰定義を使うと簡単にプログラムできます。次のリストを見てください。

リスト : データの挿入

  (insert-node! [node x]
    (if (empty-node? node)
      (Node. x empty-node empty-node)
      (let [r (compare x item)]
        (cond
          (neg? r) (set! left  (insert-node! left  x))
          (pos? r) (set! right (insert-node! right x)))
        node)))

最初に節 node が終端かチェックします。そうであれば木は空なので、新しい節を Node. で生成して返します。たとえば、フィールド変数 root が empty-node の場合、新しい節が生成されて root にセットされます。

そうでなければ、引数 x とフィールド item を比較します。x と等しいデータが見つかった場合は、新しいデータを挿入する必要はないので、何も行わずに node を返します。x が小さい場合は、左部分木に x を挿入します。ここで関数 insert-node! を再帰呼び出しします。そして、その返り値をフィールド left にセットして node を返します。

left が empty-node の場合、再帰呼び出しの返り値は新しい節なので、それが left にセットされ、木にデータが挿入されたことになります。そして、新しいデータが挿入された木 (node) を返せばいいわけです。x が item よりも大きければ、同様に右部分木にデータを挿入します。

けっきょく、子を格納している節には、同じ子が再度セットされることになります。無駄なように思われるかもしれませんが、その分だけ簡単にプログラムを作ることができます。

●データの削除

次はデータを削除するメソッドを作りましょう。

リスト : 最小値を削除する

  (delete-node-min! [node]
    (cond
      (empty-node? node) nil
      (empty-node? left) right
      :else (do (set! left (delete-node-min! left)) node)))

関数 delete-node-min! は最小値を格納している節を削除します。left が empty-node の節を探すのは search-node-min と同じです。見つけたら、もう一つの子 right を返します。これで、親の左部分木が書き換えられ、最小値を持つ節が削除されます。葉であれば right は empty-node なので、単純に削除されることになります。

左の子があれば delete-node-min! を再帰呼び出しして、その左部分木の中から最小値を探し出して削除します。そして、その返り値を left にセットして node を返します。

次は、データを削除する関数 delete-node! を作ります。削除するデータを探索して、見つけたら子の有無に合わせた削除処理を行います。

リスト : データの削除

  (delete-node! [node x]
    (if (empty-node? node)
      node
      (let [r (compare x item)]
        (cond
          (zero? r)
          (cond
            (empty-node? left) right
            (empty-node? right) left
            :else (do (set! item (search-node-min right))
                      (set! right (delete-node-min! right))
                      node))
          (neg? r)
          (do (set! left (delete-node! left x))
              node)
          :else
          (do (set! right (delete-node! right x))
              node)))))

まず、node が empty-node ならば木は空なので、何もしないで node を返します。削除するデータが見つからない場合や空の木を与えた場合がこれに相当します。

次に、削除するデータ x と item を比較します。等しい場合はその節を削除します。left が empty-node の場合は right を返し、right が empty-node の場合は left を返します。

子が 2 つある場合は、右部分木の最小値を関数 search-node-min で求め、item の値を書き換えます。そして、関数 delete-node-min! で最小値を格納していた節を削除します。これで、削除するデータを最小値で置き換え、不要になった節を二分木から削除することができます。

x と item が等しくない場合は、左右の部分木をたどって削除するデータを探索します。左部分木をたどるときは、left の値を書き換えて node を返します。右部分木の場合は、right の値を書き換えて node を返します。

●Tree の作成

最後に、二分木を表すデータ型 Tree とその操作メソッドを作ります。

リスト : Tree 型の定義

(defprotocol PTree
  (empty-tree? [this]
  (search-tree [this x])
  (insert-tree! [this x])
  (delete-tree! [this x])
  (search-min [this])
  (search-max [this])
  (delete-min! [this])
  (delete-max! [this])
  (foreach-tree [this proc]))

(deftype Tree [^:unsynchronized-mutable root]
  PTree
  (empty-tree? [_] (empty-node? root))
  (search-tree [_ x] (search-node root x))
  (insert-tree! [_ x] (set! root (insert-node! root x)))
  (search-min [_] (search-node-min root))
  (search-max [_] (search-node-max root))
  (delete-tree! [_ x] (set! root (delete-node! root x)))
  (delete-min! [_] (set! root (delete-node-min! root)))
  (delete-max! [_] (set! root (delete-node-max! root)))
  (foreach-tree [_ proc] (foreach-node root proc)))

;; 生成
(defn make-tree [] (Tree. empty-node))

Tree のフィールド変数は root で、これが二分木の根 (ルート) になります。あとは、処理に対応する Node のメソッドを呼び出すだけです。

●簡単なテスト

それでは実際に実行してみましょう。次に示す簡単なテストを行ってみました。

リスト : 簡単なテスト

;; 表示
(defn print-tree [tree]
  (foreach-tree tree #(printf "%s " %))
  (newline))

;; 乱数データの生成
(defn make-random-data [n]
  (repeatedly n #(rand-int 10000)))

;; テスト
(defn test-tree []
  (let [tree (make-tree)
        data (make-random-data 10)]
    (println "empty-tree? => " (empty-tree? tree))
    (doseq [x data]
      (printf "insert %4d : " x)
      (insert-tree! tree x)
      (print-tree tree))
    (println "empty-tree? => " (empty-tree? tree))
    (doseq [x data]
      (printf "%4d => %s\n" x (search-tree tree x))
      (printf "%4d => %s\n" (inc x) (search-tree tree (inc x))))
    (printf "max = %d\n" (search-max tree))
    (printf "min = %d\n" (search-min tree))
    (printf "delete max : ")
    (delete-max! tree)
    (print-tree tree)
    (printf "delete min : ")
    (delete-min! tree)
    (print-tree tree)
    (doseq [x data]
      (delete-tree! tree x)
      (printf "delete %4d : " x)
      (print-tree tree))))

repeatedly は引数の関数を指定した回数繰り返し、その結果をシーケンスに格納して返します。

repeatedly func
repeatedly n func

n を指定すると func を n 回繰り返します。n を省略すると無限シーケンスになります。

user=> (repeatedly 10 #(rand-int 100))
(23 98 37 61 6 38 46 26 73 27)

user=> (take 10 (repeatedly #(rand-int 100)))
(48 98 49 57 99 61 79 61 17 36)

それでは、実行結果を示します。

user=> (test-tree)
empty-tree? =>  true
insert 3919 : 3919
insert 6818 : 3919 6818
insert 9232 : 3919 6818 9232
insert 1272 : 1272 3919 6818 9232
insert 2310 : 1272 2310 3919 6818 9232
insert 3902 : 1272 2310 3902 3919 6818 9232
insert 6755 : 1272 2310 3902 3919 6755 6818 9232
insert 7436 : 1272 2310 3902 3919 6755 6818 7436 9232
insert 5385 : 1272 2310 3902 3919 5385 6755 6818 7436 9232
insert 7440 : 1272 2310 3902 3919 5385 6755 6818 7436 7440 9232
empty-tree? =>  false
3919 => true
3920 => false
6818 => true
6819 => false
9232 => true
9233 => false
1272 => true
1273 => false
2310 => true
2311 => false
3902 => true
3903 => false
6755 => true
6756 => false
7436 => true
7437 => false
5385 => true
5386 => false
7440 => true
7441 => false
max = 9232
min = 1272
delete max : 1272 2310 3902 3919 5385 6755 6818 7436 7440
delete min : 2310 3902 3919 5385 6755 6818 7436 7440
delete 3919 : 2310 3902 5385 6755 6818 7436 7440
delete 6818 : 2310 3902 5385 6755 7436 7440
delete 9232 : 2310 3902 5385 6755 7436 7440
delete 1272 : 2310 3902 5385 6755 7436 7440
delete 2310 : 3902 5385 6755 7436 7440
delete 3902 : 5385 6755 7436 7440
delete 6755 : 5385 7436 7440
delete 7436 : 5385 7440
delete 5385 : 7440
delete 7440 :
nil

正常に動作しているようです。興味のある方はいろいろ試してみてください。


●プログラムリスト

;;;
;;; tree2.clj : 二分木 (mutable 版)
;;;
;;;             Copyright (C) 2025 Makoto Hiroi
;;;

;; プロトコル
(defprotocol PNode
  (search-node [this x])
  (insert-node! [this x])
  (delete-node! [this x])
  (search-node-min [this])
  (search-node-max [this])
  (delete-node-min! [this])
  (delete-node-max! [this])
  (foreach-node [this proc]))

(defprotocol PTree
  (empty-tree? [this])
  (search-tree [this x])
  (insert-tree! [this x])
  (delete-tree! [this x])
  (search-min [this])
  (search-max [this])
  (delete-min! [this])
  (delete-max! [this])
  (foreach-tree [this proc]))

;; 終端
(def empty-node)

;; 終端か?
(defn empty-node? [node] (= empty-node node))

;; 節の定義
(deftype Node [^:unsynchronized-mutable item
               ^:unsynchronized-mutable left
               ^:unsynchronized-mutable right]
  PNode
  ;; データの探索
  (search-node [node x]
    (if (empty-node? node)
      false
      (let [r (compare x item)]
        (cond
          (zero? r) true
          (neg? r) (search-node left x)
          :else (search-node right x)))))

  ;; データの挿入
  (insert-node! [node x]
    (if (empty-node? node)
      (Node. x empty-node empty-node)
      (let [r (compare x item)]
        (cond
          (neg? r) (set! left  (insert-node! left  x))
          (pos? r) (set! right (insert-node! right x)))
        node)))

  ;; 最小値を求める
  (search-node-min [node]
    (cond
      (empty-node? node) nil
      (empty-node? left) item
      :else (search-node-min left)))

  ;; 最大値を求める
  (search-node-max [node]
    (cond
      (empty-node? node) nil
      (empty-node? right) item
      :else (search-node-max right)))

  ;; 最小値を削除する
  (delete-node-min! [node]
    (cond
      (empty-node? node) nil
      (empty-node? left) right
      :else (do (set! left (delete-node-min! left)) node)))

  ;; 最大値を削除する
  (delete-node-max! [node]
    (cond
      (empty-node? node) nil
      (empty-node? right) left
      :else (do (set! right (delete-node-max! right)) node)))

  ;; データの削除
  (delete-node! [node x]
    (if (empty-node? node)
      node
      (let [r (compare x item)]
        (cond
          (zero? r)
          (cond
            (empty-node? left) right
            (empty-node? right) left
            :else (do (set! item (search-node-min right))
                      (set! right (delete-node-min! right))
                      node))
          (neg? r)
          (do (set! left (delete-node! left x))
              node)
          :else
          (do (set! right (delete-node! right x))
              node)))))

  ;; 二分木の巡回
  (foreach-node [node proc]
    (when-not (empty-node? node)
      (foreach-node left proc)
      (proc item)
      (foreach-node right proc))))

;; 初期化
(def empty-node (Node. nil nil nil))

;; 二分木
(deftype Tree [^:unsynchronized-mutable root]
  PTree
  (empy-tree? [_] (empty-node? root))
  (search-tree [_ x] (search-node root x))
  (insert-tree! [_ x] (set! root (insert-node! root x)))
  (search-min [_] (search-node-min root))
  (search-max [_] (search-node-max root))
  (delete-tree! [_ x] (set! root (delete-node! root x)))
  (delete-min! [_] (set! root (delete-node-min! root)))
  (delete-max! [_] (set! root (delete-node-max! root)))
  (foreach-tree [_ proc] (foreach-node root proc)))

;; 生成
(defn make-tree [] (Tree. empty-node))

名前空間

●名前空間とは?

プログラムを作っていると、ほかのプログラムで作った関数が利用できるのではないか、といった場面に出あうことがあります。このような場合、自分で作成した関数をライブラリとしてまとめておくと、簡単に再利用することができて便利です。

ライブラリの作成で問題になるのが「名前の衝突」です。複数のライブラリを使うときに、同じ名前の関数や変数が存在すると、そのライブラリは正常に動作しないでしょう。このような名前の衝突を避けるために、Clojure では「名前空間 (namespace)」を使います。次の例を見てください。

リスト : ファイル bar.clj

(ns bar)

(def a 10)
(def b 20)
(defn message [] (println "namespace bar"))

このファイルを関数 load-file でロードしてから、次のプログラムを実行します。

user=> (load-file "bar.clj")
#'bar/message
user=> *ns*
#object[clojure.lang.Namespace 0x7b208b45 "user"]

user=> (def a 1)
#'user/a
user=> a
1
user=> bar/a
10

ns は名前空間を定義するマクロです。あとで簡単に説明しますが、ここでは bar という名前空間を定義しています。名前はシンボルで指定します。ns で名前空間を定義すると、それ以降ファイル bar.clj で定義される関数や変数名は名前空間 bar に属します。

Clojure は、大域変数 *ns* の値を現在の名前空間として扱い、この中からシンボルを探したり、シンボルを新規に登録します。通常、*ns* には user という Clojure があらかじめ用意している名前空間になっています。REPL で定義する変数や関数は user に登録されます。したがって、最初 a に 1 を代入しましたが、この変数は名前空間 user 内に定義されます。

ほかの名前空間の変数や関数は、namespace/name のようにアクセスすることができます。これを「名前空間付きシンボル」といいます。名前空間 bar の変数 a は、bar/a でアクセスすることができ、その値は 10 になります。このように、同じ変数名 a でも、名前空間によって区別されるのです。変数 a が衝突することはありません。

関数の呼び出しも同じです。bar に定義されている関数 message は、次のように呼び出すことができます。

user=> (bar/message)
namespace bar
nil

大昔の Lisp 処理系では、システム内のシンボルを oblist というリストで管理していました。近代的な Lisp 処理系では、ハッシュ表を使って管理するのが一般的です。名前空間は「複数のハッシュ表を使ってシンボルを管理するシステム」と考えることもできます。user に定義されているシンボルは、user に対応するハッシュ表に登録され、bar で使用されているシンボルは、bar に対応するハッシュ表に登録されるわけです。

●refer

ところで、異なる名前空間の変数や関数を使うときに、いちいち名前空間をつけるのは面倒ですね。このため Clojure には、ほかの名前空間で定義された名前を取り込む関数 refer が用意されています。

(refer ns-symbol :only '[...] :exclude '[...] :rename '{old new, ...})

(refer ns-symbol) は名前空間 ns-symbol に定義されている名前を、現在の名前空間に取り込みます。次の例を見てください。

user=> (load-file "bar.clj")
#'bar/message

user=> (refer 'bar)
nil

user=> a
10
user=> b
20
user=> (message)
namespace bar
nil

このように refer で名前を取り込むことができますが、名前が衝突する場合は以下のようにエラーとなります。

user=> (load-file "bar.clj")
#'bar/message

user=> (def a 1)
#'user/a

user=> (refer 'bar)
REJECTED: attempt to replace interned var #'user/a with #'bar/a in user, ...
nil

取り込む名前は以下のキーワードを使って制御することができます。

名前 a が衝突しているので、:exclude '[a] で a を除外すると上手くいきます。

user=> (refer 'bar :exclude '[a])
nil
user=> a
1
user=> b
20
user=> (message)
namespace bar
nil
user=> bar/a
10

bar の変数 a は bar/a でアクセスすることができます。または、:only '[b message] とすれば、a 以外の名前 b, message を取り込むことができます。もちろん、:rename で名前を変更することもできます。

user=> (refer 'bar :rename '{a aa})
nil
user=> aa
10

●require

Clojure のライブラリは関数 require でロードしました。require はキーワード :as を使ってライブラリに別名を付けることができましたが、キーワード :refer を使うと関数 refer と同じことができます。

1. require '[lib-name :refer [name ...]]
2. require '[lib-name :refer :all]
3. require '[lib-name :refer :all :exclude [name ...]]
4. require '[lib-name :refer :all :rename {old new, ...}]

1 は :only と同じ動作です。全ての名前を取り込むときは、2 のように :all を指定します。:exclude と :rename は、3, 4 のように :refer :all のあとに指定します。

ところで、require は classpath に設定されているパスからライブラリを探します。clj を起動したときの classpath は次のコマンドで表示することができます。

$ clj -Spath

デフォルトの設定では、この中にカレントディレクトリはありません。したがって、カレントディレクトリにあるソースファイルを require でロードしようとすると、次のようにエラーが表示されます。

user=> (require 'bar)
Execution error (FileNotFoundException) at user/eval1 (REPL:1).
Could not locate bar__init.class, bar.clj or bar.cljc on classpath.

この場合、カレントディレクトリに Clojure の設定ファイル deps.edn を作り、:paths にソースファイルのパスを指定します。カレントディレクトリであれば次のように指定します。

リスト : deps.edn 

{ :paths ["."] }

これで classpath にカレントディレクトリが含まれます。実際に試してみましょう。

user=> (require '[bar :refer :all])
nil
user=> a
10
user=> b
20
user=> (message)
namespace bar
nil

ところで、Clojure の名前空間は、Java のパッケージのよう階層構造にすることができます。次の例を見てください。

リスト : 名前空間の階層構造

(ns foo.baz.bar)

(def a 10)
(def b 20)
(defn message [] (println "namespace foo.baz.bar"))

ドットで区切られた名前空間はディレクトリの階層構造に対応します。たとえば、名前空間 foo.baz.bar はソースファイル foo/baz/bar.clj に対応します。実際に試してみましょう。

$ tree foo
foo
└── baz
    └── bar.clj

1 directory, 1 file
user=> (require '[foo.baz.bar :refer :all])
nil

user=> a
10
user=> b
20
user=> (message)
namespace foo.baz.bar
nil

なお、ライブラリのロードは ns マクロ でも行うことができます。

ns ns-symbol (:require ...) (:import ...) ...

:require は関数 require と同じ、:import は関数 import と同じで Java のライブラリをロードします。このほかにも便利な機能がありますので、詳細は Clojure のリファレンスマニュアルをお読みください。

●-main 関数とコマンドライン引数

Clojure はオプション -M -m を指定して起動すると、ソースファイルを読み込んだあと定義された名前空間の中から -main 関数を探して実行します。

$ clj -M -m source args1 args2 ...

この場合、ファイル名 source に拡張子 .clj を付けると source/clj.clj をソースファイルとして認識するので、想定した動作にはならないでしょう。お気を付けくださいませ。このとき、コマンドライン引数 args1 args2 ... が -main 関数の引数に渡されます。

(defn -main [& args] body ...)

それでは実際に試してみましょう。

リスト : baz.clj

(ns baz)

(defn -main [& args]
  (println "hello, baz")
  (println args))
$ clj -M -m baz foo bar baz
hello, baz
(foo bar baz)

-main 関数が呼び出され、それにコマンドライン引数が渡されていることがわかります。

もう一つ簡単な例として、小町算を解くプログラムで、コマンドライン引数から求める数値を得るように変更してみましょう。次のリストを見てください。

リスト : 小町算

(ns komachi)

;; 式の表示
(defn print-expr [ans expr]
  (doseq [x expr] (printf "%s " x))
  (printf "= %d\n" ans))

;; 式の計算
(defn calc-expr [xs]
  (loop [a (first xs)
         [op n & ys :as zs] (rest xs)]
    (cond
      (not (seq zs)) a
      (= op '+) (recur (+ a n) ys)
      :else (recur (- a n) ys))))

;; 式の生成
(defn make-expr [ans n expr]
  (if (= n 10)
    (when (= (calc-expr (reverse expr)) ans)
      (print-expr ans (reverse expr)))
    (do
      (make-expr ans (inc n) (conj expr '+ n))
      (make-expr ans (inc n) (conj expr '- n))
      (make-expr ans (inc n) (cons (+ (* (first expr) 10) n) (rest expr))))))

;; 実行
(defn -main [n]
  (make-expr (Integer/parseInt n) 2 '(1)))

関数 -main で引数 n を受け取ります。n は文字列なので、Java のメソッド Integer/parseInt で整数値に変換します。とても簡単ですね。実行結果を示します。

$ clj -M -m komachi 100
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
1 + 2 + 34 - 5 + 67 - 8 + 9 = 100
1 + 23 - 4 + 5 + 6 + 78 - 9 = 100
1 + 23 - 4 + 56 + 7 + 8 + 9 = 100
12 + 3 + 4 + 5 - 6 - 7 + 89 = 100
12 + 3 - 4 + 5 + 67 + 8 + 9 = 100
12 - 3 - 4 + 5 - 6 + 7 + 89 = 100
123 + 4 - 5 + 67 - 89 = 100
123 + 45 - 67 + 8 - 9 = 100
123 - 4 - 5 - 6 - 7 + 8 - 9 = 100
123 - 45 - 67 + 89 = 100

$ clj -M -m komachi 200
1 + 234 - 5 - 6 - 7 - 8 - 9 = 200
123 + 4 + 5 + 67 - 8 + 9 = 200
123 - 4 + 5 - 6 - 7 + 89 = 200

●簡単な例題

それでは、以前に作成したキューをライブラリに直してみましょう。次のリストを見てください。

;;;
;;; queue.clj : キュー (レコードのサンプル)
;;;
;;;             Copyright (C) 2025 Makoto Hiroi
;;;

;; 名前空間
(ns mylib.queue)

;; プロトコル
(defprotocol MyQueue
  (empty-queue? [this])
  (enqueue [this x])
  (dequeue [this])
  (top [this]))

;; immutable なキュー
(defrecord ImQueue [front rear]
  MyQueue
  ;; キューは空か
  (empty-queue? [_]
    (and (not (seq front)) (not (seq rear))))
  ;; 挿入
  (enqueue [q x]
    (assoc q :rear (cons x rear)))
  ;; 取得 (キューが空の場合は nil を返す)
  (top [_]
    (cond
      (seq front) (first front)
      (seq rear)  (top (->ImQueue (reverse rear) '()))
      :else nil))
  ;; 削除
  (dequeue [q]
    (cond
      (seq front) (assoc q :front (rest front))
      (seq rear)  (dequeue (->ImQueue (reverse rear) '()))
      :else nil)))

;; 空のキュー
(def empty-queue (->ImQueue '() '()))

名前空間は mylib.queue としました。カレントディレクトリにディレクトリ mylib を作り、その中に queue.clj を配置します。ライブラリ queue は、次のように利用することができます。

user=> (require '[mylib.queue :refer :all])
nil

user=> (def a (reduce (fn [q x] (enqueue q x)) empty-queue (range 1 9)))
#'user/a

user=> (loop [q a] (when-not (empty-queue? q) (println (top q)) (recur (dequeue q))))
1
2
3
4
5
6
7
8
nil

もう一つ queue の利用例として、以前作成したプログラム「経路の探索 (keiro.clj)」で、ライブラリ queue を使うように変更してみましょう。次のリストを見てください。

リスト : 経路の探索

(ns keiro
  (:require [mylib.queue :refer :all]))

;; 隣接リスト
(def adjacent''
  {'A '(B C),
   'B '(A C D),
   'C '(A B E),
   'D '(B E F),
   'E '(C D G),
   'F '(D),
   'G '(E)})

;; 深さ優先探索
(defn depth-first-search [goal [p & ps :as path]]
  (if (= p goal)
    (println (reverse path))
    (doseq [x (get adjacent'' p)]
      (when (neg? (.indexOf path x))
        (depth-first-search goal (cons x path))))))

;; 幅優先探索
(defn breadth-first-search [start goal]
  (loop [que (enqueue empty-queue (list start))]
    (when-not (empty-queue? que)
      (let [path (top que)
            p (first path)]
        (if (= p goal)
          (do (println (reverse path))
              (recur (dequeue que)))
          (recur (reduce (fn [q x]
                           (if (neg? (.indexOf path x))
                             (enqueue q (cons x path))
                             q))
                         (dequeue que)
                         (get adjacent'' p))))))))

;; 反復深化
(defn dfs [limit goal [p & _ :as path]]
  (if (== (count path) limit)
      (when (= p goal)
        (println (reverse path)))
    (doseq [x (get adjacent'' p)]
      (when (neg? (.indexOf path x))
        (dfs limit goal (cons x path))))))

(defn id-search [start goal]
  (dotimes [i 6]
    (let [n (+ i 2)]
      (printf "----- %d -----\n" n)
      (dfs n goal (list start)))))

;; 実行 clj -M -m keiro
(defn -main []
  (println "depth first search")
  (depth-first-search 'G '(A))
  (println "breadth first search")
  (breadth-first-search 'A 'G)
  (println "id search")
  (id-search 'A 'G))

ns で名前空間 keiro を指定し、:require でライブラリ mylib.queue をロードします。:refer :all で queue の名前をすべて取り込んでいます。あとは、幅優先探索 breadth-first-search において、キューの操作関数を queue の関数名に変更するだけです。

それでは実行してみましょう。

$ clj -M -m keiro
depth first search
(A B C E G)
(A B D E G)
(A C B D E G)
(A C E G)
breadth first search
(A C E G)
(A B C E G)
(A B D E G)
(A C B D E G)
id search
----- 2 -----
----- 3 -----
----- 4 -----
(A C E G)
----- 5 -----
(A B C E G)
(A B D E G)
----- 6 -----
(A C B D E G)
----- 7 -----

初版 2025 年 7 月 2, 7 日