Generating list of 2-lists in Scheme

问题:

(define cart-product
  (lambda (sos1 sos2)
    (if (null? sos1) '()
      (cons
       (cart-prod-sexpr (car sos1) sos2)
       (cart-product (cdr sos1) sos2)))))

(define cart-prod-sexpr
  (lambda (s sos)
    (if (null? sos) '()
        (cons
         (list s (car sos))
         (cart-prod-sexpr s (cdr sos))))))

Calling (cart-product '(q w) '(x y)) produces (((q x) (q y)) ((w x) (w y))).

How I can produce ((q x) (q y) (w x) (w y)) instead?

回答1:

Untested. Note that the append-list procedure I defined actually returns a list ending in sos2. That is appropriate (and the right thing to do) here, but is not in general.

(define cart-product
  (lambda (sos1 sos2)
    (if (null? sos1) '()
      (append-list
       (cart-prod-sexpr (car sos1) sos2)
       (cart-product (cdr sos1) sos2)))))

(define cart-prod-sexpr
  (lambda (s sos)
    (if (null? sos) '()
        (cons
         (list s (car sos))
         (cart-prod-sexpr s (cdr sos))))))

(define append-list
  (lambda (sos1 sos2)
    (if (null? sos1) sos2
      (cons
        (car sos1)
        (append-list (cdr sos1) sos2)))))

Note that if the lists are of size n then this will take time O(n³) to produce a list of size O(n²). Using regular append would take O(n⁴) instead. I just implemented the regular append without realizing it. If you want to take O(n²) you have to be more clever. As in this untested code.

(define cart-product
  (lambda (sos1 sos2)
    (let cart-product-finish
      (lambda (list1-current list2-current answer-current)
        (if (null? list2-current)
          (if (null? list1-current)
             answer-current
             (cart-product-finish (car list1-current) sos2 answer-current))
          (cart-product-finish list1-current (car sos2)
            (cons (cons (cdr list1-current) (cdr list2-current)) answer-current))))
    (cart-product-finish list1 '() '())))

In case I have a bug, the idea is to recursively loop through all combinations of elements in the first and the second, with each one replacing answer-current with a cons with one more combination, followed by everything else we have found already. Thanks to tail-call optimization, this should be efficient.

回答2:

Higher order functions for the win. Haskell's list comprehesion translated to Scheme for a nicer solution:

; cart xs ys = [ [x,y] | x <- xs, y <- ys ]
(define (cart xs ys)
  (let ((f (lambda (x) (map (lambda (y) (list x y)) ys))))
    (concatenate (map f xs))))

(cart '(a b c) '(x y)) => ((a x) (a y) (b x) (b y) (c x) (c y))

It runs in m*n (m = |xs|, n = |ys|). concatenate is from SRFI-1.

回答3:

Off the top of my head:

(define cart-product
  (lambda (sos1 sos2)
    (if (null? sos1) 
        '()
        (append
         (cart-prod-sexpr (car sos1) sos2)
         (cart-product (cdr sos1) sos2)))))

回答4:

(reduce #'append 
           (mapcar #'(lambda(x)
                         (mapcar #'(lambda(y) 
                                       (list x y))
                          '(a b c))) 
           '(1 2 3)))

=> ((1 A) (1 B) (1 C) (2 A) (2 B) (2 C) (3 A) (3 B) (3 C))

[Note: Solution is for Common Lisp (CLisp) and not Scheme, but I suppose it should be very similar in Scheme]

The outer (reduce #'append ) is for replacing (concatenate (map ) as given in solution by knivil

However, I am not sure how my solution stacks up on performance parameters compared to other solutions. Can somebody please comment on that?

回答5:

Here is just different solution on the same problem. I think that this is easy for understanding and maybe will be helpful for someone.

(define (cart-product l1 l2)
  (define (cart-product-helper l1 l2 org_l2)
    (cond
      ((and (null? l1)) `())
      ((null? l2) (cart-product-helper (cdr l1) org_l2 org_l2))
      (else (cons (cons (car l1) (car l2)) (cart-product-helper l1 (cdr l2) org_l2)))
    )
  )
  (cart-product-helper l1 l2 l2)
)