Combinatoric problem in Haskell

Question

I am new to functional programming. Just now I solved my first "real world" task using Haskell and now I'm wondering whether I got it "right" and what can be improved.

The problem arises from tensor calculations (I am a theoretical physicist), where I have the tensor product of \$\frac{n}{2}\$ identical symmetric tensors and I am looking for all indistinguishable distributions of \$n\$ indices, i.e. terms like \$\eta^{a c} \eta^{b e} \eta^{d f}\$.

The combinatorics is easy, there are \$(n-1)\times(n-3)\times\dots\times1\$ different terms and prescriptions to enlist them all are easy to conceive.

I implemented the following algorithm:

input: string of even length ("indices")

output: rose tree representing all permutations as described above, a node is a pair (my implementation: two-element list) of indices, each branch from root node to leaf is one permutation

recursive construction: From string of length \$n\$ (example: "abcdef"), construct \$n-1\$ nodes and "remainders", where the first index of each node is the first index of the input string (example: [("ab", "cdef"), ("ac", "bdef"), ("ad", "bcef"), ("ae", "bcdf"), ("af", "bcde")]). Repeat with all "remainders".

Now this is my implementation in Haskell:

import Control.Applicative
import Data.Tree

--- given string of n indices a:is,
--- construct all (n-1) two-character
--- strings a:i:[] and the reduced
--- string of (n-2) remaining indices
--- undefined if n == 1
innerEtas :: String -> [(String, String)]
innerEtas (x:[]) = undefined
innerEtas (x:xs) = map (\a -> ([x, a], filter (/=a) xs)) xs
innerEtas [] = []

--- build up tree by recursive application
--- of innerEtas
buildEtas :: String -> Forest String 
buildEtas [] = []
buildEtas xs = let ys = innerEtas xs
               in map (\(node, list) -> Node node $ buildEtas list) ys

--- flatten Tree to list of strings
treeToStrings :: Tree String -> [String]
treeToStrings (Node n []) = [n]
treeToStrings (Node n ts) = liftA2 (++) [n] (forestToStrings ts)

forestToStrings :: Forest String -> [String]
forestToStrings ts = concat $ map treeToStrings ts

--- build ansatz tree from n indices
ansatzEtas :: Integer -> Forest String
ansatzEtas n
  | n < 0 = undefined
  | n `mod` 2 /= 0 = undefined
  | otherwise = buildEtas $ take (fromIntegral n) ['a'..'z']

main = do
        putStrLn $ drawForest $ ansatzEtas 8
        print $ forestToStrings $ ansatzEtas 8
        print $ (forestToStrings $ ansatzEtas 26) !! 10000

I am really impressed by Haskells lazy evaluation, which in the last line allows me to obtain certain combinations of ['a'..'z'] without first calculating them all! So I believe I got this aspect right.

So my question is, did I make any style errors? Did I miss idioms of functional programming and Haskell which would make the code better in some ways? Are there issues with space or time?

Answer 1

The algorithm is purely combinatorial: it doesn't depend on the actual values of the elements. That can be made explicit by using more general types. Compare these signatures:

ansatzEtas :: Integer -> Forest String
ansatzEtas :: Integer -> [a] -> Forest (a, a)
-- takes the alphabet as a parameter (length must be >= the first argument n)

• The output is guaranteed to be a forest of pairs.

• Now that a is a type parameter, we are guaranteed that the pairs contain only elements from the original list.

---

We can easily get back a forest of strings using the fact that trees are functors:

pairToList :: Forest (a, a) -> Forest [a]
pairToList = (fmap . fmap) (\(x, y) -> [x, y])

---

More precise types make mistakes much less likely, and can even help us know what to write. For example, imagine we're still trying to write innerEtas, and we want to know what to put in place of the underscore:

innerEtas :: String -> [(String, String)]
innerEtas (x:xs) = map (\a -> (_, filter (/=a) xs)) xs

We can try to compile this code as it is, with the underscore, and GHC will report that this hole is of expected type String.

• Found hole: _ :: String

It also helpfully tells us that xs :: [Char] is in scope. On a tired day, one might then mistakenly interpret that as advice to put xs in:

innerEtas (x:xs) = map (\a -> (xs, filter (/=a) xs)) xs
                               -- Bug!

Looking back, before we even start writing innerEtas, we know that it's supposed to give us pairs, and we can say it in the type.

innerEtas :: [a] -> [((a, a), [a])]
innerEtas (x:xs) = map (\a -> (_, filter (/=a) xs)) xs

Here we would be told the following expected type:

• Found hole: _ :: (a, a)

Which is hopefully much more helpful to determine what goes where.

---

This generalization may introduce a bit of a challenge, because innerEtas uses (/=), which requires an Eq constraint. Two options:

• Just add the Eq a constraint everywhere, this is an easy solution, we still get most of the benefits of the generalization anyway.
• Rewrite innerEtas to not use (/=), instead write a custom recursive function or use other combinators than filter. This can help avoid mistakes when making heavy use of Eq, but arguably this is not the case here.

Still, in this case there's a cute one-liner to extract an element from a list and keep the rest, nondeterministically, without using Eq:

pick :: [a] -> [(a, [a])]
pick xs = [(y, ys ++ ys') | (ys, y : ys') <- liftA2 zip inits tails xs]
-- inits, tails from Data.List

-- Example
pick [1,2,3] = [(1,[2,3]),(2,[1,3]),(3,[1,2])]

---

Some refactoring is possible between innerEtas and buildEtas. There is redundancy because both are checking whether the list is empty. In fact, x is quite a bit more special than the other elements, and we can take it apart in buildEtas already. Then innerEtas could take x separately from the tail as an argument, but it becomes a one-liner that we might as well inline:

buildEtas :: [a] -> Forest (a, a)
buildEtas [] = []
buildEtas (x : []) = undefined   -- I think this is unnecessary, but kept it to remain close to the original code
buildEtas (x : xs) = let ys = map (\(y, zs) -> ((x, y), zs) (pick xs)
                     in map (\(node, list) -> Node node $ buildEtas list) ys