Создание списка 2-списков в схеме

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

Вызов (cart-product '(q w) '(x y)) вызывает (((q x) (q y)) ((w x) (w y))).

Как я могу создать ((q x) (q y) (w x) (w y)) вместо?

Ответ 1

непроверенная. Обратите внимание, что процедура append-list, которую я определил, фактически возвращает список, заканчивающийся на sos2. Это уместно (и правильно делать) здесь, но не является вообще.

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

Обратите внимание, что если списки имеют размер n, тогда для получения списка размера O (n 2) потребуется время O (n 3). Используя обычный append, вместо этого возьмет O (n 4). Я только что реализовал обычный append, не осознавая этого. Если вы хотите взять O (n 2), вы должны быть более умными. Как и в этом непроверенном коде.

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

В случае, если у меня есть ошибка, идея состоит в том, чтобы рекурсивно перебирать все комбинации элементов в первом и втором, причем каждый из них заменяет answer-current на cons еще одной комбинацией, за которой следует все остальное. уже нашли. Благодаря оптимизации хвостового вызова это должно быть эффективным.

Ответ 2

Функции более высокого порядка для победы. Перечисление списка Haskell переведено на схему для более удобного решения:

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

Он работает в m * n (m = | xs |, n = | ys |). concatenate от SRFI-1.

Ответ 3

Сверху моей головы:

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

[Примечание: решение для Common Lisp (CLisp), а не схемы, но я полагаю, что это должно быть очень похоже на Схеме]

Внешний (уменьшить # 'append) предназначен для замены (конкатенация (карта), как указано в решении knivil

Однако я не уверен, как мое решение складывается по параметрам производительности по сравнению с другими решениями. Может кто-нибудь прокомментировать это?

Ответ 5

Вот просто другое решение по той же проблеме. Я думаю, что это легко понять и, возможно, будет полезно для кого-то.

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