Finding all possible lists of X

问题

I would like to create a function construct-tuples that consumes a list of length m and a Nat n and produces all possible n-tuples of a list of the elements of the consumed list. The following check-expects give an idea of what the function should produce:

(check-expect (construct-tuples '(+ -) 3)
              '((+ + +) (+ + -) (+ - +) (+ - -)
                        (- + +) (- + -) (- - +) (- - -)))
(check-expect (construct-tuples empty 3) (list empty))
(check-expect (construct-tuples '(+ -) 0) (list empty))
(check-expect (construct-tuples '(+ - * /) 4)
              (list
               (list '+ '+ '+ '+)
               (list '+ '+ '+ '-)
               (list '+ '+ '+ '*)
               (list '+ '+ '+ '/)
               (list '+ '+ '- '+)
               (list '+ '+ '- '-)
               (list '+ '+ '- '*)
               (list '+ '+ '- '/)
               (list '+ '+ '* '+)
               (list '+ '+ '* '-)
               (list '+ '+ '* '*)
               (list '+ '+ '* '/)
               (list '+ '+ '/ '+)
               (list '+ '+ '/ '-)
               (list '+ '+ '/ '*)
               (list '+ '+ '/ '/)
               (list '+ '- '+ '+)
               (list '+ '- '+ '-)
               (list '+ '- '+ '*)
               (list '+ '- '+ '/)
               (list '+ '- '- '+)
               (list '+ '- '- '-)
               (list '+ '- '- '*)
               (list '+ '- '- '/)
               (list '+ '- '* '+)
               (list '+ '- '* '-)
               (list '+ '- '* '*)
               (list '+ '- '* '/)
               (list '+ '- '/ '+)
               (list '+ '- '/ '-)
               (list '+ '- '/ '*)
               (list '+ '- '/ '/)
               (list '+ '* '+ '+)
               (list '+ '* '+ '-)
               (list '+ '* '+ '*)
               (list '+ '* '+ '/)
               (list '+ '* '- '+)
               (list '+ '* '- '-)
               (list '+ '* '- '*)
               (list '+ '* '- '/)
               (list '+ '* '* '+)
               (list '+ '* '* '-)
               (list '+ '* '* '*)
               (list '+ '* '* '/)
               (list '+ '* '/ '+)
               (list '+ '* '/ '-)
               (list '+ '* '/ '*)
               (list '+ '* '/ '/)
               (list '+ '/ '+ '+)
               (list '+ '/ '+ '-)
               (list '+ '/ '+ '*)
               (list '+ '/ '+ '/)
               (list '+ '/ '- '+)
               (list '+ '/ '- '-)
               (list '+ '/ '- '*)
               (list '+ '/ '- '/)
               (list '+ '/ '* '+)
               (list '+ '/ '* '-)
               (list '+ '/ '* '*)
               (list '+ '/ '* '/)
               (list '+ '/ '/ '+)
               (list '+ '/ '/ '-)
               (list '+ '/ '/ '*)
               (list '+ '/ '/ '/)
               (list '- '+ '+ '+)
               (list '- '+ '+ '-)
               (list '- '+ '+ '*)
               (list '- '+ '+ '/)
               (list '- '+ '- '+)
               (list '- '+ '- '-)
               (list '- '+ '- '*)
               (list '- '+ '- '/)
               (list '- '+ '* '+)
               (list '- '+ '* '-)
               (list '- '+ '* '*)
               (list '- '+ '* '/)
               (list '- '+ '/ '+)
               (list '- '+ '/ '-)
               (list '- '+ '/ '*)
               (list '- '+ '/ '/)
               (list '- '- '+ '+)
               (list '- '- '+ '-)
               (list '- '- '+ '*)
               (list '- '- '+ '/)
               (list '- '- '- '+)
               (list '- '- '- '-)
               (list '- '- '- '*)
               (list '- '- '- '/)
               (list '- '- '* '+)
               (list '- '- '* '-)
               (list '- '- '* '*)
               (list '- '- '* '/)
               (list '- '- '/ '+)
               (list '- '- '/ '-)
               (list '- '- '/ '*)
               (list '- '- '/ '/)
               (list '- '* '+ '+)
               (list '- '* '+ '-)
               (list '- '* '+ '*)
               (list '- '* '+ '/)
               (list '- '* '- '+)
               (list '- '* '- '-)
               (list '- '* '- '*)
               (list '- '* '- '/)
               (list '- '* '* '+)
               (list '- '* '* '-)
               (list '- '* '* '*)
               (list '- '* '* '/)
               (list '- '* '/ '+)
               (list '- '* '/ '-)
               (list '- '* '/ '*)
               (list '- '* '/ '/)
               (list '- '/ '+ '+)
               (list '- '/ '+ '-)
               (list '- '/ '+ '*)
               (list '- '/ '+ '/)
               (list '- '/ '- '+)
               (list '- '/ '- '-)
               (list '- '/ '- '*)
               (list '- '/ '- '/)
               (list '- '/ '* '+)
               (list '- '/ '* '-)
               (list '- '/ '* '*)
               (list '- '/ '* '/)
               (list '- '/ '/ '+)
               (list '- '/ '/ '-)
               (list '- '/ '/ '*)
               (list '- '/ '/ '/)
               (list '* '+ '+ '+)
               (list '* '+ '+ '-)
               (list '* '+ '+ '*)
               (list '* '+ '+ '/)
               (list '* '+ '- '+)
               (list '* '+ '- '-)
               (list '* '+ '- '*)
               (list '* '+ '- '/)
               (list '* '+ '* '+)
               (list '* '+ '* '-)
               (list '* '+ '* '*)
               (list '* '+ '* '/)
               (list '* '+ '/ '+)
               (list '* '+ '/ '-)
               (list '* '+ '/ '*)
               (list '* '+ '/ '/)
               (list '* '- '+ '+)
               (list '* '- '+ '-)
               (list '* '- '+ '*)
               (list '* '- '+ '/)
               (list '* '- '- '+)
               (list '* '- '- '-)
               (list '* '- '- '*)
               (list '* '- '- '/)
               (list '* '- '* '+)
               (list '* '- '* '-)
               (list '* '- '* '*)
               (list '* '- '* '/)
               (list '* '- '/ '+)
               (list '* '- '/ '-)
               (list '* '- '/ '*)
               (list '* '- '/ '/)
               (list '* '* '+ '+)
               (list '* '* '+ '-)
               (list '* '* '+ '*)
               (list '* '* '+ '/)
               (list '* '* '- '+)
               (list '* '* '- '-)
               (list '* '* '- '*)
               (list '* '* '- '/)
               (list '* '* '* '+)
               (list '* '* '* '-)
               (list '* '* '* '*)
               (list '* '* '* '/)
               (list '* '* '/ '+)
               (list '* '* '/ '-)
               (list '* '* '/ '*)
               (list '* '* '/ '/)
               (list '* '/ '+ '+)
               (list '* '/ '+ '-)
               (list '* '/ '+ '*)
               (list '* '/ '+ '/)
               (list '* '/ '- '+)
               (list '* '/ '- '-)
               (list '* '/ '- '*)
               (list '* '/ '- '/)
               (list '* '/ '* '+)
               (list '* '/ '* '-)
               (list '* '/ '* '*)
               (list '* '/ '* '/)
               (list '* '/ '/ '+)
               (list '* '/ '/ '-)
               (list '* '/ '/ '*)
               (list '* '/ '/ '/)
               (list '/ '+ '+ '+)
               (list '/ '+ '+ '-)
               (list '/ '+ '+ '*)
               (list '/ '+ '+ '/)
               (list '/ '+ '- '+)
               (list '/ '+ '- '-)
               (list '/ '+ '- '*)
               (list '/ '+ '- '/)
               (list '/ '+ '* '+)
               (list '/ '+ '* '-)
               (list '/ '+ '* '*)
               (list '/ '+ '* '/)
               (list '/ '+ '/ '+)
               (list '/ '+ '/ '-)
               (list '/ '+ '/ '*)
               (list '/ '+ '/ '/)
               (list '/ '- '+ '+)
               (list '/ '- '+ '-)
               (list '/ '- '+ '*)
               (list '/ '- '+ '/)
               (list '/ '- '- '+)
               (list '/ '- '- '-)
               (list '/ '- '- '*)
               (list '/ '- '- '/)
               (list '/ '- '* '+)
               (list '/ '- '* '-)
               (list '/ '- '* '*)
               (list '/ '- '* '/)
               (list '/ '- '/ '+)
               (list '/ '- '/ '-)
               (list '/ '- '/ '*)
               (list '/ '- '/ '/)
               (list '/ '* '+ '+)
               (list '/ '* '+ '-)
               (list '/ '* '+ '*)
               (list '/ '* '+ '/)
               (list '/ '* '- '+)
               (list '/ '* '- '-)
               (list '/ '* '- '*)
               (list '/ '* '- '/)
               (list '/ '* '* '+)
               (list '/ '* '* '-)
               (list '/ '* '* '*)
               (list '/ '* '* '/)
               (list '/ '* '/ '+)
               (list '/ '* '/ '-)
               (list '/ '* '/ '*)
               (list '/ '* '/ '/)
               (list '/ '/ '+ '+)
               (list '/ '/ '+ '-)
               (list '/ '/ '+ '*)
               (list '/ '/ '+ '/)
               (list '/ '/ '- '+)
               (list '/ '/ '- '-)
               (list '/ '/ '- '*)
               (list '/ '/ '- '/)
               (list '/ '/ '* '+)
               (list '/ '/ '* '-)
               (list '/ '/ '* '*)
               (list '/ '/ '* '/)
               (list '/ '/ '/ '+)
               (list '/ '/ '/ '-)
               (list '/ '/ '/ '*)
               (list '/ '/ '/ '/)))

I found a way to do this using recursive calls to map, but it only works for finite values, so I was wondering if there was a way to make this arbitrary?

回答1:

You can indeed solve this using recursion. There's no need to even call out to functions like map. The following is an implementation that I believe solves the problem:

(define (construct-tuples symbols n)
  (if (zero? n)
      (list '())
      (let ((tuples-n-1 (construct-tuples symbols (sub1 n))))
        (for*/list ([tuple tuples-n-1]
                    [symbol symbols])
          (cons symbol tuple)))))

This solution works via recursion. The base case returns a list containing one empty list. For each iteration, we get the list of possible tuples for n-1, and then for every symbol, create a new list, containing the original list, plus that symbol.

To illustrate how this works, consider the following:

• We want to calculate (construct-tuples '(+ -) 3)
• This would first need to calculate (construct-tuples '(+ -) 2)
• Which would need to calculate (construct-tuples '(+ -) 1)
• Which would need to calculate (construct-tuples '(+ -) 0)
• ... the answer of which is (list '())
• For each symbol in '(+ -) we create a new list appending that symbol to '(). This returns (list '(+) '(-))
• For each symbol in '(+ -), create a new list appending that symbol to each list in (list '(+) '(-)). This will create 4 new lists (2x2). (list '(+ +) '(+ -) '(- +) '(- -))
• Lastly, for each symbol in '(+ -), create a new list for each of the lists that we got from the recursive iteration (8 lists will be created (4x2))

Thes for*/list function does a lot of the heavy lifting in this function. What this does is iterates for every possible combination of the various arguments producing a list of the various answers.

(for*/list ([x '(+ -)]
            [y '(* /)])
  (list x y))

This will produce a list of every possible tuple between '(x -) and '(* /)

来源：https://stackoverflow.com/questions/59122552/finding-all-possible-lists-of-x