直積

全ての組み合わせです。私が書いたのはこれ。

list = [[1, 2, 3, 4], [7, 8, 9]]
list2 = [[0, 1], [2, 3], [4, 5]]

main = do print $ crossProduct list
          print $ crossProduct list2

crossProduct :: [[a]] -> [[a]]
crossProduct [] = []
crossProduct (x:xs) =
  let ys = crossProduct xs
  in if ys == []
    then map (\n->[n]) x
    else product2 x ys

product2 :: [a] -> [[a]] -> [[a]]
product2 xs ys = concat $ map (product3 xs) ys

product3 :: [a] -> [a] -> [[a]]
product3 xs ys = map (\n->n:ys) xs

投稿されているプログラムを見ると、リスト内包表記を使っているではありませんか。そうですよね。書き直してみました。

まずはproduct3をリスト内包表記で置き換えます。

crossProduct :: [[a]] -> [[a]]
crossProduct [] = []
crossProduct (x:xs) =
  let ys = crossProduct xs
  in if ys == []
    then map (\n->[n]) x
    else product2 x ys

product2 xs ys = [x:y | x<-xs, y<-ys]

次はproduct2を消去。

crossProduct :: [[a]] -> [[a]]
crossProduct [] = []
crossProduct (x:xs) =
  let ys = crossProduct xs
  in if ys == []
    then map (\n->[n]) x
    else [a:b | a<-x, b<-ys]

さらにysを消去。

crossProduct :: [[a]] -> [[a]]
crossProduct [] = []
crossProduct (x:xs) =
  if xs == []
    then map (\n->[n]) x
    else [a:b | a<-x, b<-crossProduct xs]

ifをやめます。

crossProduct :: [[a]] -> [[a]]
crossProduct [] = []
crossProduct (x:[]) = map (\n->[n]) x
crossProduct (x:xs) = [a:b | a<-x, b<-crossProduct xs]

リストの末尾での処理を変更。

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

投稿されていたものと同じものができました。

ちなみにPerlですとSet::CrossProductを使うと簡単です。

use strict;
use Set::CrossProduct;

my $cp1 = Set::CrossProduct->new([[1,2,3,4], [qw/a b c/]]);
print_data($cp1);
print "\n";

my $cp2 = Set::CrossProduct->new([[0,1], [qw/a b/], [qw/Foo Bar/]]);
print_data($cp2);
print "\n";

sub print_data {
	my $it = shift;
	while (my $tuple = $it->get) {
		print "[", join(",", @$tuple), "]";
	}
}