You are viewing lionet

Previous Entry | Next Entry

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


Вот здесь 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:

Comments

( 114 comments — Leave a comment )
_navi_
Nov. 2nd, 2009 09:23 am (UTC)
Может вместо слова «карта» будет правильнее использовать слово «отображение»? Или по какой-то причине оно специально избегается?
lionet
Nov. 2nd, 2009 09:27 am (UTC)
Попробовал "отображение". Слух режет, честно говоря. Для меня Map это map, по-английски, а не "отображение", по-русски.
(no subject) - _navi_ - Nov. 2nd, 2009 09:45 am (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 09:50 am (UTC) - Expand
(no subject) - _navi_ - Nov. 2nd, 2009 07:17 pm (UTC) - Expand
(no subject) - itman - Nov. 2nd, 2009 04:12 pm (UTC) - Expand
squadette
Nov. 2nd, 2009 09:25 am (UTC)
Антиламер -- это Кирпичов :)
lionet
Nov. 2nd, 2009 09:27 am (UTC)
Это тот самый, который в первом выпуске http://fprog.ru/ был? ;)
(no subject) - squadette - Nov. 2nd, 2009 09:28 am (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 09:28 am (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 03:21 pm (UTC) - Expand
(no subject) - squadette - Nov. 2nd, 2009 03:23 pm (UTC) - Expand
metaclass
Nov. 2nd, 2009 09:30 am (UTC)
Не совсем понимаю, в Maybe монаду это заворачивается только благодаря тому что мы вызываем isJust?
Еще конечно, интересно использование $ - можно ли считать, что это эквивалентно окружению оставшейся части строки в скобки?
(mapM_ (fill g) (indices g)) - тут вроде не (fill g) а просто fill должно быть.
lionet
Nov. 2nd, 2009 09:35 am (UTC)
1. Да: мы тут же меняем тип выражения, и используем fail из другого инстанса тайп-класса Monad: из инстанса Maybe тайп-класса Monad.
2. Да. Это инфиксная функция такая, ($), которая определена как "приложить то, что слева от меня, к тому, что справа", с наинизшим приоритетом: ($) f g = f g, или f $ x = f x.
3. Как ты мог заметить, я убрал fill и spread из-под "where", сделав их самостоятельными функциями. А им внутри нужен граф, который я туда просто первым аргументом пустил.
(no subject) - metaclass - Nov. 2nd, 2009 10:02 am (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 10:03 am (UTC) - Expand
(no subject) - metaclass - Nov. 2nd, 2009 10:23 am (UTC) - Expand
(no subject) - voidex - Nov. 2nd, 2009 10:33 am (UTC) - Expand
pufpuf
Nov. 2nd, 2009 10:25 am (UTC)
такой сложный код для такого простого алгоритма :(
lionet
Nov. 2nd, 2009 10:26 am (UTC)
Напиши твой вариант, плиз?
quick & dirty на lisp'е за 20 минут - pufpuf - Nov. 2nd, 2009 10:57 am (UTC) - Expand
(no subject) - voidex - Nov. 2nd, 2009 10:42 am (UTC) - Expand
(no subject) - pufpuf - Nov. 2nd, 2009 11:00 am (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 11:04 am (UTC) - Expand
(no subject) - pufpuf - Nov. 2nd, 2009 11:12 am (UTC) - Expand
(no subject) - tzirechnoy - Nov. 2nd, 2009 11:22 am (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 11:24 am (UTC) - Expand
(no subject) - tzirechnoy - Nov. 2nd, 2009 11:46 am (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 11:53 am (UTC) - Expand
(no subject) - pufpuf - Nov. 2nd, 2009 12:01 pm (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 12:11 pm (UTC) - Expand
(no subject) - tzirechnoy - Nov. 2nd, 2009 12:30 pm (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 12:32 pm (UTC) - Expand
(no subject) - _arty - Nov. 2nd, 2009 01:05 pm (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 01:11 pm (UTC) - Expand
(no subject) - _arty - Nov. 2nd, 2009 01:30 pm (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 01:32 pm (UTC) - Expand
(no subject) - _arty - Nov. 2nd, 2009 01:40 pm (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 01:44 pm (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 01:49 pm (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 01:52 pm (UTC) - Expand
(no subject) - _arty - Nov. 2nd, 2009 01:54 pm (UTC) - Expand
(no subject) - _arty - Nov. 2nd, 2009 01:46 pm (UTC) - Expand
(no subject) - voidex - Nov. 2nd, 2009 11:35 am (UTC) - Expand
(no subject) - lionet - Nov. 2nd, 2009 11:39 am (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 11:40 am (UTC) - Expand
(no subject) - voidex - Nov. 2nd, 2009 12:22 pm (UTC) - Expand
(no subject) - tzirechnoy - Nov. 2nd, 2009 11:52 am (UTC) - Expand
(no subject) - zfsed [ya.ru] - Nov. 2nd, 2009 01:59 pm (UTC) - Expand
(no subject) - voidex - Nov. 2nd, 2009 02:40 pm (UTC) - Expand
zhengxi
Nov. 2nd, 2009 11:19 am (UTC)
А это кошерно использовать Map, ключами которого будут 1..число_узлов ?
Может быть, на его месте будет лучше применить Array Int (Unknown|Color1|Color2)?
antilamer
Nov. 2nd, 2009 11:20 am (UTC)
Какой именно Array? Про эффективность не забывайте. STArray мне использовать не хотелось, т.к. с ним код бы получился гораздо сложнее (был бы уже не StateT, а какой-то STT) и менее близким к предметной области.
(no subject) - zhengxi - Nov. 2nd, 2009 11:33 am (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 11:35 am (UTC) - Expand
(no subject) - lomeo - Nov. 2nd, 2009 01:11 pm (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 01:48 pm (UTC) - Expand
(no subject) - lomeo - Nov. 2nd, 2009 02:56 pm (UTC) - Expand
(no subject) - lomeo - Nov. 2nd, 2009 02:57 pm (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 03:12 pm (UTC) - Expand
(no subject) - lomeo - Nov. 2nd, 2009 03:15 pm (UTC) - Expand
(no subject) - antilamer - Nov. 2nd, 2009 03:19 pm (UTC) - Expand
(no subject) - _adept_ - Nov. 3rd, 2009 08:56 pm (UTC) - Expand
faceted_jacinth
Nov. 2nd, 2009 11:51 pm (UTC)
Ви таки мине извините что влезаю в вашу высокоинтеллектуальную дискуссию о преимуществах Lithp перед Haskell и наоборот, но
def is_bipartite(graph): # graph is {id : [id], ...}
    colors = {} # {id : bool, ...}
    def paint(node, color):
        current_color = colors.get(node, None)
        if current_color is None:
            colors[node] = color
            return all(paint(edge, not color) for edge in graph[node]) 
        return current_color == color

    return all(paint(node, True) for node in graph if node not in colors)

на строчку длиннее хаскелевского монстрозити но читается по сравнению с ним как плейнтекст. Ну, правда, если это показать практически любому программисту, хоть он сразу всё поймёт, даже если он всю жизнь писал на Паскале (ок, тут гоню, если он это делал, то не поймёт, и Паскаль сам по себе тут ни при чём). Удивление от генераторов будет выглядеть как "и так можно? офигеть", а вовсе не "что это за херняааа?!". Его не нужно объяснять, вообще.

Кстати прозреваю, что если не строчками мерять, а лексемами, то оно и вовсе в два раза проще.

Мораль же сей истории такова: имплементация императивного по сути алгоритма на Хаскеле требует огромного количества плясок вокруг, включая множесто двух- и трёхсимвольных операторов. Это всё в данном случае нафиг не нужно. Не следует демонстрировать мощь Хаскеля на подобных задачах, результат получается прямо обратный.

Алсо, бонус, на "статически типизированном Питоне", как мы как бэ с надеждой называем sea octothorpe. Оно несколько длиннее потому, что LINQ принято писать по действию на строчку.
faceted_jacinth
Nov. 3rd, 2009 12:03 am (UTC)
Забыл сказать главное-то. Красной нитью через повествование проходит идея о том, что если как следует напрячься и изучить весь синтаксис, а потом весь новый синтаксис частоиспользуемых библиотек, а в завершение ещё и моск перестроить, чтобы начал думать в PF терминах, то подобный говнокод можно будет читать практически ничего не рисуя на бумажке.

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

Если вы на него хотите ответить стандартно, как вы это уже делали, дескать я на самом деле на Хаскеле пишу, даже когда на Питоне или Шарпе, то нет, я пишу именно на Питоне или Шарпе и несколько удивляюсь, когда мне предлагают именно писать именно на Хаскеле, вместо того, чтобы, как заповедовал сам SPJ, смотреть на него издалека и тырить клёвые идеи.
(no subject) - lionet - Nov. 3rd, 2009 01:46 am (UTC) - Expand
faceted_jacinth
Nov. 3rd, 2009 12:20 am (UTC)
Ах, и ещё, пока не забыл, за прятанье эксепшенов в isJust нужно бить бамбуковыми палками по пяткам. За разработку языка, в котором принято прятать эксепшены ..., нужно ... .
(no subject) - antilamer - Nov. 3rd, 2009 04:35 am (UTC) - Expand
faceted_jacinth
Nov. 3rd, 2009 12:48 am (UTC)
This I like even better. And it's shorter.

def is_bipartite(graph): # graph is {id : [id], ...}
    colors = {} # {id : bool, ...}
    def paint(node, color):
        current_color = colors.get(node, None)
        if current_color is not None: return current_color == color
        colors[node] = color
        return all(paint(edge, not color) for edge in graph[node]) 

    return all(paint(node, True) for node in graph if node not in colors)
(no subject) - pufpuf - Nov. 3rd, 2009 07:35 am (UTC) - Expand
(no subject) - faceted_jacinth - Nov. 3rd, 2009 09:25 am (UTC) - Expand
(no subject) - faceted_jacinth - Nov. 3rd, 2009 09:30 am (UTC) - Expand
zamotivator
Nov. 3rd, 2009 01:04 am (UTC)
Спасибо, непонятная херня стала понятной.
antilamer
Nov. 3rd, 2009 04:34 am (UTC)
Мне нравится этот вариант на питоне и я тоже считаю, что prerequisites для его понимания намного меньше чем к коду на хаскелле.
Ваша же мораль звучит, по сути, как "Мне не нужно изучать хаскель, чтобы проверить граф на двудольность". Полностью согласен, не изучайте на здоровье.
Мой исходный пост вообще был просто моим собственным упражнением в программировании на хаскеле, а пост Льва - полагаю, экскурсией в стиль хаскела. Никто не говорил, "а попробуйте-ка на питоне напишите, наверняка так же классно не выйдет".
zhengxi
Nov. 3rd, 2009 04:36 am (UTC)
Да.
И питоновская is_bipartite() тоже вполне Pure Functional.

Странно, что в Хаскелле (всё еще) нет какого-то DSL, позволяющего описывать императивные алгоритмы прямо, без монадных конвертеров и прочих наворотов.
Re: Да. - lomeo - Nov. 3rd, 2009 10:58 am (UTC) - Expand
Re: Да. - zhengxi - Nov. 3rd, 2009 11:20 am (UTC) - Expand
Re: Да. - lomeo - Nov. 3rd, 2009 12:19 pm (UTC) - Expand
Re: Да. - zhengxi - Nov. 3rd, 2009 12:52 pm (UTC) - Expand
kola.name.myopenid.com
Nov. 3rd, 2009 10:40 pm (UTC)
Я хоть преимущественно на Дельфе и Сях кодил и кодю, но о Питоне представление имею. Но все равно ваш код меня сильно подгрузил. Пришлось читать про двудольный граф и алгоритм проверки в Вики. И вещи вроде get(node, None) и All(...) сильно заставляют тупить, кажутся надуманными, я не уверен, что правильно их понял. Ну не мануалы же по Питону читать!

На Паскале, кстати, не сильно длинее(бегины с эндами кучу строк занимают):

type NodeList = array of int;
type Graph = array of NodeList;
type Colors = array of int; // 0 - None; 1 - Первый цвет; 2 - Второй цвет.

function isBipartite(grph: Graph): boolean;
var clrs: Colors;

function Paint(node, color: integer): boolean;
var i: integer;
begin
if clrs[node] then return color = node;
else
begin
clrs[node]:=color;
for i:=0 to Length(grph[node])-1 do
if not Paint(grph[node], abs(1-3)) then begin return false; break; end;
end;
end;

begin
if length(grph) = 0 then begin return false; exit; end; //для приличия
SetLength(clrs, Length(grph));
return Paint(0, 1); //подразумеваем связанный граф
end;

Правда тут строгая нумерация нодов в отличие от вашего решения. Писал в блокноте, сам на пасме давненько не писал, мог ошибиться где-то...

По поводу функционального решения, безосновательное IMHO - тут больше подошло бы представление просто в виде набора ребер, а вообще, даже Хаскелю не хватает абстракции, чтобы естественным образом представить процесс закрашивания. Ну на то он и процесс, чтобы императивно описываться. :)
(no subject) - kola.name.myopenid.com - Nov. 3rd, 2009 10:43 pm (UTC) - Expand
(no subject) - kola.name.myopenid.com - Nov. 3rd, 2009 10:46 pm (UTC) - Expand
_adept_
Nov. 5th, 2009 12:36 pm (UTC)
Вот дословное переложение кода на питоне, приведенного выше.

Добавлено немного синтаксического сахара:
1)цвета - это не Bool, а Red/Blue
2)Всякие, гхм, пугающие некоторых функции вынесены в "run" и "allTrue", чтобы облегчить чтение кода:

data Color = Red | Blue deriving Eq

isBipartite' graph = run $ do
  allTrue [ paint True node Red | node <- indices graph ]
  where
    paint isSeed node color = do
      current <- gets (M.lookup node)
      case current of
        Nothing -> do modify (M.insert node color)
                      allTrue [ paint False edge (swap color) | edge <- graph!node ]
        Just someColor -> if isSeed then return True
                                    else return (color == someColor)

    swap Red  = Blue
    swap Blue = Red

    run = flip evalState M.empty
    allTrue actions = sequence actions >>= return . and


Так что написать можно по-всякому.
(no subject) - pufpuf - Nov. 5th, 2009 01:06 pm (UTC) - Expand
(no subject) - pufpuf - Nov. 5th, 2009 01:09 pm (UTC) - Expand
(no subject) - _adept_ - Nov. 5th, 2009 02:08 pm (UTC) - Expand
zamotivator
Nov. 3rd, 2009 01:03 am (UTC)
Я уже в середине потерялся, и перестал понимать что происходит
Питон, Окамль, Ерланг, Си - для работы.
Хаскелль - полюбоваться.
antilamer
Nov. 3rd, 2009 04:29 am (UTC)
Таки никто не спорит, что пока ты не знаешь хаскель, то тебе только и остается, что любоваться. Так что следует читать:
Питон, Окамль, Ерланг, Си - zamotivator'у для работы.
Хаскелль - zamotivator'у полюбоваться.
(no subject) - zamotivator - Nov. 3rd, 2009 10:19 am (UTC) - Expand
(no subject) - antilamer - Nov. 3rd, 2009 10:47 am (UTC) - Expand
(no subject) - zamotivator - Nov. 3rd, 2009 10:56 am (UTC) - Expand
(no subject) - antilamer - Nov. 3rd, 2009 11:14 am (UTC) - Expand
_adept_
Nov. 3rd, 2009 01:50 pm (UTC)
Дурацкий вопрос
А вот такой вот простой вариант разве не будет работать:
naiveBipartite g = all even $ -- Если все четные - пасьянс сошелся
        map (sum . map snd) $ -- Считаем четность вершины
        groupBy ((==) `on` fst) $ -- Группируем записи по каждой вершине в отдельный список
        sort $ -- Сортируем список пар (вершина, цвет)
        concat [ [ (from,1), (to,(-1)) ]  -- Красим концы всех ребер в разные (1/-1) цвета
               | (from,edges) <- assocs g, to<-edges ]


Edited at 2009-11-03 01:53 pm (UTC)
antilamer
Nov. 3rd, 2009 02:21 pm (UTC)
Re: Дурацкий вопрос
Нет, не будет. Возьми полный граф любой четной степени, например, 4.
kola.name.myopenid.com
Nov. 4th, 2009 08:41 am (UTC)
int = 1,2,...
bln = tr | fs
grph = {} | {(int, {int,...}),...}
pnt = {} | {(int | (int,bln), {int | (int,bln),...}),...}

not tr = fs
not fs = tr

isBiptt (int0, {...}) : grph = isBiptt ((int0,tr), {...}) : grph
isBiptt ((int0,bln0), int1 % {...}) : (int1, {...}) % pnt = isBiptt ((int0,bln0), (int1,not bln0) % {...}) : ((int1,not bln0), {...}) % pnt
isBiptt ((int0,bln0), int1 | (int1,bln) : {...}) : ((int1,bln0), {...}) : pnt = fs
isBiptt {((int,bln), {(int,bln),...}),...} = tr

где (...) - список;
{...} - множество;
x : {...}, x - произвольный элемент множеества;
x % {...}, x - каждый элемент множества (удовлетворяющий паттерну)
если type - тип, то type0, type1... - конкретные значения данного типа

Вроде крайне функционально и быстро должно получиться, если бы не ошибки. Интересно, можно ли написать такой транслятор.
kola.name.myopenid.com
Nov. 4th, 2009 08:54 am (UTC)
Только для пущей правильности надо сделать так.
isBiptt (int0, {...}) : grph0 = isBiptt ((int0,tr), {...}) : grph0

И, наверное, так.
isBiptt ((int0,bln0), int1 % {...}) : (int1, {...}) % pnt0 = isBiptt ((int0,bln0), (int1,not bln0) % {...}) : ((int1,not bln0), {...}) % pnt0
( 114 comments — Leave a comment )

Profile

lionet
Lev Walkin
Website

Latest Month

July 2014
S M T W T F S
  12345
6789101112
13141516171819
20212223242526
2728293031  
Powered by LiveJournal.com
Designed by yoksel