Functional, tail-recursive way to generate all possible combinations from a dictionary and a dimension

Viewed 479

I'd like to find out concise, functional and tail-recursive (if possible) way of implementing the below specified function:

(define (make-domain digits dimension)
    ;; Implementation)
;; Usage
(make-domain '(0 1) 0) => (())
(make-domain '(0 1) 1) => ((0) (1))
(make-domain '(0 1) 2) => ((0 0) (0 1) (1 0) (1 1))
(make-domain '(0 1) 3) => ((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))

I'd prefer Scheme implementation with as few helper or library functions as possible, but SML or Haskell will do as well. I'm trying to find a tail-recursive solution possibly using mutual or nested recursion, but with no luck at the moment.

Thank you very much!

4 Answers

That one, in Haskell, is at least “functional” and concise (I think):

makeDomain :: [α] -> Int -> [[α]]
makeDomain xs 0  =  [[]]
makeDomain xs n  =  let  mdn1 = makeDomain xs (n-1)
                         fn x = map (x:) mdn1
                    in   concat (map fn xs)

Trying it:

 λ> 
 λ> makeDomain [0,1] 2
[[0,0],[0,1],[1,0],[1,1]]
 λ> 
 λ> makeDomain [0,1] 3
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
 λ> 

As mentioned in the comments, going tail-recursive might be a not so good idea, in Haskell at least.

Addendum re: memory efficiency:

You did not list performance concerns in your requirements (was it because you think tail-recursive functions tend to perform better ?).

The above version of makeDomain, as hinted in the comments by amalloy suffers from exponential memory consumption, at least for some compiler versions / optimization levels. This is because the compiler can see makeDomain xs (n-1) as a loop-invariant value to be kept around.

So this is one of these situations where you have to pick a trade-off between elegance and efficiency. The problem has been discussed recently in this related SO question in the context of the very similar replicateM library function; drawing on the answer by K. A. Buhr, one can come up with a version of makeDomain that runs in constant memory, leveraging the Haskell list comprehension construct.

makeDomain1 :: [α] -> Int -> [[α]]
makeDomain1 xs n =
    map reverse (helper xs n)
        where
            helper xs 0 = [[]]
            helper xs n = [ x:ys  |  ys <- helper xs (n-1),  x <- xs ]

Testing: running with an OS-enforced memory hard limit of 1200 MB.

 λ> 
 λ> import Control.Monad (replicateM)
 λ> replicateM 3 [0,1]
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
 λ> 
 λ> makeDomain1 [0,1] 3
[[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
 λ> 
 λ> length $ replicateM 30 [0,1]
<interactive>: internal error: Unable to commit 1048576 bytes of memory
...
 λ> 
 λ> length $ makeDomain [0,1] 30
<interactive>: internal error: Unable to commit 1048576 bytes of memory
...
 λ> 
 λ> length $ makeDomain1 [0,1] 30
1073741824
 λ> 

Using GHC v8.6.5 with -O2 option, that last version never takes more than 150 MB memory, and runs at a speed of about 30 nsec per output list on a vanilla Intel x86-64 PC. This is perfectly reasonable.

Here is my constructive take on solving the above described problem.

The solution is functional, concise, recursive (but not tail-recursive) implementation in Scheme.

The idea is that the domain has an inductive (recursive) definition: each combination in the domain (first map) is a pair of a digit that is taken one in one from the initial digits dictionary and all combination for a smaller by one dimension (second map)

(define (make-domain digits dimension)
  "Builds all combinations of digits for a dimension"
  ;; There is an empty combination for a dimension 0
  (if [zero? dimension] '(())
      ;; Combine all combinations
      (apply append
             ;; For each digit from digits
             (map (lambda (d)
                    ;; Prepend the digit to each combination
                    ;; for a smaller by one dimension
                    (map (lambda (sd) (cons d sd))
                         (make-domain digits (1- dimension))))
                  digits))))

Your answer can be made tail-recursive by the usual trick of using an accumulator. The following is Racket not Scheme, but perhaps only because it uses append* which can be defined, I think, as

(define (append* . args)
  (apply append args))

Here is a tail-recursive version, therefore:

(define (make-domain digits dimension)
  (let mdl ([d dimension] [r '(())])
    (if (zero? d)
        r
        (mdl (- d 1)
             (append* (map (λ (d)
                             (map (λ (sd)
                                    (cons d sd))
                                  r))
                           digits))))))

For completeness, here is the Haskell solution translated to Standard ML:

fun curry f x y = f (x, y)
fun concatMap f xs = List.concat (List.map f xs)

fun makeDomain _ 0 = [[]]
  | makeDomain ys n =
    let val res = makeDomain ys (n-1)
    in concatMap (fn x => map (curry op:: x) res) ys
    end

One could apply the usual trick of an accumulator to avoid the n stack frames that tfb demonstrates. But as amalloy points out, this is hardly the bottleneck of this function with its memory use an exponential factor of n. In the Standard ML variant, the excessive list concatenation will cost more.

So depending on what you intend to do with this list, you may want to consider, in Standard ML, generating its elements and process them one at a time (like lazy streams allow you to); for example, rather than generate a long list and filter it, you could generate the filtered list. Here's an example: Translation of Pythagorean Triplets from Haskell to Standard ML.

Related