带有可能不均匀列表的方案 zip 函数

Question

我知道以前有人问过这个问题，我的解决方案与许多答案相同，但我有一个特殊的测试用例，它不能与这个问题的通用解决方案一起正常工作。

我为 zip 问题找到的解决方案像许多其他人一样是

(define (zip l1 l2)(map list l1 l2))

。 . .which 适用于给定的参数，例如

(zip '(a b c) '(1 2 3)) => ((a 1) (b 2) (c 3))

但我也希望 zip 函数适用于我的参数与长度不匹配的情况，例如

(zip '(a b c) '(1)) => ((a 1) (b ()) (c ()))

我还没有找到解决这个问题的方法，也不确定如何解决每个列表可以是任意长度的问题。

Answer 1

首先，一个仅适用于 2 个列表的简单迭代版本：

(define (zip lst1 lst2 (placeholder '()))

  (define (my-car lst)
    (if (empty? lst) placeholder (car lst)))
  (define (my-cdr lst)
    (if (empty? lst) lst (cdr lst)))

  (let loop ((lst1 lst1) (lst2 lst2) (res '()))
    (if (and (empty? lst1) (empty? lst2))
        (reverse res)
        (loop (my-cdr lst1) (my-cdr lst2) 
              (cons (list (my-car lst1) (my-car lst2)) res)))))

比如

(zip '(a b c) '(1 2 3))
=> '((a 1) (b 2) (c 3))

(zip '(a b c) '(1))
=> '((a 1) (b ()) (c ()))

由此，您可以推广到 n 个列表，但为了避免关键字参数，您必须先放置占位符参数：

(define (zip placeholder . lsts)

  (define (my-car lst)
    (if (empty? lst) placeholder (car lst)))
  (define (my-cdr lst)
    (if (empty? lst) lst (cdr lst)))

  (let loop ((lsts lsts) (res '()))
    (if (andmap empty? lsts)
        (reverse res)
        (loop (map my-cdr lsts) 
              (cons (apply list (map my-car lsts)) res)))))

比如

(zip '() '(a b c) '(1 2 3))
==> '((a 1) (b 2) (c 3))

(zip '() '(a b c) '(1))
==> '((a 1) (b ()) (c ()))

(zip '() '(a b c) '(1) '(x y))
=> '((a 1 x) (b () y) (c () ()))

我相信 andmap 是这里唯一特定于 Racket 的函数，根据您的实现，它可能有一些 Scheme 或 SRFI 等价物。

编辑

由于该解决方案基于创建等长列表，而不是重复 zip 算法，您还可以先将占位符添加到列表中，然后再执行经典的 map-list 内容：

(define (zip placeholder . lsts)
  (let* ((max-len (apply max (map length lsts))) ; the length of the longest lists
         (equal-length-lists                     ; adjusts all lists to the same length,
          (map                                   ;   filling with placeholder
           (lambda (lst) (append lst (make-list (- max-len (length lst)) placeholder)))
           lsts)))
    (apply map list equal-length-lists)))        ; classical zip

Answer 2

(zip '(a b c) '(1)) => ((a 1) (b ()) (c ())) 在语义上是不正确的（除非您专门使用 () 作为占位符值）；拥有((a 1) (b) (c)) 更明智。这是一个实现这一目标的实现：

(define (zip-with-uneven . lists)
  (define (advance lst)
    (if (null? lst)
        lst
        (cdr lst)))
  (define (firsts lists)
    (let loop ((lists lists)
               (result '()))
      (cond ((null? lists) (reverse result))
            ((null? (car lists)) (loop (cdr lists) result))
            (else (loop (cdr lists) (cons (caar lists) result))))))

  (let loop ((lists lists)
             (results '()))
    (if (andmap null? lists)
        (reverse results)
        (loop (map advance lists)
              (cons (firsts lists) results)))))

andmap 来自 Racket。如果您不使用 Racket，则可以使用 SRFI 1 中的every。

---

如果您真的想要使用占位符，这里有一个支持占位符的（特定于球拍的）版本。默认占位符是(void)，我认为它绝不是您想要放入结果列表的有效值。

(define (zip-with-uneven #:placeholder (ph (void)) . lists)
  (define (advance lst)
    (if (null? lst)
        lst
        (cdr lst)))
  (define (cons-with-placeholder a d)
    (if (void? a)
        d
        (cons a d)))
  (define (firsts lists)
    (let loop ((lists lists)
               (result '()))
      (cond ((null? lists) (reverse result))
            ((null? (car lists))
             (loop (cdr lists) (cons-with-placeholder ph result)))
            (else (loop (cdr lists) (cons (caar lists) result))))))

  (let loop ((lists lists)
             (results '()))
    (if (andmap null? lists)
        (reverse results)
        (loop (map advance lists)
              (cons (firsts lists) results)))))