# Programming_玉手箱_組合せ

Programming:玉手箱:組合せ

Programming_玉手箱

## 組合せ論的な生成関数

「順列の生成」に触発されて、いろいろつくってみた。2003/11/24 08:09:32 JST–nobsun

### リストの二分割の生成

たとえば、[1,2,3]というリストの全二分割は、 [([],[1,2,3]),(,[2,3]),([1,2],),([1,2,3],[])]

divid :: [a] -> [([a],[a])]

divid [email protected](x:xs) = ([],xxs) : [(x:ys,zs) | (ys,zs) <- divid xs]
divid []         = [([],[])]

あれっ。これでいいじゃん。

divid xs = zip (inits xs) (tails xs)

えっ。なに？逆？

inits = map fst . divid
tails = map snd . divid

### 順列の生成

n 種類のものから、r 個取り出して並べる。辞書順に生成される。

perm :: [a] -> Int -> [[a]]
perm [] _ = []
perm xs 0 = [[]]
perm xs 1 = map (:[]) xs
perm xs n = concatMap (pm n) $divid xs where pm _ (_,[]) = [] pm n (hs,(t:ts)) = map (t:)$ perm (hs ++ ts) (n-1)

length (perm ns r) == nＰr (n = length ns)

perm [] = [[]]
perm xs = concat [map (x:) (perm xs') | (x, xs') <- f xs]
where f [] = []
f (x:xs) = (x, xs):[(x', x:xs') | (x', xs') <- f xs]

Eq a なときの順列

perm' :: Eq a => [a] -> [[a]]
perm' [] = [[]]
perm' xs = concat [map (x:) (perm' xs') | (x, xs') <- nubBy g $f xs] where f [] = [] f (x:xs) = (x, xs):[(x', x:xs') | (x', xs') <- f xs] g (x, _) (y, _) = x == y ### 重複順列の生成 n 種類のものから、重複を許して、r 個取り出してならべる。 rperm :: [a] -> Int -> [[a]] rperm [] _ = [] rperm xs 0 = [[]] rperm xs 1 = [[x] | x <- xs] rperm xs n = [ x:ys | x <- xs, ys <- rperm xs (n-1) ] length (rperm ns r) == nΠr (n = length ns) == n^r • 2ch で覚えた方法 rperm = ((foldl ((=<<) . (. (return .) . (:)) . (>>=) ) [[]]) .) . (flip replicate)  • 邪悪な香りがして、ぞくぞくきますねぇ。^^； • rperm [] 0 の結果が上と違うけど、どちらが正しいの? • 0^0 は 0 か 1 かと同じ話ですよね。不定ということでどうでしょうか。 • 空集合から空集合への写像の数は１つらしいので rperm [] _ の行はない方がいいでしょうか。それと rperm xs 1 の行も必要ないですよね。他のほとんどの項目の *** xs 1 の行についても同様です。 • HHLに同じ事をする関数があった import Control.Monad rperm = flip replicateM ### 組合せの生成 n 種類のものから、r 個取り出して組み合せる。 comb :: [a] -> Int -> [[a]] comb [] _ = [] comb xs 0 = [[]] comb xs 1 = map (:[]) xs comb (x:xs) n = map (x:) (comb xs (n-1)) ++ comb xs n comb xs 1 のパターンを外せるが他のパターンの順序を変えないといけない。 comb _ 0 = [[]] comb [] _ = [] comb (x:xs) n = map (x:) (comb xs (n-1)) ++ comb xs n length (comb ns r) == nＣr (n = length ns) 選んだ残りのものも利用したいとき choice :: Int -> [a] -> [([a], [a])] choice 0 xs = [([], xs)] choice n [] = [] choice n (x:xs) = [(x:ys, zs) | (ys, zs) <- choice (n-1) xs] ++ [(ys, x:zs) | (ys, zs) <- choice n xs] ### 重複組合せの生成 n 種類のものから、重複を許して、r 個取り出して組み合わせる。 rcomb :: [a] -> Int -> [[a]] rcomb [] _ = [] rcomb xs 0 = [[]] rcomb xs 1 = [[x] | x <- xs] rcomb [email protected](x:xs) n = map (x:) (rcomb xxs (n-1)) ++ rcomb xs n length (rcomb ns r) == nＨr (n = length ns) rcomb' [] _ = [] rcomb' xs 0 = [[]] rcomb' xs n = xs >>= (flip map (rcomb xs (n-1))) . (:) -- rcomb' xs n = xs >>= (rcomb xs (n-1) >>=) . ((flip (:) [] .) . (:)) ## 順列の生成 かってに書いてもいいのかな? 問題があったら消して下さい >> nobsun • Welcome! Wikiなんですから、どんどん書いちゃってくださいな。–nobsun 2chの関数型プログラミング言語Haskell で話題になっているものを転記。 819 permutation' [] = [[]] permutation' xs = foldr (++) [] (map f (rotate_list xs)) where f (x:xs) = map (x:) (permutation' xs) rotate_list xs = take (length xs) (iterate rotate_left xs) where rotate_left [] = [] rotate_left (x:xs) = xs ++ [x] permutation [] = [[]] permutation xs = foldr (++) [] (map f (selected_list xs)) where f (x:xs) = map (x:) (permutation xs) selected_list xs = take (length xs) (zipWith select (repeat xs) [0..]) where select [] _ = [] select xs n = z : ys ++ zs where (ys,(z:zs)) = splitAt n xs 上の permutation' は速いですが順列が昇順に出力されません．下の permutation は昇順に出力されますが， splitAt のあたりが遅いのか，速度 で劣ります． 821 permutation [] = [[]] permutation xs = concat [map (x:)$ permutation (delete x xs) | x <- xs]

823

deleteの2倍以上速いと思う。

permutations :: [a] -> [[a]]
permutations (x:xs) = concat $map (insap [] x)$ permutations xs
where
insap :: [a] -> a -> [a] -> [[a]]
insap xs y (z:zs) = (xs ++ [y] ++ (z:zs)):(insap (xs ++ [z]) y zs)
insap xs y [] = [xs ++ [y]]
permutations [] = [[]]

826

 insap xs y [email protected](z:zs) = (xs++y:zzs):insap (xs++[z]) y zs

とやると僅かだけど、早くなるかも。

828

permutation xs = p xs []
where
p [] [] = [[]]
p [] ys = []
p (x:xs) ys = (map (x:) \$ p (xs ++ reverse ys) []) ++ p xs (x:ys)

deleteより少し速い。xs ++ reverse ysを効率的にやればもう少しいけるかもね。

830

Haskellよく知らないけど前にLispでやったから多分

permutation' [] = [[]]
permutation' xs = foldr (++) [] (map rotate_list (f xs))
where
f (x:xs) = map (x:) (permutation' xs)
rotate_list xs = take (length xs) (iterate rotate_left xs)
where
rotate_left [] = []
rotate_left (x:xs) = xs ++ [x]

830

末尾再帰はループになるのかな？

selected-list xs = p xs [] []
where
p [] ys r = reverse r
p (x:xs) ys r = p xs (x:ys) ((x:((reverse ys) ++ xs)):r)