コード貼り付けのテスト

(2009/4/26シンタックスハイライト追加)
円形に並べられたn個の数字で、
隣り合う数字の和が1からn(n-1)+1になるようなものがあれば見つけてくるHaskellプログラム。
GHCでn=9まで終了した。
反転対称を除いていないのがすぐに改善できそうな点。
rotateの名前は不適切な気がする。

module Main where
import List

main = print $ solve 5

rotate :: [Int] -> [[Int]]
rotate xs = map (tail . rotate' xs) [1..length xs]

rotate' :: [Int] -> Int -> [Int]
rotate' xs n = xs2 ++ xs1 where
  (xs1, xs2) = splitAt n xs

csegs :: [Int] -> [[Int]]
csegs = concatMap inits' . rotate 

--initsはemptyが先頭につくので削除
inits' = tail . inits

nodup :: Eq a => [a] -> Bool
nodup [] = True
nodup (x:xs) = not (x `elem` xs) && nodup xs

check :: [Int] -> Bool
check = nodup . map sum . csegs

numseg :: Int -> Int
numseg n = n * (n-1)

--n の l分割
divide :: Int -> Int -> [[Int]]
divide n l = divide' n l 0
  
divide' :: Int -> Int -> Int -> [[Int]]
divide' n 1 m = [[n]]
divide' n l m = [m':xs | m' <- [m+1..n], m' < n - m', xs <- divide' (n-m') (l-1) m']

divs :: Int -> [[Int]]
divs n = divide (numseg n + 1) n

inserts :: a -> [a] -> [[a]]
inserts a [] = [[a]]
inserts a ys@(x:xs) = (a:ys) : map (x:) (inserts a xs)

perms :: [a] -> [[a]]
perms [] = [[]]
perms (x:xs) = concatMap (inserts x) (perms xs)

--2番目以降の順列をとる
perms2 :: [a] -> [[a]]
perms2 (x:xs) = map (x:) (perms xs)

solve :: Int -> [Int]
solve = head . filter check . concatMap perms2 . divs