この記事は ひとりアドベントカレンダーRosettaCodeで楽しむプログラミング Advent Calendar 2025の24日めの記事です。
定義
1からnまでの数の順列で、項が交互に増加、減少、しているもの。
タスク
- 与えられたnに対して、1～nのジグザグ数列を全て列挙する。$1 \leq n \leq 5$ について結果を示せ。
- 与えられたmに対して、1～mのジグザグ数列の総数を求める。$1 \leq m \leq 30$ について結果を示せ。
考える
数列の生成
最初に、先頭の要素を決める。
その要素より小さいものと大きいものに分けられるので、以後、これを持って再帰する。
「直前に選んだ要素より小さいもの、大きいもの」の2つのリスト。
上昇するとき、大きいものの方から任意に一つ選ぶ。それより小さいものが、小さいものの方に移される。
下降するときはその逆。
両方とも空になったときは成功。次に選ぶ側が空なのに、反対側は残っている場合は失敗。
generateZZ :: Int -> [[Int]]
generateZZ n = [ k : res | k <- [1 .. n], res <- up [1 .. pred k] [succ k .. n]]
where
up [] [] = [[]]
up as bs = [ x : res | x <- bs, res <- dn (as ++ takeWhile (x >) bs) (dropWhile (x >=) bs) ]
dn [] [] = [[]]
dn as bs = [ x : res | x <- as, res <- up (takeWhile (x >) as) (dropWhile (x >=) as ++ bs) ]
ghci> generateZZ 5
[[1,3,2,5,4],[1,4,2,5,3],[1,4,3,5,2],[1,5,2,4,3],[1,5,3,4,2],[2,3,1,5,4],[2,4,1,5,3],[2,4,3,5,1],[2,5,1,4,3],[2,5,3,4,1],[3,4,1,5,2],[3,4,2,5,1],[3,5,1,4,2],[3,5,2,4,1],[4,5,1,3,2],[4,5,2,3,1]]
なぜか皆さんの出力には、先頭に [1,2,3,4,5] が入っているものが多いんですが、何なんでしょう。
数える
生成したものを数えるのだと、計算量的にすぐ破綻する。
生成のコードの動作を考えると、より小さい、より大きい、にいくつ残っているのか、だけが結果に影響するとわかる。
generateZZ のリスト引数をその長さだけに抽象化してみる。
countZZnaive n = sum [up a b | a <- [0 .. n], let b = pred n - a]
where
up 0 0 = 1
up a b = sum [dn c d | k <- [0 .. pred b], let c = a + k, let d = pred b - k]
dn 0 0 = 1
dn a b = sum [up c d | k <- [0 .. pred a], let d = b + k, let c = pred a - k]
ghci> map countZZnaive [1 .. 11]
[1,1,2,5,16,61,272,1385,7936,50521,353792]
(3.12 secs, 1,804,457,928 bytes)
これ以上は無理なので、メモ化DPをする。
その前に、upとdnがあまりにも対称なので、統合したい。
大小関係がなくなったので、「探す側」と「そうでない側」の区別さえあればいい。
countZZnaive2 n = sum [go a b | a <- [0 .. n], let b = pred n - a]
where
go 0 0 = 1
go a b = sum [go d c | k <- [0 .. pred b], let c = a + k, let d = pred b - k]
ghci> map countZZnaive2 [1 .. 11]
[1,1,2,5,16,61,272,1385,7936,50521,353792]
(3.05 secs, 1,757,490,088 bytes)
では、無限に伸びるリストに、goの答えをメモする。
countZZ :: Int -> Integer
countZZ n = sum [go !! a !! b | a <- [0 .. n], let b = pred n - a, b >= 0]
where
go = [[gof a b | b <- [0 ..]] | a <- [0 ..]]
gof 0 0 = 1
gof a b = sum [go !! d !! c | k <- [0 .. pred b], let c = a + k, let d = pred b - k, c >= 0, d >= 0]
範囲外へアクセスしないように配慮が必要。
ghci> map countZZ [1 .. 30]
[1,1,2,5,16,61,272,1385,7936,50521,353792,2702765,22368256,199360981,1903757312,19391512145,209865342976,2404879675441,29088885112832,370371188237525,4951498053124096,69348874393137901,1015423886506852352,15514534163557086905,246921480190207983616,4087072509293123892361,70251601603943959887872,1252259641403629865468285,23119184187809597841473536,441543893249023104553682821]
(0.07 secs, 25,511,464 bytes)
お化粧してフィードバックかけましょうかね。
import Text.Printf
import Control.Monad
main :: IO ()
main = do
forM_ [1 .. 5] (\n -> do
printf "Zigzag Permutations for N = %d:\n" n
print $ generateZZ n
)
putStrLn "\n N Zigzags"
putStrLn $ replicate 30 '-'
forM_ [1 .. 30] (\m -> printf "%2d %d\n" m (countZZ m))
ghci> main
Zigzag Permutations for N = 1:
[[1]]
Zigzag Permutations for N = 2:
[[1,2]]
Zigzag Permutations for N = 3:
[[1,3,2],[2,3,1]]
Zigzag Permutations for N = 4:
[[1,3,2,4],[1,4,2,3],[2,3,1,4],[2,4,1,3],[3,4,1,2]]
Zigzag Permutations for N = 5:
[[1,3,2,5,4],[1,4,2,5,3],[1,4,3,5,2],[1,5,2,4,3],[1,5,3,4,2],[2,3,1,5,4],[2,4,1,5,3],[2,4,3,5,1],[2,5,1,4,3],[2,5,3,4,1],[3,4,1,5,2],[3,4,2,5,1],[3,5,1,4,2],[3,5,2,4,1],[4,5,1,3,2],[4,5,2,3,1]]
N Zigzags
------------------------------
1 1
2 1
3 2
4 5
5 16
6 61
7 272
8 1385
9 7936
10 50521
11 353792
12 2702765
13 22368256
14 199360981
15 1903757312
16 19391512145
17 209865342976
18 2404879675441
19 29088885112832
20 370371188237525
21 4951498053124096
22 69348874393137901
23 1015423886506852352
24 15514534163557086905
25 246921480190207983616
26 4087072509293123892361
27 70251601603943959887872
28 1252259641403629865468285
29 23119184187809597841473536
30 441543893249023104553682821
(0.11 secs, 26,988,152 bytes)
小ネタでした。