Примеры решения задач

Задача 6.1. Структура графа задана списками смежности номеров вершин, т. е. списком, элементами которого являются списки номеров вершин, инцидентных ей (см. также задачу 4.3):

newtype Graph = Graph [[Int]].

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

Решение. Проще всего написать функцию обхода вершин графа, которая будет последовательно находить все достижимые из заданной вершины узлы графа. Как только в список достижимых вершин попадает вторая вершина из двух концов предполагаемого пути, работа алгоритма должна прекрахцаться, путь существует. Если обход вершин графа закончен, а второй конец пути так и не найден, то пути между двумя заданными вершинами не существует.

Основную работу будет делать рекурсивная функция bfs (поиск в ширину). Она получит в качестве аргументов номер вершины, поиск которой проводит эта функция, список уже пройденных в процессе обхода графа вершин, список номеров вершин, находящихся «на переднем крае» поиска (фронт волны), и собственно граф. Результатом работы функции будет логическое значение — найдена или нет в процессе обхода целевая вершина. Таким образом, тип функции будет иметь вид bfs: Int -> [Int] -> [Int] -> Graph -> Bool.

Если «фронт волны» уже пуст, то обход закончен, целевая вершина нс найдена. Соответствующее уравнение для функции bfs выглядит очень просто:

bfs _ _ [] _ = False.

Если целевая вершина имеется в списке, представляющем «фронт волны», то работа алгоритма заканчивается успешно, путь, соединяющий вершины, существует:

bfs finish _ front _ I finish 'elem' front = True.

В общем случае требуется выполнить очередной шаг алгоритма: добавить вершины «фронта» в список пройденных вершин и построить новый фронт волны из еще не исследованных вершин, смежных с вершинами текущей волны. Для этого будем использовать операции с множествами, представленными в виде списков, из модуля Data. List. Операция объединения множеств представлена функцией union, а операция получения разности множеств — бинарным оператором (): bfs finish passed front g0 (Graph list) =.

bfs finish newPassed newFront g where newPassed = passed 'union' front.

newFront = (foldrl union $ map (list!!) front) newPassed.

Теперь несложно определить искомую функцию. Для этого нужно запустить процесс обхода в ширину, определив в качестве начального «фронта волны» список из единственной начальной вершины. Полностью программа представлена в листинге 6.6.

Листинг 6.6. Определение существования пути в графе import Data. List (union, ()).

newtype Graph = Graph [[Int]].

pathExists:: Int -> Int -> Graph -> Bool pathExists start finish = bfs finish [] [start].

bfs: Int -> [Int] -> [Int] -> Graph -> Bool bfs _ _ [] _ = False.

bfs finish _ front _ I finish 'elem' front = True bfs finish passed front g0 (Graph list) =.

bfs finish newPassed newFront g.

where newPassed = passed 'union' front.

newFront = (foldrl union $ map (list!!) front) newPassed.

Задача 6.2. Усложним условие задачи 6.1. Теперь помимо существования пути определим еще и сам путь между двумя вершинами в графе, если он существует. Искомая функция должна для заданного графа и двух номеров вершин найти последовательность номеров вершин в виде списка, лежащих на пути, соединяющем эти вершины. Если такого пути нет, то функция должна выдавать значение Nothing.

Решение. Будем так же, как и в задаче 6.1, осуществлять обход графа в ширину, но в процессе обхода еще и строить дерево обхода. Традиционно дерево обхода представляется в виде массива номеров вершин, в котором каждой вершине сопоставлен номер той вершины, из которой ведет дуга в этом дереве. Например, для графа, представленного на рис. 6.3, дерево его обхода из вершины с номером 0 будет таким, как показано на рис. 6.4, в. Это дерево получается в результате выполнения последовательности шагов обхода в ширину, которая показана на рис. 6.4.

Рис. 63. Пример графа.

На этом рисунке вершины, находящиеся во фронте волны, помечены серым цветом, пройденные вершины — черным, а вершины, которые в процессе обхода еще не рассматривались — белым. На рис. 6.4, а изображена начальная ситуация, когда фронт волны составляет единственная вершина с номером 0. С каждым новым шагом просматриваются новые вершины, и увеличивается дерево обхода, показанное на рисунке сплошными стрелками. Дуги графа, не входящие в дерево обхода, изображены штриховыми линиями. На последнем фрагменте (рис. 6.4, е) дуги, не вошедшие в дерево обхода, удалены.

Рис. 6.4. Последовательность шагов при обходе графа в ширину.

Будем представлять дерево обхода функцией, которая по номеру вершины выдает номер родительской вершины в дереве, если такая вершина в дереве есть. Если нет — функция будет выдавать Nothing. Таким образом, дерево обхода будет представлено типом данных.

type Tree = Int -> Maybe Int.

Дерево обхода, которое не содержит дуг, будет представлено тождественной функцией, выдающей значение Nothing для всех вершин графа. Добавление дуги в дерево обхода может быть представлено функцией type Arc = (Int, Int) add:: Arc -> Tree -> Tree.

add (u, v) tree arg = if arg == v then Just u else tree arg Тогда найти в дереве обхода путь от начальной вершины до некоторой вершины графа можно, проследив обратную последовательность вершин от конечной до начальной. Следующая функция выдает такой путь в виде списка вершин в обратном порядке в предположении, что такой путь существует:

getPath: Int -> Tree -> [Int].

getPath v tree | isNothing (tree v) = [v].

I otherwise = v: getPath (fromJust (tree v)) tree.

Теперь можно приступать к программированию обхода графа. Основная идея алгоритма будет той же, что и в задаче 6.1, но по мере добавления новых вершин в формирующийся фронт волны нужно будет еще и добавлять соответствующие дуги в дерево обхода, что несколько усложняет текст программы. Первые два варианта работы функции представляют собой случаи, когда работа алгоритма завершается успешно или неуспешно, и они остаются практически неизменными по сравнению с задачей 6.1: bfs: Int -> [Int] -> [Int] -> Tree -> Graph -> Maybe Tree bfs finish passed front tree graph | null front = Nothing | finish 'elem' front = Just tree Последний вариант значительно сложнее. Один шаг обхода состоит в том, что сначала для каждой вершины фронта волны строится множество исходящих из нее дуг, ведущих в еще не исследованные вершины графа. Затем все дуги добавляются в дерево обхода (возможно, что при этом некоторые дуги, ведущие в какую-либо вершину, будут заменяться другими), а все новые вершины объединяются в новое множество, образующее новый фронт волны. Все эти действия можно объединить в следующем уравнении:

bfs finish passed front tree gr@ (Graph list).

I otherwise = bfs finish newPassed newFront newPath gr where newPassed = passed 'union' front (newFront, newPath) =.

foldr insertArcs ([], tree) $ map getArcs front Здесь функция getArcs формирует множество дуг, ведущих из заданной вершины, а функция insertArcs производит добавление этих дуг в дерево обхода и объединение множеств вершин. Полная программа получается, если добавить функцию findPath, которая запускает программу обхода графа и извлекает результат из получившегося дерева обхода. Получившаяся программа представлена в листинге 6.7.

Листинг 6.7. Построение пути между двумя заданными вершинами в графе

import Data. Maybe (isNothing, fromJust) import Data. List (union, ()).

newtype Graph = Graph [[Int]].

• — Дерево путей в процессе обхода графа в ширину, type Tree = Int -> Maybe Int
• — Дуга в графе, type Arc = (Int, Int)
• — Поиск пути в дереве обхода до заданной вершины в предположении,
• — что заданная вершина достигнута в процессе обхода. getPath: Int -> Tree -> [Int]

getPath v tree | isNothing (tree v) = [v].

I otherwise = v: getPath (fromJust (tree v)) tree.

— Добавление дуги в дерево обхода add:: Arc -> Tree -> Tree.

add (u, v) tree arg = if arg == v then Just u else tree arg.

• — Обход графа в ширину.
• — Аргументы:

finish — вершина, достижение которой является целью;

passed — множество пройденных вершин;

front — фронт волны;

tree — текущее дерево обхода;

gr — граф.

— Результат:

дерево обхода до целевой вершины, если эта вершина достижима, bfs: Int -> [Int] -> [Int] -> Tree -> Graph -> Maybe Tree bfs finish passed front tree gr@ (Graph list).

I null front = Nothing | finish 'elem' front = Just tree.

| otherwise = bfs finish newPassed newFront newPath gr where newPassed = passed 'union' front (newFront, newPath) =.

foldr insertArcs ([], tree) $ map getArcs front getArcs:: Int -> [Arc].

getArcs u = map ((,) u) $ list!! u newPassed insertArcs: [Arc] -> ([Int], Tree) -> ([Int], Tree).

insertArcs s (u, p) = (u 'union' (map snd s), foldr add p s).

• — Поиск пути в графе от начальной до целевой вершины.
• — Аргументы:

start — начальная вершина; finish — целевая вершина; gr — исходный граф.

findPath: Int -> Int -> Graph -> Maybe [Int].

findPath start finish gr = case bfs finish [] [start] initTree gr of Nothing -> Nothing.

Just tree -> Just $ reverse $ getPath finish tree.

— Начальное пустое дерево обхода. initTree:: Tree.

initTree u = Nothing.

Граф, представленный на рис. 6.3, в программе может иметь следующее описание:

testGraph:: Graph.

testGraph = Graph [ [1,2], [ ], [1,5, 6], [0], [1], [1,4,6, 7], [3], [ 6] ] Попробуем запустить нашу функцию поиска пути для этого графа и некоторых пар вершин:

>> findPath 0 3 testGraph Just [0,2,б, 3].

>> findPath 2 0 testGraph Just [2,6,3,0].

" findPath 4 0 testGraph Nothing.

По крайней мере на приведенных примерах наша программа работает правильно.

Задача 6.3. Строка содержит натуральные числа, разделенные знаками ' + например, «12+23*2». Напишите функцию makeMaximum.

:: String -> String, которая добавляет в строку круглые скобки таким образом, чтобы результат вычисления выражения стал максимальным. Например, для приведенной строки «12+23*2» результатом будет «((12+23) *2) «(с точностью до внешней пары скобок). Порядок выполнения операций в результирующей строке должен определяться только скобками, приоритеты операций не учитываются.

Решение. Анализировать и преобразовывать выражение удобнее всего, если выражение представлено деревом, в узлах которого находятся операнды (в данном случае — числа) и операции. Для функционального программирования естественно, чтобы операции были представлены функциями, поэтому опишем следующие типы данных для представления такого дерева выражения:

type Op = Integer -> Integer -> Integer data Tree = Term Integer | Oper Op Tree Tree.

Здесь тип Op представляет двуместную операцию над целыми числами, конструктор Term создаст лист дерева, содержащий целый операнд, и конструктор Орег создает узел, представляющий бинарную операцию с двумя подвыражениями в качестве операндов.

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

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

Анализ исходной строки проведем следующим образом. Сначала удалим из строки все «пустые» символы, т. е. те, для которых функция Data. Char. isSpace выдает значение True. Затем сгруппируем символы исходной строки по признаку, является ли символ цифрой, получив тем самым список строк, представляющих по отдельности операции и операнды. Наконец, преобразуем знаки операций в соответствующие бинарные операции и последовательности цифр в целые числа: divide: String -> ([Op], [Integer]) divide s = (map toOp ops, map read numbers) where (ops, numbers) =.

partition (not.isDigit.head) $.

groupBy (cl c2 -> isDigit cl == isDigit c2) $.

filter (not. isSpace) s toOp с I c == «+ «= (+).

I c ₌₌ = (-).

I _{c ==} M*n = (*)

Построение списка деревьев можно оформить в виде нары взаимно рекурсивных функций, которые выбирают по очереди все знаки операций и затем рекурсивно строят всевозможные деревья операндов из тех чисел и знаков операций, которые находятся слева и справа от выбранного знака операции. Функция build будет строить список всевозможных деревьев выражений для выбранного номера операции в списке операций, а функция allTrees будет объединять все построенные функцией build списки: allTrees: ([Op], [Integer]) -> [Tree].

allTrees ([], [x]) = [Term x].

allTrees (ops, values) =.

concatMap (build ops values) [0.length ops — 1].

build: [Op] -> [Integer] -> Int -> [Tree] build ops values i =.

[Oper op tl t2 | tl <- allTrees (opsLeft, valsLeft) ,.

t2 <- allTrees (opsRight, valsRight) ] where (opsLeft, (op:opsRight)) = splitAt i ops.

(valsLeft, valsRight) = splitAt (i+1) values Для выбора дерева с максимальным значением нужно научиться вычислять значение выражения, представленного деревом. Эта функция, впрочем, совсем простая: calc:: Tree -> Integer calc (Term n) = n.

calc (Oper op tl t2) = op (calc tl) (calc t2).

Мы почти закончили программирование. Все остальные действия: выбор дерева с максимальным значением, представление дерева выражения в виде строки — носят чисто технический характер, и не составляет большого труда их запрограммировать. Отметим еще способ, которым можно по заданной функции из набора операций (+), (-) и (*) получить ее визуальное представление в виде символа. Выбор можно сделать по тому, каков будет результат операции с операндами 2 и 1. Действительно, 2−1 = 1,2*1 = 2 и 2+1 = 3. Это очень удобно.

Полностью вся программа с некоторым количеством комментариев представлена в листинге 6.8.

Листинг 6.8. Расстановка скобок в выражении для получения максимального результата import Data. Char (isDigit, isSpace) import Data. List (partition, maximumBy, groupBy).

• — Типы данных для представления одной из трех операций
• — и дерева выражения, в терминальных узлах которого находятся
• — числа, а в нетерминальных узлах — операции.

type Op = Integer -> Integer -> Integer.

data Tree = Term Integer | Oper Op Tree Tree.

— Функция по заданному дереву выражения вычисляет его значение. calc:: Tree -> Integer calc (Term n) = n.

calc (Oper op tl t2) = op (calc tl) (calc t2).

— Представление дерева в виде строки (скобочное представление). instance Show Tree where

show (Term n) = show n show (Oper op tl t2) =.

" («++ show tl ++ [showOp op] ++ show t2 ++ «)» .

— Анализ исходной строки с выделением знаков операций и операндов, divide: String -> ([Op], [Integer]).

divide s = (map toOp ops, map read numbers) where (ops, numbers) =.

partition (not.isDigit.head) $.

groupBy (cl c2 -> isDigit cl == isDigit c2) $.

filter (not. isSpace) s toOp с | c == «+ «= (+).

I c == = (-).

I _{c == =}

• — Функции build и allTrees — две взаимно рекурсивные функции, — основные в этой реализации.
• — allTrees строит множество всех деревьев с заданными списками — операций и операндов.
• — build строит множество деревьев, в корне которых находится
• — операция из списка с заданным номером.

allTrees: ([Op], [Integer]) -> [Tree].

allTrees ([], [x]) = [Term x].

allTrees (ops, values) =.

concatMap (build ops values) [0.length ops — 1].

build: [Op] -> [Integer] -> Int -> [Tree] build ops values i =.

[Oper op tl t2 | tl <- allTrees (opsLeft, valsLeft) ,.

t2 <- allTrees (opsRight, valsRight) ] where (opsLeft, (op:opsRight)) = splitAt i ops.

• (valsLeft, valsRight) = splitAt (i+1) values
• — Функция выбора дерева с максимальным значением. getMaxTree:: [Tree] -> Tree

getMaxTree = maximumBy (11 t2 -> compare (calc tl) (calc t2)).

• — Визуализация одной из трех операций ¹ + ', '¹
• — Выбор происходит по результату выполнения операции — над числами 2 и 1.

showOp:: Op -> Char.

showOp op = «! ! fromlntegral (op 2 1 — 1).

• — Алгоритм работы основной функции по этапам:
• — сначала разделяем операнды и операции,
• — затем строим деревья,
• — — потом выбираем из них дерево с максимальным значением

выражения и, наконец,.

— выводим выражение в виде строки. makeMaximum: String -> String.

makeMaximum = show. getMaxTree. allTrees. divide.

Для коротких строк наша функция работает довольно быстро, можно проверить это, вызвав ее, например, следующим образом:

" makeMaximum «3*4+1+2*5» .

" ((3* ((4 + 1)+2))*5)" .

(0.00 secs, 515 440 bytes).

" makeMaximum «1−2-3−4» .

" (I^- ((2−3)-4))" .

(0.02 secs, 518 028 bytes).

Для более длинных исходных строк замедление в работе функции более заметно:

>> makeMaximum «1+2−3*4+5−6+7*8−9*10−11+12» .

" ((1+2) — (3* ((4 + 5) — ((6+7)*(8-(9*(10-(11 + 12))))))))" .

(2.46 secs, 397 966 960 bytes).

Функция совсем непригодна для анализа строк длиной в 20 и более операндов. Количество требуемой для работы памяти растет экспоненциально с увеличением числа операндов, так же, как и временные затраты. Несколько улучшить ситуацию можно, если генерировать не все возможные деревья выражений, а ограничить перебор, учитывая специфику выражений. Например, если в корне дерева находится знак операции умножения, то для того, чтобы результирующее выражение было максимальным, нужно, чтобы оба операнда были также максимальны. Для операции сложения — то же самое. Для операции вычитания необходимо, чтобы левый операнд был максимальным, а второй — минимальным. Для нахождения выражения с минимальным значением можно поступать точно так же, только максимумы и минимумы меняются местами.

Оптимизируем наше решение, заменив функции построения списка всех деревьев и выбора «лучшего» из них на функции, которые будут находить экстремальное (максимальное или минимальное) значение для деревьев выражений, существенно ограничив перебор вариантов. Вместо функций build и allTrees, которые строили множество деревьев для последующего выбора из них максимального, напишем функции buildExtreme и extremeTree, которые будут строить одно «экстремальное» дерево, имеющее минимальное или максимальное значение. Общее количество построенных в результате работы деревьев останется тем же, но выбор будет производиться из существенно меньшего их числа на каждом этапе, что позволит резко сократить количество используемой памяти и время работы. Некоторое усложнение алгоритма будет состоять в том, что новые функции станут получать дополнительный аргумент, показывающий, максимальное или минимальное дерево выражения выбирается.

Новая программа представлена в полном объеме в листинге 6.9.

Листинг 6.9. Еще один вариант программы расстановки скобок в выражении import Data. Char (isDigit, isSpace).

import Data. List (partition, maximumBy, minimumBy, groupBy).

• — Типы данных для представления одной из трех операций
• — и дерева выражения, в терминальных узлах которого находятся
• — числа, а в нетерминальных узлах — операции.

type Op = Integer -> Integer -> Integer data Tree = Term Integer | Oper Op Tree Tree.

— Функция по заданному дереву выражения вычисляет его значение, calc:: Tree -> Integer calc (Term n) = n.

calc (Oper op tl t2) = op (calc tl) (calc t2).

• — Функции нахождения максимума и минимума в списке,
• — выбираемые по номеру.

maxMin:: [ (а -> а -> Ordering) -> [а] -> а].

maxMin = [maximumBy, minimumBy].

— Представление дерева в виде строки (скобочное представление). instance Show Tree where

show (Term n) = show n show (Oper op tl t2) =.

" («++ show tl ++ [showOp op] ++ show t2 ++ «)» .

— Анализ исходной строки с выделением знаков операций и операндов. divide: String -> ([Char], [Integer]) divide s = (map head ops, map read numbers) where (ops, numbers) =.

partition (not.isDigit.head) $.

groupBy (cl c2 -> isDigit cl == isDigit c2) $.

filter (not. isSpace) s.

— Преобразование знака операции в бинарную функцию. toOp:: Char -> (Integer -> Integer -> Integer) toOp с | c == ' + ' = (+).

I c == = (-).

| c == = (*).

• — Функции buildExtreme и extremeTree — две взаимно рекурсивные — функции, основные в этой реализации.
• — extremeTree строит дерево выражения с минимальным или — максимальным значением по спискам операций и операндов.
• — buildExtreme строит дерево выражения, в корне которого — находится операция из списка с заданным номером. extremeTree: Int -> ([Char], [Integer]) -> Tree extremeTree _ ([], [x]) = Term x

extremeTree n (ops, values) =.

(maxMin! !n) (l t2 -> compare (calc tl) (calc t2)) $ map (buildExtreme n ops values) [0.length ops — 1].

buildExtreme:: Int -> [Char] -> [Integer] -> Int -> Tree buildExtreme n ops values i = case op of

'+' -> Oper (toOp op) tMaxLeft tMaxRight -> Oper (toOp op) tMaxLeft tMinRight '*' -> Oper (toOp op) tMaxLeft tMaxRight.

where (opsLeft, (op:opsRight)) = splitAt i ops.

• (valsLeft, valsRight) = splitAt (i+1) values tMaxLeft = extremeTree n (opsLeft, valsLeft) tMaxRight = extremeTree n (opsRight, valsRight) tMinRight = extremeTree (1-n) (opsRight, valsRight)
• — Визуализация одной из трех операций ' + ', '¹ *'.
• — Выбор происходит по результату выполнения операции — над числами 2 и 1. showOp:: Op -> Char

showOp op = «-* + » ! ! fromlntegral (op 2 1 — 1).

• — Алгоритм работы основной функции по этапам:
• — сначала разделяем операнды и операции,
• — — затем строим дерево с максимальным значением выражения и
• — — выводим выражение в виде строки.

makeMaximum:: String -> String makeMaximum = show. (extremeTree 0). divide.

Проверим, как работают оба варианта решения при анализе строки, содержащей 14 операндов. Сначала — первый (неоптимизированный) вариант:

" makeMaximum «1+2−3*4+5−6+7*8−9*10−11+12−13*14» .

" ((1+2) — (3* ((4+5) — (((6+7) * (8- (9* ((10- (11 + 12)) -13)))) *14)))) «.

(32.26 secs, 5 434 212 448 bytes).

Теперь запустим второй вариант решения:

" makeMaximum «1+2−3*4+5−6+7*8−9*10−11+12−13*14» .

" ((1+2) — (3* (4 + (5- (((6+7) * (8 — (9* ((10- (11 + 12)) -13)))) *14))))) «.

(5.80 secs, 1 067 343 852 bytes).

Количество используемой памяти и время работы сократились более чем в 5 раз. Интересно, что форма результата в этих двух вариантах программы немного отличается друг от друга, хотя получившиеся выражения на самом деле эквивалентны и, разумеется, при вычислении дают одно и то же значение — 132 108.

Задача 6.4. Прямоугольная матрица, А типа [ [Integer] ] размера N х М содержит только положительные числа. Каждое число A[i] [ j ] содержит сумму штрафа, взимаемого за проход через данную клетку матрицы. Напишите функцию penalty:: [ [Integer] ] -> [ (Int, Int) ], которая находит путь из одной из клеток первой строки, А [ 0 ] [ i ] в одну из клеток последней строки A [N-l ] [ j ] с минимальной суммой штрафа вдоль клеток пути. Каждый шаг этого пути должен содержать переход из клетки некоторой строки в одну из трех соседних клеток следующей строки. Другими словами, из клетки, А [ i ] [ j ] разрешен переход в одну из клеток А[i+1].

[ j -1 ], А [ i+1 ] [ j ], А [ i+1 ] [j+1], так что, например, для матрицы размером 4×3 некоторый путь мог бы иметь вид [(0,1), (1,0), (2,1), (3,2)]. Если путей с минимальной суммой штрафа несколько, то функция может выдать любой из них.

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

Искомый путь должен быть представлен списком пар индексов, однако понятно, что фактически первые элементы этих пар представляют собой последовательные целые числа, так что фактически каждый путь определяется лишь вторыми элементами этих пар. Например, путь [(0,1), (1,0), (2,1), (3,2)] фактически может быть представлен списком [ 1,0,1,2] и получен из него применением функции (zip [0.. 3]). Так что в нашей программе мы будем хранить пути в виде простого списка чисел. Вместе с каждым путем будем хранить также длину этого пути.

Рассмотрим следующий пример. Пусть имеется квадратная матрица штрафов 0 2 0 6.

• 6 4 4 1
• 7 3 5 6
• 19 2 8

представляемая списком [[0,2,0,6], [6,4,4,1], [7,3,5,6], [1,9, 2,8] ]. Будем последовательно для каждой строки строить оптимальные пути из ячеек этой строки в последнюю строку матрицы. Для последней строки матрицы такие пути состоят из единственной клетки, и величина штрафа на этом пути составляет значение, записанное в данной клетке. Для приведенного примера соответствующие пары из величины суммарного штрафа и пути можно представить списком [(1/ [0]), (9, [1]), (2, [2]), (8, [3]) ].

Чтобы сформировать соответствующий список для предыдущей строки, нужно для каждой ячейки выбрать минимальное значение штрафа из трех соседних с ней клеток следующей строки, добавить величину штрафа из самой клетки и расширить путь. Для третьей строки матрицы из нашего примера получится следующий список:

[(8, [0,0]), (4, [1,0]), (7, [2,2]), (8, [3,2])].

Далее, обработка предыдущей, второй, строки матрицы даст в результате.

[ (10, [0,1,0]), (8, [1,1,0]), (8, [2,1,0]), (8, [3,2,2])].

Наконец, после обработки первой строки матрицы получим.

[ (8, [0,1,1,0]), (10, [1,1,1,0]), (8, [2,1,1,0]), (14, [3,2,1,0])]

Окончательный результат — минимальная сумма штрафов равна 8 на одном из двух путей — [ 0,1, 1,0 ] или [2,1,1,0b Заметим, что этот же результат можно было бы получить и на путях [2,3,2,2] или [ 2,2,1,0 ], эти пути могли бы получиться при немного другой стратегии выбора минимального значения.

Напомним, что сравнение кортежей и списков происходит в лексикографическом порядке, так что из двух значений (8, [0,0]) и (4, [1,0]) меньшим будет второе, поскольку 4 < 8, а из значений (8, [1,1,0]).

и (8, [2,1,0]) меньшим будет первое, так как [1,1,0] < [2,1,0].

При построении результатов мы производили сравнения именно, но этому правилу, так что из всех возможных оптимальных путей у нас в результате получился «самый левый», т. е. путь с минимальными значениями индексов.

Программирование этого алгоритма довольно просто. Сначала нужно научиться по заданному списку строить список минимальных значений из троек соседних элементов. Это делает следующая функция: min3Row:: Ord a => [a] -> [a].

min3Row row = zipWith3 min3 (head row :

row) row (tail row ++ [last row]) where min3 a b c = min a $ min b c.

Затем запрограммируем обработку очередной строки матрицы. Если, например, строка имела значение [7,3,5,61,™ сначала получим список пар [(7,0), (3,1), (5,2), (6,3)] с помощью конструкции z ip [7,3,5, 6] [0.. 4], а потом скомбинируем получившийся список пар со значениями минимальных путей, полученных на предыдущем этапе, складывая суммы штрафов со значениями, находящимися в ячейках строки матрицы, и присоединяя индекс ячейки к минимальным путям. Полный текст программы приведен в листинге 6.10.

Листинг 6.10. Нахождение пути с минимальным суммарным штрафом в матрице.

— По заданному списку строит список, каждый элемент которого — есть минимальное из трех соседних значений в исходном списке. min3Row:: Ord, а => [а] -> [а].

min3Row row = zipWith3 min3 (head row: row) row.

• (tail row ++ [last row]) where min3 a b c = min a $ min b c
• — Для каждой строки строит список минимальных путей от каждой — из клеток строки до последней строки матрицы, penalty: [[Integer]] -> [ (Int, Int) ] penalty matr = zip [0.m] $ snd $ minimum $

foldr step (replicate m (0,[])) matr where m = length $ head matr step row paths =.

zipWith ((s, j) (s', p) -> (s + s', j: p)).

(zip row [0.m]) (min3Row paths).

Проверим, как работает наша программа на приведенном в решении примере:

" penalty [[0,2,0,6], [6,4,4,1], [7,3,5,б], [1,9,2,8]].

[(0,0), (1,1), (2,1), (3,0)].

Задача 6.5. Назовем пирамидой список, в котором каждый элемент с заданным индексом i не больше, чем элементы с индексами (2*i + l) и (2*i+2), если элементы с такими индексами вообще существуют. Напишите функцию, проверяющую, является ли заданный список пирамидой.

Решение. Ясно, что проверять нужно лишь элементы с индексами от 0 до половины длины списка. Для всех таких элементов с индексом i в списке существует элемент с индексом (2*i+l), а элемент с индексом (2*i+2) может и не существовать для последнего элемента в списке, если всего элементов четное число. Проверку свойства пирамидальное™ можно выполнить, написав для каждого элемента списка list с индексом i формулу list! !i <= list! (2*i+l) && list!! i <= list! (2*i+2). Если нужно проделать такую проверку для всех элементов с индексами от 0 до т-1, то можно написать для этого следующие выражения: and $ zipWith (<=) (take m list).

(map (i->list! (2*i + l)) [0.m-l]).

and $ zipWith (<=) (take m list).

(map (i->list!!(2*i+2)) [0.m-l]).

Длину фрагмента списка, для которого нужно производить данные проверки, в этих двух выражениях следует вычислять по-разному, поскольку в случае четного числа элементов для вычисления второго выражения может понадобиться меньшее число элементов, чем для первого выражения. Обобщить оба эти выражения можно, написав следующую функцию проверки списка:

check list k = and $ zipWith (<=) (take m list).

(map (i -> list !! (2*i+k+l)) [0.m-l]).

where m = (length list — k) 'div' 2.

Здесь k — номер выражения для проверки свойства пирамидальное™. Тогда программа для проверки свойства пирамидальное™ списка целиком принимает следующий вид (листинг 6.11).

Листинг 6.11. Проверка пирамидальное™ списка

check list k = and $ zipWith (<=) (take m list).

(map (i -> list !! (2*i+k+l)) [0.m-l]).

where m = (length list — k) 'div' 2.

pyramid list = and $ map (check list) [0, 1].

Задача 6.6. Разработайте систему сдвигов позиции в двоичном дереве. Система должна позволять передвигаться по дереву как вниз, так и вверх.

Решение. В двоичном дереве позиция уже не определяется индексом элемента, как это было для списков. Конечно, можно разработать систему нумерации узлов и для двоичного дерева тоже, но все-таки более удобная система навигации получается, если считать, что попасть в определенный узел дерева можно, двигаясь от корня дерева вниз, последовательно переходя либо к правому, либо к левому поддереву текущего узла. Таким образом, указателем позиции в дереве может служить последовательность направлений, состоящая из значений «шаг влево» и «шаг вправо». Поскольку в конечном счете наша цель состоит в том, чтобы передвигаться в дереве не только в направлении от корня к листьям, но и в обратном направлении, то к списку возможных направлений добавим еще и «шаг вверх».

Итак, определим типы данных, которые задают возможные направления и пути передвижения позиции в дереве: data Direction = L | — вправо.

R | — влево.

U — вверх.

deriving (Eq, Show).

type Path = [Direction].

Для списков, имея индексы двух позиций в списке, можно было бы легко получить последовательность действий для перехода из одной позиции в другую, выполнив вычитание значений двух индексов. Разработаем для дерева операцию «вычитания путей», которая позволит вычислить нужную последовательность сдвигов позиции в дереве, чтобы перейти от одной позиции в дереве к другой. Будем считать, что исходные позиции представлены путями, содержащими только направления L и R, однако «разность» путей может содержать также и направления движения U.

Вообще говоря, чтобы из позиции pi попасть в позицию р2, можно подняться из позиции pi к корню дерева, а затем спуститься вниз в позицию р2, однако, если позиции pi и р2 имеют некоторую общую начальную составляющую, то эту общую часть можно «сократить». В этом и состоит основная идея сдвигов по дереву. Операция «вычитания путей» будет представлена в нашей программе функцией subtractPath: subtractPath:: Path -> Path -> Path.

subtractPath (xl:pl) (x2:p2) | xl == x2 = subtractPath pi p2.

subtractPath pi p2 = replicate (length p2) U ++ pi.

Модификатор, который описывает, как добраться до определенного узла в дереве и как преобразовать значение, лежащее в этом узле, описывается точно так же, как мы это делали для модификаторов списка, только в качестве указателя местоположения узла в дереве используется не индекс элемента, а путь в дереве:

type Modifier, а = (Path, а -> а) Описание типа данных двоичного дерева сделаем так, как это мы сделали в первый раз в параграфе 4.1:

data Tree, а = Null | Tree a (Tree a) (Tree a).

Самое интересное здесь — вопрос о том, как описать позицию в дереве. Нам нужно добиться, чтобы по любой позиции можно было получить новую позицию в дереве, которая получится, если сделать один шаг по дереву влево, вправо или вверх. Конечно, определяющим в выборе представления данных будет то, чтобы была возможность пройти по дереву вверх. В случае списка мы просто сохраняли в позиции список пройденных элементов списка. В случае дерева этого, очевидно, недостаточно для восстановления структуры. Ясно, что нужно по крайней мере запоминать список поддеревьев, пройденных из корпя дерева в данную позицию. В действительности необходимо еще знать, в какую сторону — влево или вправо — были сделаны шаги на этом пути. Таким образом, позиция в дереве может быть представлена следующим типом данных:

type Position, а = ([(Direction, Tree a)], Tree а) Приведем пример дерева, содержащего в узлах символы, и покажем, как будут представлены в этом дереве позиции некоторых элементов. Рассмотрим дерево, представленное на рис. 6.5.

Это дерево может быть представлено в языке Haskell выражением Tree ' d'.

• (Tree 'o'
• (Tree 't^T
• (Tree 's' Null Null)

Null).

• (Tree 'b'
• (Tree 'h' Null Null)
• (Tree 'y^f Null Null)))
• (Tree 'n'
• (Tree 'e' Null Null)

Null).

Рис. 6.5. Пример дерева, содержащего символы.

Для краткости будем обозначать одной буквой целое поддерево, корнем которого является эта буква. Например, все дерево обозначим буквой ¹ d¹, а поддерево из трех узлов, корнем которого является узел, содержащий символ 'Ь¹, обозначим буквой ^fb*. Тогда позиция корня дерева может быть представлена следующей структурой данных типа Position:

(П, d).

Позиция поддерева ^f b¹ может быть представлена структурой ([(R, о), (L, d)], b).

т.е. для того, чтобы попасть в корень дерева ¹ b¹, нужно сначала из корня ' d¹ спуститься влево, а потом из узла ¹ о¹ — вправо.

Начальная позиция для модификаций в дереве — позиция корня — может быть задана с помощью функции start: start:: Tree, а -> Position, а start tree = ([], tree).

Следующий ключевой момент — это сдвиг позиции в дереве на один шаг влево, вправо или вверх. При сдвигах вниз по дереву наращивается пройденный путь, при сдвигах вверх — наращивается дерево, представляющее в позиции текущий узел:

stepLeft, stepRight, stepUp:: Position a -> Position a stepLeft (path, t@ (Tree _ left _)) = ((L, t) :path, left).

stepRight (path, t0(Tree _ _ right)) = ((R, t) :path, right).

stepUp ((L, Tree root _ right) :path, t) =.

(path, Tree root t right) stepUp ((R, Tree root left _) :path, t) = (path, Tree root left t).

Как и для случая списков, введем некоторые сокращения для удобства записи операций над деревом. Во-первых, обозначим операцию применения функции с переставленными аргументами символами ($>); во-вторых, опишем функцию step, выполняющую последовательность заданных шагов из заданной позиции в дереве:

($>):: а -> (а -> b) -> b.

х $> f = f х step:: Path -> Position a -> Position a step path pos = foldl oneStep pos path where oneStep pos L = stepLeft pos.

oneStep pos R = stepRight pos oneStep pos U = stepUp pos.

Наконец, опишем аналоги функций replace, convert, extract, modify Pos и modify, которые для случая позиционирования в списках производили следующие операции:

• • replace — заменяет значение в текущем узле дерева, выполняя преобразование, заданное аргументом функции;
• • convert — преобразует список модификаторов, содержащих абсолютные пути до некоторых узлов дерева в список модификаторов, содержащих вместо абсолютных путей сдвиги по дереву;
• • extract — извлекает модифицированное дерево из текущей позиции, проходя вверх по дереву до его корня;
• • modifyPos — выполняет последовательно модификации дерева, заданные списком модификаций;
• • modify — функция-оболочка, которая берет исходное дерево, формирует начальную позицию в корне, запускает выполнение списка модификаций дерева и возвращает модифицированное дерево.

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

Листинг 6.12. Модуль, определяющий функции для последовательной модификации дерева

module TreeModifier (Tree (. .), Direction (. .), Modifier, modify) where

data Direction = L | — вправо.

R | — влево.

U — вверх.

deriving (Eq, Show).

type Path = [Direction].

subtractPath:: Path -> Path -> Path.

subtractPath (xl:pl) (x2:p2) | xl == x2 = subtractPath pi p2.

subtractPath pi p2 = replicate (length p2) U ++ pi.

data Tree a = Null | Tree a (Tree a) (Tree a).

type Modifier a = (Path, a -> a).

type Position a = ([(Direction, Tree a)], Tree a).

($>):: a -> (a -> b) -> b.

x $> f = f x.

start:: Tree a -> Position a start tree = ([], tree) stepLeft: Position a -> Position a.

stepLeft (path, t@(Tree _ left _)) = ((L, t) :path, left) stepRight: Position a -> Position a.

stepRight (path, t@(Tree _ _ right)) = ((R, t):path, right).

stepUp:: Position a -> Position a stepUp ((L, Tree root _ right) :path, t) =.

(path, Tree root t right).

stepUp ((R, Tree root left _) :path, t) = (path, Tree root left t).

step:: Path -> Position a -> Position a step path pos = foldl oneStep pos path where oneStep pos L = stepLeft pos.

oneStep pos R = stepRight pos oneStep pos U = stepUp pos.

extract:: Position a -> Tree a.

extract ([], t) = t.

extract p = extract $ stepUp p.

replace:: (a -> a) -> Position a -> Position a replace f (path, t@(Tree v left right)) =.

(path, Tree (f v) left right).

convert:: [Modifier a] -> [Modifier a] convert acts = zip (diffs paths) actions where (paths, actions) = unzip acts diffs [] = [].

diffs list@(x:e) = x: zipWith subtractPath e list.

modifyPos: [Modifier a] -> Position a -> Position a modifyPos actions list = foldl act list actions where act mList (n, action) =.

mList $> step n $> replace action.

modify:: [Modifier a] -> Tree a -> Tree a modify actions tree = tree $> start $>

modifyPos (convert actions) $> extract.

Приведем пример использования этого модуля. Пусть задано дерево из символов, приведенное в качестве примера и изображенное на рис. 6.5. Его узлы 's', ' b' и ' h' имеют следующие «адреса»:

s: [L, L, L].

b: [L, R] h: [L, R, L].

Составим модификаторы, которые заменят значения в этих узлах на символы ' t', ' m' и ' г' соответственно: ml, m2, m3: Modifier Char ml = ([L, L, L], const ' t¹).

m2 = ([L, R], const 'm') m3 = ([L, R, L], const 'r').

Отметим применение стандартной функции const, которая создает константную функцию, возвращающую значение, заданное аргументом функции const. Для контроля исходных данных и результата напишем еще функцию getSymbols, которая будет собирать символы дерева в одну строку. Дерево будем проходить «в ширину», используя для этого известный алгоритм, хранящий промежуточные данные для обхода дерева в очереди:

getSymbols: Tree Char -> String getSymbols t = fromQueue [t] «» where

fromQueue:: [Tree Char] -> String -> String.

fromQueue [] = id.

fromQueue (Null:q) = fromQueue q.

fromQueue (Tree с 1 r: q) = (c:). fromQueue (q ++ [1, r]).

Теперь можно проверить содержимое исходного дерева, а затем модифицировать его и проверить результат:

>> getSymbols example «dontbeshy» .

" getSymbols $ modify [ml, m2, m3] example «dontmetry» .

Решение полностью закончено и проверено.