CODEWITHSUNDEEP
loopslispcommon-lispgeneratorcartesian-product
Michelle
Michelle

Reputation: 265

How to generate one cartesian product in lisp?

This is my code to generate a cartesian product:

(defun cartesian-product (LIST)
  (LOOP FOR X IN LIST
    NCONC
        (LOOP FOR Y IN LIST
         COLLECT (LIST X Y))))

I tried outputting one of the cartesian products with this: 

(defun cartesian-product-generator (CALLBACK LIST)
  (LOOP FOR X IN LIST
    NCONC
        (LOOP FOR Y IN LIST
        DO(FUNCALL CALLBACK (LIST X Y)))))

However there are errors when I tried testing it with:

(cartesian-product-generator '(A B C))

Error: Too few arguments in call to #<Compiled-function cartesian-product-generator #x30200097E60F>:
       1 argument provided, at least 2 required.  While executing: cartesian-product-generator, in process listener(1).

I am new to LISP and would like to know why there's an error and how to fix this error. Ultimately, I would like to output each cartesian product per call of the function.

For example, if the lists consists of ((1 1) (1 2) (2 1) (2 2)). I would like to generate (1 1). Then (1 2). Then (2 1). Lastly, (2 2).

Upvotes: 2

Views: 1852

Answers (4)

Kepler
Kepler

Reputation: 195

Let me give a more basic answer (without loops), but more general, i.e., cartesian products of two, three and four lists (your case is binary cartesian product with two identical arguments):

(defun make-tuples-with-object (obj lst)
  (mapcar #'(lambda (x) (list obj x)) lst))
                
(defun cartesian-product (list-1 list-2)
  (apply #'append (mapcar #'(lambda (x) (make-tuples-with-object x list-2)) list-1)))

(defun cartesian-product-ternary (list-1 list-2 list-3)
  (mapcar #'(lambda (x) (cons (car x) (second x)))
      (cartesian-product list-1 (cartesian-product list-2 list-3))))

(defun cartesian-product-quaternary (list-1 list-2 list-3 list-4)
  (mapcar #'(lambda (x) (cons (car x) (second x)))
      (cartesian-product list-1 (cartesian-product-ternary list-2 list-3 list-4))))

Upvotes: 0

margolari
margolari

Reputation: 671

Just want to leave my 2 cents here.

You can also do this with a macro

(defmacro cartesian-product (lists)
  (let* ((indices (loop for i from 1 to (length lists)
                        collect (gensym (format nil "~a-i-" i))))
         (initial-value `(loop for ,(car (last indices)) in ',(car (last lists))
                               collect `(,,@indices))))
    (reduce
     (lambda (x y)
       `(loop for ,(car x) in ',(cadr x)
              nconc ,y))
     (mapcar #'list (butlast indices) (butlast lists))
     :from-end t
     :initial-value initial-value)))

which expands with

(cartesian-product ((H P) (a b c) (1 2 3 5)))

to

(loop for #:|1-i-806| in '(h p)
      nconc (loop for #:|2-i-807| in '(a b c)
                  nconc (loop for #:|3-i-808| in '(1 2 3 5)
                              collect `(,#:|1-i-806| ,#:|2-i-807| ,#:|3-i-808|))))

and results into

((H A 1) (H A 2) (H A 3) (H A 5) (H B 1) (H B 2) (H B 3) (H B 5) (H C 1) (H C 2) (H C 3) (H C 5)
 (P A 1) (P A 2) (P A 3) (P A 5) (P B 1) (P B 2) (P B 3) (P B 5) (P C 1) (P C 2) (P C 3) (P C 5))

I like it because it is quite simple and does not require recursion.

Upvotes: 0

coredump
coredump

Reputation: 38809

Your first code does work correctly.

(defun cartesian-product (list)
  (loop
    for x in list
    nconc (loop for y in list
                collect (list x y))))

Calling it with '(a b c) returns a list:

((A A) (A B) (A C) (B A) (B B) (B C) (C A) (C B) (C C))

You want to avoid building a list and use a callback instead. To simplify, first try to only print elements instead of collecting them.

That means that you do not care about returning the generated values up to the caller: you just want to generate them and print them as soon as they are available.

Basically, you can replace all nconc and collect keywords by do, and add a call to print:

(defun cartesian-product (list)
  (loop
    for x in list
    do (loop for y in list
             do (print (list x y)))))

A quick test on the REPL with '(a b c) should print the same elements as previously, each one on a separte line.

Now, you can just generalize print and call anything you want:

(defun map-cartesian-product (function list)
  (loop
    for x in list
    do (loop for y in list
             do (funcall function (list x y)))))

Just to see if it still works, do a quick test:

(map-cartesian-product #'print '(a b c))

This should have the same behaviour as before.

Since you only iterate over a list for side-effects, you can use DOLIST:

(defun map-cartesian-product (function list)
  (dolist (x list)
    (dolist (y list)
      (funcall function (list x y)))))

Again, you can test that it still works as previously.

Upvotes: 7

ptb
ptb

Reputation: 2148

You may want to look into the cl-coroutine library available via quicklisp. Then your cartesian-product could be written as

(cl-coroutine:defcoroutine cartesian-product (list)
  (loop for x in list
    do (loop for y in list
      do (cl-coroutine:yield (list x y)))))

An example use could be:

(cl-coroutine:with-coroutine (cartesian-product)
  (let ((x (list 1 2 3)))
    (loop for y = (cartesian-product x)
      while y do (print y))))

; outputs (1 1) (1 2) ... (3 3)

Upvotes: 3

Related Questions