Scheme zip函数,可能包含不均匀列表

时间:2013-06-23 01:37:37

标签: list function zip scheme

我之前已经问过这个问题,我的解决方案和许多答案一样,但我有一个特殊的测试用例,无法正常解决这个问题。

我和其他许多人一样找到解决拉链问题的解决方案是

(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 ()))

我还没有找到解决这个问题的方法,并且不确定如何处理它,每个列表可以是任意长度。

2 个答案:

答案 0 :(得分: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算法,您还可以在执行经典地图列表之前先将占位符添加到列表中:

(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

答案 1 :(得分:0)

(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


如果确实想要使用占位符,则这是支持占位符的(特定于Racket)版本。默认占位符是(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)))))