path: root/90-94/92.hs

import Data.List (sortBy)
import Data.Ord (comparing)

vonKoch :: [(Int, Int)] -> [[(Int, Int)]]

vonKoch edges = koch (reverse adj) [] [] []
    where koch [] _ _ vplan = return vplan
          koch ((v, us):vs) eused vused vplan =
            do (vn, eused') <-  [(x, eused')
                                | x <- [1..maxvn],
                                  x `notElem` vused,
                                  let en = map (abs . (x-)) (map (findn vplan) us),
                                  let (eused', f) = foldl (\(l, f) d ->
                                        (d:l, f && d `notElem` l
                                                && 1 <= d && d <= maxen))
                                        (eused, True) en, f]
               koch vs eused' (vn:vused) ((v, vn):vplan)
          maxen = length edges
          maxvn = maxen + 1
          deg x = length $ filter (\(a, b) -> a == x || b == x) edges
          genAdj [] = []
          genAdj (v:vs) = (v, [u | u <- vs, (v, u) `elem` edges || (u, v) `elem` edges]):genAdj vs
          findn vplan u = snd $ head $ filter ((== u) . fst) vplan
          adj = genAdj $ sortBy (comparing deg) [1..maxvn]