ブドウの房問題

gistfile1.hs

module Main where 
import Control.Monad 
import Data.List 
 
step :: Int 
step = 5 
 
clusterCount :: Int -> Int 
clusterCount n = n * (n + 1) `div` 2 
 
--全ての組み合わせを列挙
allPattern :: Int -> [[Int]] 
allPattern n = let 
    f m n = replicateM n [1..m] 
  in do 
    x <- f (clusterCount n) n 
    guard $ length (nub x) == n 
    return x 
 
--2段目以降の房を計算
sloveSteps :: [Int] -> [[Int]] 
sloveSteps xs = take (length xs) $ iterate nextStep xs 
  where 
    nextStep :: [Int] -> [Int] 
    nextStep ys = zipWith (\a b -> abs  $ a - b) ys $ tail ys  
 
--房の印字 
printAns :: [[Int]] -> IO () 
printAns xs = do 
  forM_ xs $ \ys -> do 
    replicateM_  (length xs - length ys) $ putStr "  " 
    mapM_ (putStr . fill) ys 
    putStrLn "" 
  where 
    fill :: Show a => a -> String 
    fill val = take 4 $ show val ++ "  " 
   
----- 
 
main :: IO () 
main = mapM_ (\ans -> printAns ans >> putStrLn "") $ do 
  xs <- map sloveSteps $ allPattern step 
  guard $ length (nub $ concat xs) == clusterCount step 
  return xs