Lev Walkin (lionet) wrote,
Lev Walkin
lionet

Category:

Комментарий алгоритма

Вот здесь antilamer проверяет двудольность графа, а вот здесь metaclass, по всей видимости, чуть-чуть не догоняет, что происходит.

Попробую предложить расшифровку алгоритма, который я вижу первый раз, мопед не мой, кто такой антиламер — не знаю, и подобного задания никогда в жизни не видел. Всё честно (ну может, кроме знания о том, кто такой антиламер).

Код в изначальной записи:
import qualified Data.Map as M
import Data.Maybe
import Data.Array
import Control.Monad
import Control.Monad.State
import Control.Monad.IfElse

type Graph = Array Int [Int]

isBipartite g = isJust $ runStateT (mapM_ fill (indices g)) M.empty
  where
    fill     v = whenM (M.notMember v`fmap`get) $ spread True v
    spread k v = whenM (paint k v)              $ mapM_ (spread (not k)) (g!v)

paint k v = get >>= \c -> case M.lookup v c of 
    Nothing     -> put (M.insert v k c) >> return True
    Just x|x==k ->                         return False
          |True ->                         fail ""

Перед расшифровкой выясним, что такое двудольный граф: http://en.wikipedia.org/wiki/Bipartite_graph
Там есть и алгоритм тестирования на двудольность: «Testing bipartiteness».

Определим тип, который будет хранить наш граф. Граф имеет набор вершин, адресуемых по их уникальным целочисленным индексам, например вершины 1, 2, 3. Кроме этого граф должен для каждой вершины иметь несколько ветвей, ведущих в другие вершины. Допустим, с каждой вершиной (Int) ассоциирован список соединённых с ней ветвью вершин (список индексов вершин: [Int]).

Будем хранить весь граф в виде массива вершин, каждой из которой поставлен в соответствие список ветвей (индексов соединённых с данной вершиной вершин).

> -- Каждой вершине типа Int ставится в соответствие список вершин, соединённых с ней: [Int]
> type Graph = Array Int [Int]


Мы хотим иметь функцию, которая для данного графа даёт нам Bool (True или False), в зависимости от того, является ли граф двудольным. Назовём её isBipartite. Соответственно, тип этой функции будет чем-то типа Graph → Bool:

> isBipartite :: Graph -> Bool

По желанию автора этой программы, мы будем вычислять наш ответ в монаде State, сконструированной поверх Map: состоянием является отображение (карта, ассоциативный массив) типа Map Int Bool, которое мы протаскиваем через вычисления. (Для самого поверхностного, первоначального понимания можно представить, что такая монада соответствует в императивных языках осуществлению вычислений над ассоциативным массивом, лежащим в глобальной переменной.) Вот как мы можем делать что-то в монаде State, которая начальным состоянием имеет пустое отображение Map Int Bool:

runStateT long_and_complex_computation Data.Map.empty

Например, код, не выполняющий почти ничего: игнорирующий протаскиваемое состояние и дающий константный ответ:

*Test> runStateT (return 42) Data.Map.empty
(42,fromList [])
*Test>


Как видим, в этом коде нам вернулась пара: финальное значение и финальное состояние. fromList [] — это как раз состояние: репрезентация Data.Map.empty.

А вот код, который нам просто возвращает начальное состояние:

*Test> runStateT (get) Data.Map.empty
(fromList [],fromList [])
*Test>


Одной особенностью вычисления в монаде является возможность быстрого завершения вычислений: fail. (Быстрая интуиция: часто fail в монаде моделирует исключение в императивных языках). Этот fail в нашей монаде, организованной через монадный трансформер, ничего не делает, кроме выкидывания исключения в монаду повыше. Вот, например:

*Test> runStateT (fail "oops") Data.Map.empty
*** Exception: user error (oops)
*Test>


Из-за того, что вычисления в строке ghci происходят в монаде IO, мы видим "*** Exception: user error (oops)", который порождён именно монадой IO, в которую runStateT "передала" исключение. Но ведь можно и по-другому: давайте завернём runStateT в монаду попроще: Maybe, которая превращает исключения в Nothing, а всё остальное просто возвращает как есть:

*Test> fromJust $ runStateT (return 42) Data.Map.empty
(42,fromList [])
*Test> isJust $ runStateT (fail "oops") Data.Map.empty
False
*Test> case runStateT (fail "oops") Data.Map.empty of Nothing -> "yes, got Nothing"
"yes, got Nothing"
*Test>


Для простоты, будем считать аварийное завершение нашего алгоритма неуспехом (граф не двудольный), а неаварийное — тем, что у нас граф двудольный. У нас есть специальная функция: isJust, которая различает между Just a и Nothing, возвращая True или False, соответственно. Раз Nothing в монаде Maybe возвращается тогда, когда мы вызываем в этой монаде fail, это как раз то что нужно, чтобы отловить "исключение" и превратить его в булево значение:

*Test> isJust $ runStateT (fail "oops") Data.Map.empty
False
*Test> isJust $ runStateT (return 42) Data.Map.empty
True
*Test>


Вооружившись знанием того, как исключение в какой-то монаде превратить в True/False, рассмотрим определение isBipartite, как оно дано в рассматриваемом коде.

> isBipartite g = isJust $ runStateT (mapM_ (fill g) (indices g)) Data.Map.empty

Курсивом выделено то самое "длинное вычисление", которое мы делаем в монаде. Что такое mapM_: эта функция вычисляет (fill g) для каждой вершины графа g (indices g), в данной монаде. Вызов indices g для нашего гипотетического графа с вершинами 1, 2, 3, даст просто [1, 2, 3].

То есть, мы чего-то там заполняем (fill: наполнить) для каждой вершины оригинального графа. Судя по коду, именно в fill должна происходить магия, использующая вспомогательное "глобальное" состояние — отображение Data.Map.

И верно: fill g использует get, для того, чтобы втащить состояние (изначально равное Data.Map.empty) внутрь нашего вычисления:

> fill g v = whenM (Data.Map.notMember v`fmap`get) $ spread g True v

Здесь мы для каждой вершины v (помним, что функции fill g v передаётся одна за другой все вершины графа, выраженные индексами) вычисляем, есть ли эта вершина в нашем "глобальном" состоянии — отображении Data.Map. Если нет этой вершины (значит, не обрабатывали ещё)?, для неё вызываем spread g True v, которая что-то там раскрашивает (paint):

> spread g k v = whenM (paint k v) $ mapM_ (spread g (not k)) (g!v)

А, вот оно что: функция spread, если удалось раскрасить (paint), то для каждой вершины, с которой соединена данная вершина (g!v, помните, что в нашем графе каждой вершине v поставлен в соответствие список вершин, с которыми она соединена?) мы запускаем себя же (spread), с противоположным вторым аргументом. Граф — первый аргумент, а второй аргумент, получается, это серия чередующихся True/False/True/….

То есть, мы идём и красим вершины, которые встречаем, краской k, которая то True, то False, попеременно.

Как мы это делаем? Вот в этом коде мы опять встречаем get, который нам выдаёт текущее значение "глобального" отображения Data.Map, которое мы протаскиваем в монаде состояния:

> paint k v = get >>= \c -> case Data.Map.lookup v c of
   Nothing -> put (Data.Map.insert v k c) >> return True
   Just x|x==k -> return False
         |True -> fail ""


Здесь для вершины v мы смотрим, есть ли она в нашем отображении Data.Map, е если есть, и покрашена также, как мы её и пытаемся раскрасить, то это одно дело (возвратим False, для того чтобы перестать раскрашивать дальше (код whenM paint … внутри spread), ибо цикл), а если пытаемся раскрасить другой краской, то, извините, граф не двудольный. Вызываем fail "", который, как мы знаем, приводит к тому, что исключение нашей монадой выбрасывается на уровень монады Maybe, которая даёт Nothing, который даёт False в итоге для нашей функции isBipartite.

Если же в нашем "глобальном состоянии" ещё ничего не известно про вершину v, добавляем её с указанным цветом (put (Data.Map.insert v k c)) и возвращая (return True), который попадёт в whenM paint … внутри spread, вызвав рекурсивный спуск spread далее по вершинам графа.

Всё. Ровно как в википедии, там даже картинка есть.

Неточности в формулировках присутствуют; кому глаза режет — с удовольствием заменю неточности на ваши уточнения.

Upd: Ещё пара вариантов алгоритма: http://users.livejournal.com/_adept_/99610.html
Tags: haskell
Subscribe
  • Post a new comment

    Error

    Anonymous comments are disabled in this journal

    default userpic

    Your IP address will be recorded 

  • 112 comments