EulerCycle.hs

import Control.Applicative ((<$>))
import Data.List (partition)

type Edge = [Int]

findCycle :: [Int] -> [Edge] -> Maybe [Int]
findCycle vs es =
	if (not $ all (even . length . adjacent es) vs) || (segmentsCount vs es > 1)
	then Nothing
	else Just $ let (cycle, rest) = buildCycle (head vs) es in builder cycle rest

builder :: [Int] -> [Edge] -> [Int]
builder cycle [] = cycle
builder cycle es =
	let (left, (pivot:right)) = splitCycle cycle es in
	let (cycle', es') = buildCycle pivot es in
	builder (left ++ pivot:cycle' ++ right) es'

splitCycle :: [Int] -> [Edge] -> ([Int], [Int])
splitCycle vs es =
	let hasEdges v = length (adjacent es v) > 0 in
	(takeWhile (not . hasEdges) vs, dropWhile (not . hasEdges) vs)

buildCycle :: Int -> [Edge] -> ([Int], [Edge])
buildCycle start es = go start start es []

go :: Int -> Int -> [Edge] -> [Int] -> ([Int], [Edge])
go start v es acc =
	case adjacent es v of
		(next:_) | next == start -> (v:acc, (removeEdge v next es))
		(next:_) -> go start next (removeEdge v next es) (v:acc)

removeEdge :: Int -> Int -> [[Int]] -> [[Int]]
removeEdge _f   _t  [] = []
removeEdge from to (e@[a, b]:es)
	| (from == a && to == b) || (to == a && from == b) = es
	| otherwise = e : removeEdge from to es

adjacent :: [[Int]] -> Int -> [Int]
adjacent es v =
	let (adj, _) = partition (elem v) es in
	concat $ map (filter (/= v)) adj

readNumList :: String -> [Int]
readNumList = map read . words

segmentsCount :: [Int] -> [[Int]] -> Int
segmentsCount [] _ = 0
segmentsCount (v:vs) edges = let (vs', es') = mark v vs edges in 1 + segmentsCount vs' es'
 
mark :: Int -> [Int] -> [[Int]] -> ([Int], [[Int]]) 
mark v vs es =
	let (adjEdges, another) = partition (elem v) es in
	let adj = map (head . filter (/= v)) adjEdges in
	foldl (\(vs, es) v -> mark v (filter (/= v) vs) es) (vs, another) adj

main :: IO ()
main = do
	[v, e] <- readNumList <$> getLine
	edges <- map readNumList <$> (sequence $ replicate e getLine)
	case findCycle [1..v] edges of
		Nothing -> putStrLn "NONE"
		Just cycle -> putStrLn . unwords . map show $ cycle