summaryrefslogtreecommitdiff
path: root/90-94/94.hs
diff options
context:
space:
mode:
Diffstat (limited to '90-94/94.hs')
-rw-r--r--90-94/94.hs33
1 files changed, 33 insertions, 0 deletions
diff --git a/90-94/94.hs b/90-94/94.hs
new file mode 100644
index 0000000..29c310b
--- /dev/null
+++ b/90-94/94.hs
@@ -0,0 +1,33 @@
+import Data.List (permutations, sort)
+
+iso vs e1 e2 =
+ let perm = permutations vs
+ t = takeWhile id $ scanl (\acc perm ->
+ let tab = zip vs perm
+ trans x = snd . head $ filter ((== x) . fst) tab in
+ acc && (sort (map (\(u, v) -> (trans u, trans v)) e1') /= e2''))
+ True perm in length t /= length perm + 1
+ where adjust e = e >>= (\(u, v) -> [(u, v), (v, u)])
+ e1' = adjust e1
+ e2'' = sort $ adjust e2
+
+select _ 0 = [[]]
+select [] _ = []
+select (x:xs) k = (map (x:) $ select xs (k - 1)) ++ select xs k
+
+regular :: Int -> Int -> [[(Int, Int)]]
+regular n k = elim $ reg [] 0 []
+ where elim [] = []
+ elim (p:ps)
+ | length ps + 1 == length (takeWhile id $
+ scanl (\f p' -> f && not (iso' p p'))
+ True ps) = p:elim ps
+ | otherwise = elim ps
+ where iso' = iso [0..n-1]
+ reg e i plan
+ | i == n = [plan]
+ | otherwise = do vs <- select rv (k - k')
+ let plan' = [(i, v) | v <- vs] ++ plan
+ reg (vs ++ e) (i + 1) plan'
+ where (_, k'):r = map (\v -> (v, length $ filter (== v) e)) [i..n-1]
+ rv = map fst $ filter ((<k) . snd) r