Eugene Kirpichov (antilamer) wrote,
Eugene Kirpichov
antilamer

Проверка двудольности графа

Сидящему рядом коллеге дали ДЗ по хаскеллу - написать проверку двудольности графа. Он написал, я переписал. Полученный вариант мне очень нравится, особенно отмеченный кусок :)
Алгоритм самый обыкновенный: проходимся по всем вершинам последовательно (mapM_ fill), для нераскрашенных устраиваем поиск в глубину с чередующейся раскраской слоев (spread).

module Test where

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 ""
Subscribe
  • Post a new comment

    Error

    Anonymous comments are disabled in this journal

    default userpic

    Your reply will be screened

    Your IP address will be recorded 

  • 26 comments