1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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]
|