全ての組み合わせ in Haskell DouKaku?

2個以上のリストlist1, list2, list3...が与えられたときに、その複数個のリストの中の要素を一つずつとりだして組にする方法の全通りのリストを返すコードを書いてください。

Pythonで表現すると下のようになります。

>>> c = CrossProduct([1,2,3,4], "abc")
>>> list(c.all())
[[1, 'a'], [1, 'b'], [1, 'c'], [2, 'a'],
 [2, 'b'], [2, 'c'], [3, 'a'], [3, 'b'],
 [3, 'c'], [4, 'a'], [4, 'b'], [4, 'c']]

>>> c = CrossProduct([0, 1], "ab", ["Foo", "Bar"])
>>> list(c.all())
[[0, 'a', 'Foo'], [0, 'a', 'Bar'], [0, 'b', 'Foo'], [0, 'b', 'Bar']
 [1, 'a', 'Foo'], [1, 'a', 'Bar'], [1, 'b', 'Foo'], [1, 'b', 'Bar']]

順番はこの通りでなくても構いません。返すものはリストと書きましたが、なんらかの「一度に全部をメモリ上に作成しないリスト状のモノ」がある言語ではそちらを使う方がおすすめです。数値や文字列を一つのリストに混在させるのがやっかいな言語では整数のリストに限定しても構いません。

このお題はZIGOROuさんとのやりとりにヒントを得て作りました。 (しまった、先にブログで公開されてしまった→Yet Another Hackadelic - 直積の導出と考えうる全ての値を網羅したハッシュの生成)

追記：サンプル出力が間違っていたのでoceanさんの解答を使って出力し直しました。

芸がない。そのくせ型という制約がある。

1	crossProduct = sequence :: [[a]] -> [[a]]

引数の数(リストの数)を固定する

crossProduct2 = concatMap . (. repeat) . zip
crossProduct3 = (. crossProduct2) . (.) . crossProduct2
crossProduct4 = (. crossProduct3) . (.) . (.) . crossProduct2
crossProduct5 = (. crossProduct4) . (.) . (.) . (.) . crossProduct2
crossProduct6 = (. crossProduct5) . (.) . (.) . (.) . (.) . crossProduct2
crossProduct7 = (. crossProduct6) . (.) . (.) . (.) . (.) . (.) . crossProduct2

-- Test data

data RGB = Red | Green | Blue  deriving (Bounded,Enum, Show)
data ENWS = East | North | West | South deriving (Bounded,Enum, Show)

allItems :: (Bounded a, Enum a) => [a]
allItems = [minBound..maxBound]

test = crossProduct4 (allItems::[()]) (allItems::[Bool]) (allItems::[RGB]) (allItems::[ENWS])

{-
*Main> test
[((),(False,(Red,East)))
,((),(True,(Red,East)))
,((),(False,(Green,East)))
,((),(True,(Green,East)))
,((),(False,(Blue,East)))
,((),(True,(Blue,East)))
,((),(False,(Red,North)))
,((),(True,(Red,North)))
,((),(False,(Green,North)))
,((),(True,(Green,North)))
,((),(False,(Blue,North)))
,((),(True,(Blue,North)))
,((),(False,(Red,West)))
,((),(True,(Red,West)))
,((),(False,(Green,West)))
,((),(True,(Green,West)))
,((),(False,(Blue,West)))
,((),(True,(Blue,West)))
,((),(False,(Red,South)))
,((),(True,(Red,South)))
,((),(False,(Green,South)))
,((),(True,(Green,South)))
,((),(False,(Blue,South)))
,((),(True,(Blue,South)))]
-}

リストの数固定して、Dynamicを使うというのを書いてみました。

import Data.Dynamic

crossProduct2 :: (Typeable a, Typeable b)
              => [a] -> [b] -> [(a,b)]
crossProduct2 ps qs 
 = map tuple 
 $ sequence 
 $ [ map toDyn ps
   , map toDyn qs
   ]
 where tuple [p,q]
        = ( fromDyn p undefined
          , fromDyn q undefined
          )

crossProduct3 :: (Typeable a, Typeable b, Typeable c)
              => [a] -> [b] -> [c] -> [(a,b,c)]
crossProduct3 ps qs rs
 = map tuple 
 $ sequence 
 $ [ map toDyn ps
   , map toDyn qs
   , map toDyn rs
   ]
 where tuple [p,q,r]
        = ( fromDyn p undefined
          , fromDyn q undefined
          , fromDyn r undefined
          )

crossProduct4 :: (Typeable a, Typeable b, Typeable c, Typeable d)
              => [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
crossProduct4 ps qs rs ss
 = map tuple 
 $ sequence 
 $ [ map toDyn ps
   , map toDyn qs
   , map toDyn rs
   , map toDyn ss
   ]
 where tuple [p,q,r,s]
        = ( fromDyn p undefined
          , fromDyn q undefined
          , fromDyn r undefined
          , fromDyn s undefined
          )

crossProduct5 :: (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e)
              => [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
crossProduct5 ps qs rs ss ts
 = map tuple 
 $ sequence 
 $ [ map toDyn ps
   , map toDyn qs
   , map toDyn rs
   , map toDyn ss
   , map toDyn ts
   ]
 where tuple [p,q,r,s,t]
        = ( fromDyn p undefined
          , fromDyn q undefined
          , fromDyn r undefined
          , fromDyn s undefined
          , fromDyn t undefined
          )

-- Test data

data RGB = Red | Green | Blue  deriving (Typeable,Bounded,Enum,Show)
data ENWS = East | North | West | South deriving (Typeable,Bounded,Enum,Show)

allItem :: (Bounded a, Enum a) => [a]
allItem = [minBound..maxBound]

test = crossProduct4 (allItem::[()]) (allItem::[Bool]) (allItem::[RGB]) (allItem::[ENWS])

{-
*Main> putStr $ unlines $ map show $ test
((),False,Red,East)
((),False,Red,North)
((),False,Red,West)
((),False,Red,South)
((),False,Green,East)
((),False,Green,North)
((),False,Green,West)
((),False,Green,South)
((),False,Blue,East)
((),False,Blue,North)
((),False,Blue,West)
((),False,Blue,South)
((),True,Red,East)
((),True,Red,North)
((),True,Red,West)
((),True,Red,South)
((),True,Green,East)
((),True,Green,North)
((),True,Green,West)
((),True,Green,South)
((),True,Blue,East)
((),True,Blue,North)
((),True,Blue,West)
((),True,Blue,South)
-}

二番煎じ。

1
2
3

crossProduct :: [[a]]->[[a]]
crossProduct [] = [[]]
crossProduct (x:xs) = [y:ys |y<-x, ys<-crossProduct xs]

Template Haskellを使用しました。
異なる型にも対応できるようにタプルリストを返す関数にしますが、引数の個数を与えてコンパイル時に目的コードを生成するようにします。
また、引数が2より小さければ、コンパイル時にエラーを検出し、reportにより報告します。

> $(crossProduct 1) [1, 2, 3, 4]

<interactive>:1:2: argument of crossProduct must be greater than 1

> $(crossProduct 2) [1, 2] ["foo", "bar", "baz"]
[(1,"foo"),(1,"bar"),(1,"baz"),(2,"foo"),(2,"bar"),(2,"baz")]

> $(crossProduct 3) [1, 2] ["foo", "bar", "baz"] [True, False]
[(1,"foo",True),(1,"foo",False),(1,"bar",True),(1,"bar",False),
(1,"baz",True),(1,"baz",False),(2,"foo",True),(2,"foo",False),
(2,"bar",True),(2,"bar",False),(2,"baz",True),(2,"baz",False)]

{-# OPTIONS_GHC -fth #-}
import Language.Haskell.TH
import Control.Applicative
import Control.Monad

varList :: Int -> String -> [Name]
varList n s = [mkName (s ++ show i) | i <- [1..n]]

crossProduct :: Int -> Q Exp
crossProduct n = do
    when (n < 2) (report True "argument of crossProduct must be greater than 1")
        -- 一時変数を2組使用
    let xs = varList n "x"
        ps = varList n "p"
        -- \p1 p2 ... -> [(x1, x2, ..) | x1 <- p1, x2 <- p2, ...] というコードを生成
     in return $ LamE (VarP <$> ps) 
                      (CompE $ (zipWith BindS (VarP <$> xs) (VarE <$> ps)) 
                  ++ [NoBindS $ TupE (VarE <$> xs)])

また、Applicativeを使うとこう書けます。問題の趣旨にあっているかどうか微妙ではありますが。

>:m +Control.Applicative
>(,) <$> [1, 2] <*> ["foo", "bar", "baz"]
[(1,"foo"),(1,"bar"),(1,"baz"),(2,"foo"),(2,"bar"),(2,"baz")]

>(,,) <$> [1, 2] <*> ["foo", "bar", "baz"] <*> [True, False]
[(1,"foo",True),(1,"foo",False),(1,"bar",True),(1,"bar",False)
,(1,"baz",True),(1,"baz",False),(2,"foo",True),(2,"foo",False)
,(2,"bar",True),(2,"bar",False),(2,"baz",True),(2,"baz",False)]

持ち上げました。

import Control.Monad
p x y = (x,y)
directProduct :: [a] -> [b] -> [(a,b)]
directProduct = liftM2 p

{-
実行例
*Main> directProduct [1..4] ["hello","world"]                                                                   
[(1,"hello"),(1,"world"),(2,"hello"),(2,"world"),(3,"hello"),(3,"world"),(4,"hello"),(4,"world")]
-}

DouKaku?

全ての組み合わせ

Posted feedbacks - Haskell

Index

Feed

Other

Link

Pathtraq