На этом шаге мы рассмотрим реализацию этого алгоритма.
Параметр path функции defi из предыдущего шага описывает путь из начальной вершины в просматриваемую, поэтому поиск вершины в глубину можно легко модифицировать в поиск пути между заданными вершинами.
Раскрыть/скрыть текст примера.
-- Поиск в графе graph пути между заданными вершинами -- root и end с помощью модифицированной функции defi ----------------------------------------------------- import LibGrp_2 ------------------------------------ way graph root end | null graph = [] | True = defi graph [root] [root] end -------------------------------------------------------- -- visited - список уже просмотренных вершин; -- path - список вершин, определяющих путь просмотра; -- end - конечная вершина пути ------------------------------- defi graph visited path end | null path = reverse visited | null (expnd graph visited (head path)) = defi graph visited (tail path) end | expnd graph visited (head path) == [end] = reverse (end:path) | True = defi graph (expnd graph visited (head path) ++ visited) (expnd graph visited (head path) ++ path) end ------------------------------------------------- -- Выбор следующей, еще не просмотренной вершины, -- соседней с вершиной vertex ----------------------------- expnd graph visited vertex | null (neighb2 vertex graph) = [] | True = firstNotVisited visited (neighb2 vertex graph) ---------------------------------------------------------------- firstNotVisited visited vlist | null vlist = [] | not (elem (head vlist) visited) = [head vlist] | True = firstNotVisited visited (tail vlist) ---------------------------------------------------------------- -- Неудачные тестовые примеры ----------------------------------------------- test = way [(1,[2]),(2,[3,4]),(3,[]),(4,[5]), (5,[2,7,8]),(7,[]),(8,[])] 1 2 == [1,2] && way [(1,[2]),(2,[3,4]),(3,[]),(4,[5]), (5,[2,7,8]),(7,[]),(8,[])] 1 5 == [1,2,4,5] && way [(1,[2]),(2,[3,4]),(3,[]),(4,[5]), (5,[2,7,8]),(7,[]),(8,[])] 4 2 == [4,5,2] && way [(1,[2]),(2,[3,4]),(3,[]),(4,[5]), (5,[2,7,8]),(7,[]),(8,[])] 7 7 == [7] && way [(1,[2]),(2,[3,4]),(3,[]),(4,[5]), (5,[2,7,8]),(7,[]),(8,[])] 1 1 == [1,2,3,4,5,7,8] && way [(3,[7]),(7,[8]),(8,[11]),(11,[13]), (13,[10]),(10,[6]),(6,[7])] 7 7 == [7,8,11,13,10,6]
Библиотека для работы с графами, представленными ассоциативными списками смежности.
Раскрыть/скрыть текст библиотеки.
-- Библиотека для работы с графами, представленными ассо- -- циативными списками смежности. -- Ассоциативные списки смежности моделируются ассоциати- -- вным списком точечных пар следующего вида: -- -- [(A ,[x ,x ,...,x ]),...,(A ,[y ,y ,...,y ])], -- 1 1 2 k n 1 2 j -- -- каждая из которых описывает дугу, соединяющую вершины -- -- A и x , A и x ,..., A и x ,..., -- 1 1 1 2 1 k -- -- A и y , A и y ,..., A и y . -- n 1 n 2 n j -- -- Автор программы (на языке LISP): М.В.Швецкий -- Переписано на язык Haskell: И.А.Кудрявцева (28.01.2010) ---------------------------------------------------------- module LibGrp_2 (pairLis,reKey,reData,assoc1,rAssoc,putAssoc1,addArc, deleteNode,deleteArc,walk,neighb2,oneRange,listSet,assoc) where import List ----------------------------------------------------------- -- Построение графа из списка вершин KEY и списка списков -- смежных вершин DATA с помощью добавления к существующему -- графу Graph -------------------------------------------------------------- pairLis:: [Integer] -> [[Integer]] -> [(Integer,[Integer])] -> [(Integer,[Integer])] pairLis key dta graph | null key = graph | null dta = graph | elem (head key) (reKey graph) = pairLis (tail key) (tail dta) (putAssoc1 (head key) (listSet (head dta ++ (assoc1 (head key) graph))) graph) | True = (head key,head dta) : pairLis (tail key) (tail dta) graph ----------------------------------------------------- -- Восстановление списка вершин графа Graph из -- ассоциативного списка инцидентности ------------------------------------------ reKey:: [(Integer,[Integer])] -> [Integer] reKey graph | null graph = [] | True = fst (head graph) : reKey (tail graph) ---------------------------------------------------------------- -- Восстановление списка списков смежных вершин графа -- Graph из ассоциативного списка инцидентности -------------------------------------------------- reData:: [(Integer,[Integer])] -> [[Integer]] reData graph | null graph = [] | True = snd (head graph) : reData (tail graph) ----------------------------------------------------------- -- Функция возвращает список вершин графа Graph, содержащий -- вершины, смежные вершине Node ------------------------------------------------------ assoc1:: Integer -> [(Integer,[Integer])] -> [Integer] assoc1 node graph | null graph = [] | fst (head graph)==node = snd (head graph) | True = assoc1 node (tail graph) ------------------------------------------------------------ -- Функция возвращает список из вершины графа Graph, имеющей -- заданный список смежных вершин LST -------------------------------------------------------- rAssoc:: [Integer] -> [(Integer,[Integer])] -> [Integer] rAssoc lst graph | null graph = [] | sort (snd (head graph))==sort lst = [fst (head graph)] | True = rAssoc lst (tail graph) --------------------------------------------------------- -- Изменение в графе Graph списка вершин, смежных вершине -- Key, на список Data ------------------------------------------------------------ putAssoc1:: Integer -> [Integer] -> [(Integer,[Integer])] -> [(Integer,[Integer])] putAssoc1 key dta graph | null graph = [] | fst (head graph)/=key = head graph : putAssoc1 key dta (tail graph) | True = (fst (head graph),dta) : putAssoc1 key dta (tail graph) ------------------------------------------------------------- -- Добавление в граф Graph дуги (x,y) ------------------------------------------------------- addArc:: Integer -> Integer -> [(Integer,[Integer])] -> [(Integer,[Integer])] addArc x y graph | null graph = [(x,[y])] | fst (head graph)==x && not (elem y (snd (head graph))) = putAssoc1 x (y : snd (head graph)) graph | fst (head graph)==x && elem y (snd (head graph)) = graph | True = head graph : addArc x y (tail graph) ---------------------------------------------------------------- -- Удаление вершины X из графа Graph ------------------------------------------------ deleteNode:: Integer -> [(Integer,[Integer])] -> [(Integer,[Integer])] deleteNode x graph | (null graph) = [] | fst (head graph)==x = deleteNode x (tail graph) | elem x (snd (head graph)) = (fst (head graph), filter (x/=) (snd (head graph))) : deleteNode x (tail graph) | True = head graph : deleteNode x (tail graph) ------------------------------------------------------------ -- Удаление дуги (X,Y) из графа Graph ---------------------------------------------------------- deleteArc:: Integer -> Integer -> [(Integer,[Integer])] -> [(Integer,[Integer])] deleteArc x y graph | null graph = [] | fst (head graph)==x && elem y (snd (head graph)) = (x,filter (y/=) (snd (head graph))) : deleteArc x y (tail graph) | True = head graph : deleteArc x y (tail graph) -------------------------------------------------------------- -- Построение списка, содержащего все вершины графа, заданного -- ассоциативным списком инцидентности Graph -------------------------------------------- walk:: [(Integer,[Integer])] -> [Integer] walk graph | null graph = [] | True = sort (listSet (oneRange graph)) --------------------------------------------------------- -- Функция возвращает всех "соседей" данной вершины X -- в графе Graph, представленном в виде ассоциативного -- списка инцидентности ------------------------------------------------------- neighb2:: Integer -> [(Integer,[Integer])] -> [Integer] neighb2 x graph | null (assoc x graph (==)) = [] | True = snd (head (assoc x graph (==))) -------------------------------------------------------- -- Вспомогательные функции библиотеки: -------------------------------------- -- Преобразование списочной структуры -- -- ((A .(x x ... x ))...(A .(y y ... y ))), -- 1 1 2 k n 1 2 j -- -- в одноуровневый список --------------------------------------------- oneRange:: [(Integer,[Integer])] -> [Integer] oneRange lst | null lst = [] | True = (fst (head lst) : snd (head lst)) ++ oneRange (tail lst) ------------------------------------------------------- -- Преобразование одноуровневого списка LST в множество -- (удаление из списка повторяющихся элементов) ----------------------------------------------- listSet:: [Integer] -> [Integer] listSet lst | null lst = [] | elem (head lst) (tail lst) = listSet (tail lst) | True = head lst : listSet (tail lst) ------------------------------------------------------------- -- Функция, выполняющая линейный поиск в ассоциативном списке -- alist пары, для которой при сравнении её fst-элемента с -- ключом key по тесту test признак не равен False. -- Если пара элементов, удовлетворяющая тесту, найдена, то -- возвращается список из этой пары; иначе - пустой список ---------------------------------------------------------- assoc:: Integer -> [(Integer,[Integer])] -> (Integer -> Integer -> Bool) -> [(Integer,[Integer])] assoc key alist test | null alist = [] | test (fst (head alist)) key = [head alist] | True = assoc key (tail alist) test
На следующем шаге мы рассмотрим нерекурсивный алгоритм поиска в глубину на графе.
