カード

http://d.hatena.ne.jp/nuc/20050831/p4

gen2 :: [Int] -> [a] -> [ [ [a] ] ]
gen2 [ ] _ =  
gen2 (i:is) xs = [(a:r)| (a,b) <- takeAll i xs, r <- gen2 is b]

takeAll :: Int -> [a] -> [([a],[a])]
takeAll 0 xs = [([ ],xs)]
takeAll _ [ ] = [ ]
takeAll n (x:xs) =    [*1| (a,b) <- takeAll n xs]

 *Main> filter (\[a,b,c] -> product a == product b && sum b == sum c)$ gen2 [4,4,4] [1..12]
(6.56 secs, 145554740 bytes)
 Main> filter (\[a,b,c] -> product a == product b && sum b == sum c)$ gen2 [5,5,5] [1..15]
(685.38 secs, 888176944 bytes)

アルゴリズム変えて、パーサっぽく。もうちょいと汎用性を持たせてみようかなと思ったが、後ろがリストの処理ゆえか遅くなった。枝きりは簡単だけれども正直枝きりを十分すれば答えそのものだしなあ。
tuple 実装のほうがよいか。tuple のアルゴリズムを list にしようとすると、全部のn番目をいじるが他は触らない、がややこしくしている感じがする。これ以上、高階なものはぱっと思いつかないから。

*1:x:a),b)| (a,b) <- takeAll (n-1) xs] ++ [(a,(x:b