challenge 魔方分割数

1 .. N^2までの数をN個の数字の和が等しいN個のグループに分けたいと思います。

たとえば、N=3のときは、
(1) { 1, 5, 9 }, { 2, 6, 7 }, { 3, 4, 8 } 
(2) { 1, 6, 8 }, { 2, 4, 9 }, { 3, 5, 7 }
の2通りの方法があります。

ここで指定されたNに対して、何通りのグループ分けの方法があるかを数えるプログラムを作ってください。
(何通りかという値だけが出力されればよいのですが、予め計算してある結果を返すのはダメですよ。)
また、N=5を指定したときの実行時間もあわせて教えてください。

なお、数え上げるときの注意として、

・{ 1, 5, 9 } と { 1, 9, 5 }は同じもの

・{ 1, 5, 9 }, { 2, 6, 7 }, { 3, 4, 8 }と
 { 1, 5, 9 }, { 3, 4, 8 }, { 2, 6, 7 }は同じもの
とすることに注意してください。

Posted feedbacks - Haskell

条件を満す組み合せを生成するが、できるだけ余分なものを生成しないように
したつもり.

1 から n までの数から,k 個選ぶ組み合せのリストを生成する際に
採用されなかった残りの n-k 個の要素のリストをペアにするようにした
関数 comb を定義する.残りの部分には当然,既に採用した数ははいっていない.

comb' は和の制約を加え,さらに残りの組み合せ(リスト)が採用されたものより
辞書順で大きいものだけを採用するようにしてある.これによって,組み合せ
(リスト)のリスト同士の同一性をチェックしなくてすむ.

実行結果は以下のとおり.

% time ./magic 4
392
./magic 4  0.00s user 0.00s system 93% cpu 0.008 total
% time ./magic 5
3245664
./magic 5  47.19s user 0.40s system 99% cpu 47.590 total

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
module Main (main) where

import Data.List
import System.Environment

comb :: Int -> [a] -> [([a],[a])]
comb 0 xs = [([],xs)]
comb _ [] = []
comb k (x:xs) = [ (x:ys,zs) | (ys,zs) <- comb (k-1) xs ]
              ++[ (ys,x:zs) | (ys,zs) <- comb k     xs ]

comb' :: Int -> Int -> [Int] -> [([Int],[Int])]
comb' s 0 xs | s == 0    = [([],xs)]
             | otherwise = []
comb' _ _ []             = []
comb' s k (x:xs) = [ (x:ys,zs) | (ys,zs) <- comb (k-1) xs, s == x+sum ys ]

foo s k (acc,xs) = case unzip $ comb' s k xs of
  (yss,zss) -> zip (map (:acc) yss) zss
            
magic n = map (reverse . fst) $ iterate (concatMap (foo s n)) [([],ns)] !! n
  where ns = [1..n^2]
        s  = sum ns `div` n

main = print . length . magic . read . head =<< getArgs

comb の方にも和の制約を入れたら手元のマシンで
magic 5 のケースが4倍速になりました。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
comb :: Int -> Int -> [Int] -> [([Int],[Int])]
comb s _ xs | s < 0 = []
comb s 0 xs | s == 0    = [([],xs)]
            | otherwise = []
comb _ _ [] = []
comb s k (x:xs) = [ (x:ys,zs) | (ys,zs) <- comb (s-x) (k-1) xs ]
                ++[ (ys,x:zs) | (ys,zs) <- comb s     k     xs ]

comb' :: Int -> Int -> [Int] -> [([Int],[Int])]
comb' s 0 xs | s == 0    = [([],xs)]
             | otherwise = []
comb' _ _ []             = []
comb' s k (x:xs) = [ (x:ys,zs) | (ys,zs) <- comb (s-x) (k-1) xs ]

もう少し速くなりました。
ついでにグループ分けの数を求めるのに必要な部分だけに削りました。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
module Main (main) where

import Data.List
import System.Environment

comb s 0 xs | s == 0    = [xs]
            | otherwise = []
comb s k (x:xs)
  | k * x > s = []
  | otherwise = comb (s-x) (k-1) xs ++ map (x:) (comb s k xs)
comb _ _ _ = []

comb' s k (x:xs)
  | k * x > s = []
  | otherwise = comb (s-x) (k-1) xs
comb' _ _ _ = []

magic n = iterate (concatMap (comb' s n)) [ns] !! n
  where ns = [1..n^2]
        s  = sum ns `div` n

main = print . length . magic . read . head =<< getArgs

Index

Feed

Other

Link

Pathtraq

loading...