Нахождение компонент связанности графа (Пояснительная записка к курсовой работе), страница 6

;; функция создает множество вершин графа (реализовано как хеш-таблица)

(defun vertex-set:build (g)

;; set – вновь созданное множество вершин

(let ((set (cons *vertex-set-id* (make-hash-table))))

(graph:for-each-vertex g

(lambda (x)

(setf (gethash x (vertex-set:vertexes set)) nil)))

set))

;; предикат проверки принадлежности типа объекта классу “множество вершин”

(defun vertex-set? (set)

(and (consp set) (eq (car set) *vertex-set-id*)))

;; Функция возвращает хеш-таблицу вершин АТД Множество Вершин

(defun vertex-set:vertexes (set)

(check (vertex-set? set))

(cdr set))

;; Функция возвращает любой элемент множества set

;; или nil, если set – пустое множество

(defun vertex-set:find-vertex (set)

(check (vertex-set? set))

;; Функция использует механизм catch/throw для прерывания перебора

;; вершин на первом же вызове. Если maphash завершилась без throw, значит

;; хеш-таблица не содержит элементов

;; Альтернативным вариантом является ведение дополнительного списка вершин

;; множества.

(catch 'found

(maphash (lambda (x y) (throw 'found x)) (vertex-set:vertexes set))

(throw 'found nil)))

;; Удаляет элемент x из множества set и возвращает не nil,

;; если элемент существовал в множестве

(defun vertex-set:remove (set x)

(check (vertex-set? set))

;; remhash возвращает t при удалении

(remhash x (vertex-set:vertexes set)))

;; Функция находит все компоненты связанности заданного графа

(defun find-connected (g)

;; переменная vertexes хранит список всех нерассмотренных вершин графа

(let ((vertexes (vertex-set:build g)))

;; find: основная рабочая функция программы: составляет список вершин,

;; принадлежащих одной компоненте смежности и рекурсивно вызывается

;; для нахождения следующей компоненты.

;; labels используется для возможности рекурсивного вызова

(labels ((find ()

;; vertex - любая из нерассмотренных еще вершин, используется как

;; затравка для поиска смежных вершин.

(let ((vertex (vertex-set:find-vertex vertexes)))

;; если множество непроверенных вершин пусто, find-vertex вернет nil,

;; что является условием завершения работы алгоритма

(if vertex

;; vlist хранит список связанных вершин (компоненту связанности).

;; Изначально устанавливается в nil.

(let* ((vlist nil)

;; queue - очередь нерассмотренных вершин, принадлежащих данной

;; компоненте связанности.

(queue (list vertex)))

;; удаляем вершину из общего множества нерассмотренных вершин графа

(vertex-set:remove vertexes vertex)

;; повторяем, пока очередь нерассмотренных вершин не пуста

(do () ((eq queue nil))

;; cur - текущий элемент очереди

(let* ((cur (car queue))

;; links - список вершин, смежных с cur

(links (graph:vertex-links g cur)))

;; удаляем элемент из очереди нерассмотренных вершин

(setq queue (cdr queue))

;; добавляем элемент в список компоненты связанности

(setq vlist (cons cur vlist))

;; заносим все смежные вершины в очередь

(dolist (link links)

;; помещаем вершину в очередь, только если она не была просмотрена ранее

(if (vertex-set:remove vertexes link)

(setq queue (cons link queue))))))

;; рекурсивно формируем список компонент связанности

(cons vlist (find)))

;; все вершины проверены, выход

nil))))

;; найти список всех связанных компонентов графа

(find))))

Приложение 2. Распечатки тестов

Тест1: nil Þ nil

Тест2: (a b c d e f) Þ ((c) (d) (a) (e) (b) (f))

Тест3: ((a b) (a c) (b d) (d e)) Þ ((e d b a c))

Тест4: ((a b) (a c) (b c) (d e)) Þ ((b a c) (e d))