Лабораторная работа 3

Цель работы - исследование класса задач, решаемых полным перебором и методов их решения средствами Lisp.

Указания. Используя списковое представление графов и рекурсивные функции, разработать программу, находящую решение, в соответствии с приведенными ниже вариантами. Не разрешается использовать операторы цикла и оператор PROG.

Пример решения.

Д

ан некоторый произвольный плоский граф. Необходимо раскрасить все его внутренние области так, чтобы никакие две соседние области не имели одинаковый цвет (см. рис)

.

В общем случае данная задача решается полным перебором, однако существует алгоритм, позволяющий подобрать достаточно хорошее решение за гораздо меньшее число шагов. Решим задачу c помощью этого алгоритма.

Подбор “достаточно хорошего решения” “жадным” алгоритмом. Алгоритм решения заключается в последовательном повторении следующих двух шагов:

1. выбираем новый цвет

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

В тот момент, когда все вершины будут закрашены, нужное нам решение и будет найдено.

Зададим граф, изображённый на рисунке в примере к задаче, следующим образом:

>(setq map '((a 0 (b c g h e))

(b 0 (a c e))

(c 0 (b a e f d))

(d 0 (c e f i j))

(e 0 (a b c d f g h i))

(f 0 (c d e h i j))

(g 0 (a e h))

(h 0 (a e f g i))

(i 0 (c d e f j h))

(j 0 (d f i))

)

)

Каждый из элементов списка представляет собой тройку вида (имя_области цвет_области список_смежных_областей). Таким образом, например, область a имеет цвет 0 (т.е. не задан) и граничит с областями b,c,g,h и e.

Напишем несколько вспомогательных функций. Первая функция определяет номер области в списке областей по её имени:

>(defun getnodebyname (name map)

(cond

((null map) 0)

((eq (nth 0 (nth 0 map)) name) 1)

(T (setq nodeid

(getnodebyname name (cdr map)))

(if (eql nodeid 0) 0 (+ 1 nodeid)))))

Функция возвращает номер записи в списке считая от единицы, нуль означает, что такой записи не найдено.

Следующая функция проверяет, является ли некоторые две области смежными:

>(defun areneighbours (node1 node2 map)

(cond

((null (member node2 (nth 2 (nth

(- (GETNODEBYNAME node1 map) 1) map)))) nil)

(T T)))

Следующая функция проверяет, можно ли закрасить некоторый узел указанным цветом, и возвращает в зависимости от этого T или NIL

>(defun isnodepaintable (node color map maprest)

(cond

((null maprest) T)

((eq (caar maprest) node)

(isnodepaintable node color map (cdr maprest)))

((and (areneighbours node (caar maprest) map) (eq (cadar maprest) color)) nil)

(t(isnodepaintable node color map (cdr maprest)))))

Ещё одна функция получает произвольную область, которую можно закрасить текущим цветом, если же такой области нет, возвращает nil.

>(defun getfirstpaintable (color map maprest)

(cond

((null maprest) nil)

((and (isnodepaintable (caar maprest)

color map map) (not (eq (cadar maprest) color) )

(eq (cadar maprest) 0) )(caar maprest))

(T (getfirstpaintable color map (cdr maprest)))))

Ещё две сервисные функции – закрасить область и проверить, есть ли ещё хоть одна незакрашенная область

>(defun paintregion (node color map)

(progn

(setf (nth 1 (nth (- (getnodebyname node map) 1)

map)) color)

map))

>(defun unpaintedyet (map)

(cond

((null map) nil)

((eq (cadar map) 0) T)

(T (unpaintedyet (cdr map)))))

Следующая функция закрашивает некоторым цветом все доступные узлы:

>(defun paintmapwithcolor (color map)

(cond

((null (getfirstpaintable color map map)) map)

(T (progn (paintregion (getfirstpaintable

color map map) color map) (paintmapwithcolor color map)))))

Наконец, собственно тело программы

>(defun paintall (map color)

(progn

(paintmapwithcolor color map)

(if (unpaintedyet map) (paintall map (+ 1 color)) map)))

Контрольный пример.

>(setq map '((a 0 (b c g h e))

(b 0 (a c e))

(c 0 (b a e f d))

(d 0 (c e f i j))

(e 0 (a b c d f g h i))

(f 0 (c d e h i j))

(g 0 (a e h))

(h 0 (a e f g i))

(i 0 (c d e f j h))

(j 0 (d f i))

)

)

((A 0 (B C G H E)) (B 0 (A C E)) (C 0 (B A E F D)) (D 0 (C E F I J)) (E 0 (A B C D F G H I)) (F 0 (C D E H I J)) (G 0 (A E H)) (H 0 (A E F G I)) (I 0 (C D E F J H)) (J 0 (D F I)))

> (paintall map 1)

((A 1 (B C G H E)) (B 2 (A C E)) (C 3 (B A E F D)) (D 1 (C E F I J)) (E 4 (A B C D F G H I)) (F 2 (C D E H I J)) (G 2 (A E H)) (H 3 (A E F G I)) (I 5 (C D E F J H)) (J 3 (D F I)))

Таким образом, для раскраски графа нам понадобилось пять цветов. Результат выполнения программы приведён на рисунке:

Задания для лабораторной работы