方案中的配对组合

Pair combinations in scheme

我试图找到可以用方案中的 N 对列表进行的各种组合。这是我目前所在的位置:

(define (pair-combinations list-of-pairs)
  (if (null? list-of-pairs)
      nil
      (let ((first (caar list-of-pairs))
            (second (cadar list-of-pairs))
            (rest (pair-combinations (cdr list-of-pairs))))
        (append
            (list (cons first rest))
            (list (cons second rest))
        ))))

现在,我不确定逻辑是否正确,但我立即注意到括号的伸缩。例如:

(define p1 '( (1 2) (3 4) (5 6) ))
(pair-combinations p1)
((1 (3 (5) (6)) (4 (5) (6))) (2 (3 (5) (6)) (4 (5) (6))))

显然,这是由于在追加调用中重复了 list (...,所以结果看起来类似于 (list 1 (list 2 (list 3 ...。有没有办法在一个函数中做类似上面的事情?如果是这样,我哪里出错了,如何正确完成?

我希望得到的答案是:

((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))

即从N对中选择一个元素的可能方式。

这是思考这个问题的一种方法。如果输入为空列表,则结果为 ()。如果输入是一个包含单个列表的列表,那么结果就是在该列表上映射 list 的结果,即 (combinations '((1 2 3))) --> ((1) (2) (3)).

否则,可以通过获取输入中的第一个列表并将该列表中的每个项目添加到为输入中其余列表找到的所有组合来形成结果。也就是说,(combinations '((1 2) (3 4))) 可以通过将 (1 2) 的每个元素添加到 (combinations '((3 4))) 中的每个组合来找到,这些组合是 ((3) (4)).

用两个过程来表达这一点似乎很自然。首先,一个combinations程序:

(define (combinations xss)
  (cond ((null? xss) '())
        ((null? (cdr xss))
         (map list (car xss)))
        (else
         (prepend-each (car xss)
                       (combinations (cdr xss))))))

现在需要一个prepend-each程序:

(define (prepend-each xs yss)
  (apply append
         (map (lambda (x)
                (map (lambda (ys)
                       (cons x ys))
                     yss))
              xs)))

这里的过程 prepend-each 接受一个列表 xs 和一个列表列表 yss 和 returns 将每个 x 添加到 xsyss 中的列表。内部映射获取 yss 中的每个列表 ys 并将 xs 中的 x 添加到它上面。由于内部映射产生列表的列表,外部映射然后产生列表的列表的列表,因此 append 用于在返回之前连接结果。

combinations.rkt> (combinations '((1 2) (3 4) (5 6)))
'((1 3 5) (1 3 6) (1 4 5) (1 4 6) (2 3 5) (2 3 6) (2 4 5) (2 4 6))

既然找到了可行的方法,这个可以转换成一个过程:

(define (combinations-2 xss)
  (cond ((null? xss) '())
        ((null? (cdr xss))
         (map list (car xss)))
        (else
         (apply append
                (map (lambda (x)
                       (map (lambda (ys)
                              (cons x ys))
                            (combinations-2 (cdr xss))))
                     (car xss))))))

但是,我不会那样做,因为两个程序中的第一个版本似乎更清楚。

仅查看使用和不使用 appendprepend-each 的结果可能会有所帮助:

combinations.rkt> (prepend-each '(1 2) '((3 4) (5 6)))
'((1 3 4) (1 5 6) (2 3 4) (2 5 6))

不使用 append:

(define (prepend-each-no-append xs yss)
  (map (lambda (x)
         (map (lambda (ys)
                (cons x ys))
              yss))
       xs))
combinations.rkt> (prepend-each-no-append '(1 2) '((3 4) (5 6)))
'(((1 3 4) (1 5 6)) ((2 3 4) (2 5 6)))

可以看出,1((3 4) (5 6))中的每个列表前添加,以创建列表列表,然后2在[=45=中的每个列表前添加] 创建列表列表。这些结果包含在另一个列表中,因为 12 来自 (1 2) 上的外部映射。这就是为什么使用 append 来连接结果。

一些最后的改进

请注意,当 yss 为空时,prepend-each returns 是一个空列表,但是当 xs 的元素分布在多个列表中时,返回一个列表yss 包含一个空列表:

combinations.rkt> (prepend-each '(1 2 3) '(()))
'((1) (2) (3))

combinations 的输入包含单个列表时,这与我们想要的结果相同。我们可以修改 combinations 使其具有单一的基本情况:当输入为 '() 时,结果为 (())。这将允许 prepend-each 完成之前由 (map list (car xss)) 完成的工作,使 combinations 更加简洁; prepend-each 程序未更改,但为了完整起见,我还是将其包含在下面:

(define (combinations xss)
  (if (null? xss) '(())
      (prepend-each (car xss)
                    (combinations (cdr xss)))))

(define (prepend-each xs yss)
  (apply append
         (map (lambda (x)
                (map (lambda (ys)
                       (cons x ys))
                     yss))
              xs)))

combinations 更简洁后,我 可能 想继续把它写成一个过程,毕竟:

(define (combinations xss)
  (if (null? xss) '(())
      (apply append
             (map (lambda (x)
                    (map (lambda (ys)
                           (cons x ys))
                         (combinations (cdr xss))))
                  (car xss)))))