summaryrefslogtreecommitdiff
path: root/90-94/92.hs
diff options
context:
space:
mode:
Diffstat (limited to '90-94/92.hs')
-rw-r--r--90-94/92.hs24
1 files changed, 24 insertions, 0 deletions
diff --git a/90-94/92.hs b/90-94/92.hs
new file mode 100644
index 0000000..0f6f7a0
--- /dev/null
+++ b/90-94/92.hs
@@ -0,0 +1,24 @@
+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]