I am trying to write a function in Lisp that generates all possible combinations of given keys and values. Here is an example input and output:
Input: '((key1 . (v1 v2))
(key2 . (v3 v4)))
Output: '(((key1 . v1)(key2 . v3))
((key1 . v1)(key2 . v4))
((key1 . v2)(key2 . v3))
((key1 . v2)(key2 . v4)))
Currently, my function for doing this is the following:
(defun generate-selectors (selectors)
(cond ((= (length selectors) 0) nil)
((= (length selectors) 1)
(let* ((keys (mapcar #'first selectors))
(key (first keys))
(values (rest (assoc key selectors))))
(loop for val in values
collect (cons key val))))
(t
(let* ((keys (mapcar #'first selectors))
(key (first keys))
(values (rest (assoc key selectors)))
(rest (remove (assoc key selectors) selectors)))
(loop for r in (generate-selectors rest)
append (loop for val in values
collect (cons (cons key val) (list r))))))))
For the input given above, the function works as expected:
> (generate-selectors '((key1 . (v1 v2 v3)) (key2 . (v4 v5))))
(((KEY1 . V1) (KEY2 . V4))
((KEY1 . V2) (KEY2 . V4))
((KEY1 . V3) (KEY2 . V4))
((KEY1 . V1) (KEY2 . V5))
((KEY1 . V2) (KEY2 . V5))
((KEY1 . V3) (KEY2 . V5)))
However, for longer input, the output is no longer correct!
> (generate-selectors '((key1 . (v1 v2 v3)) (key2 . (v4 v5)) (key3 . (v6))))
(((KEY1 . V1) ((KEY2 . V4) (KEY3 . V6)))
((KEY1 . V2) ((KEY2 . V4) (KEY3 . V6)))
((KEY1 . V3) ((KEY2 . V4) (KEY3 . V6)))
((KEY1 . V1) ((KEY2 . V5) (KEY3 . V6)))
((KEY1 . V2) ((KEY2 . V5) (KEY3 . V6)))
((KEY1 . V3) ((KEY2 . V5) (KEY3 . V6))))
Note in the output above that KEY2 and KEY3 are nested in another sublist. The correct output should look like this:
(((KEY1 . V1) (KEY2 . V4) (KEY3 . V6))
((KEY1 . V2) (KEY2 . V4) (KEY3 . V6))
... )
What is causing this in my generate-selectors function?
EDIT: When not wrapping r in a list, I get the following output:
> (generate-selectors '((key1 . (v1 v2 v3)) (key2 . (v4 v5)) (key3 . (v6))))
(((KEY1 . V1) (KEY2 . V4) KEY3 . V6)
((KEY1 . V2) (KEY2 . V4) KEY3 . V6)
((KEY1 . V3) (KEY2 . V4) KEY3 . V6)
((KEY1 . V1) (KEY2 . V5) KEY3 . V6)
((KEY1 . V2) (KEY2 . V5) KEY3 . V6)
((KEY1 . V3) (KEY2 . V5) KEY3 . V6))
Given the fact that the previous solution is correct, I would like to propose an alternative solution. Given a list of lists A1, A2, ... An, the following function performs the cartesian product of them (A1 x A2 x ... x An):
(defun cartesian-product (l)
(if (null l)
(list nil)
(loop for x in (car l)
nconc (loop for y in (cartesian-product (cdr l)) collect (cons x y)))))
Then the function generate-selectors can be defined as:
(defun generate-selectors (selectors)
(cartesian-product (loop for s in selectors
collect (loop for val in (cdr s) collect (cons (car s) val)))))
Here:
(cons (cons key val) (list r))
R is obtained recursively and is a list. You are wrapping it inside a list. Try instead:
(cons (cons key val) r)
Also, when you call append in the general case, you expect a list of lists. Your base case is however not producing a list of lists, only a list.
You need to put the additional list in the base case around the cons:
(loop for val in values
collect (list (cons key val)))
Another version
If you don't need keys, this one is a little bit simpler. I (re)named the function product, following Renzo's answer, because what you are doing is called the Cartesian product:
(defun product (lists)
(if lists
(destructuring-bind (head . lists) lists
(loop
with product = (product lists)
for value in head
append (loop
for tuple in product
collect (cons value tuple))))
(list (list))))
(product '((a b) (0 1 2)))
=> ((A 0) (A 1) (A 2) (B 0) (B 1) (B 2))
Related
Im trying to make a function that replaces the values of one list by values of another list if certain conditions are met.
For example, given l1 = ((x 1) (y 2)), l2 = (word x y c) I should get (1 2 c). My approach is to modify l2. I know how to do it with a loop but the loop stops at the shorter list and doesn't keep going.I have tried multiple methods and spent around 6 hours trying to come up with something but cannot.
Below is my code
(loop :for x :in (cdr l2):for (a b) in l1
do(if (eql a x) (nsubst b x l2) ())
return l2
)
It doesn't work for me, and just stop at the first thing so I get like (word replaced value c). It even doesn't work when l1 and l2 have the same size
You are using two “parallel” iterations in your loop, but you should use two “nested” loops, that is one loop inside the other: the external one to scan trhough l2, the inner one to find the right substitution.
CL-USER> (defvar l1 (copy-list '((x 1) (y 2))))
L1
CL-USER> (defvar l2 (copy-list '(word x y c)))
L2
CL-USER> (loop for x in (cdr l2)
do (loop for (a b) in l1
when (eql a x)
do (nsubst b x l2))
finally (return l2))
(WORD 1 2 C)
SUBLIS
First of all, note that Common Lisp defines a standard function that can be useful when doing term rewriting, namely SUBLIS:
USER> (sublis '((x . 1) (y . 2) (z . 3))
'(some-tree
(with x
(and y z
(nested (list x y z))))))
(SOME-TREE (WITH 1 (AND 2 3 (NESTED (LIST 1 2 3)))))
You can also play with the :key and :test arguments to cover a lot of use cases.
Recursive transform
This small comment of yours is however quite important:
To add another example, if input l1 = ((a 1 ) (b 2)) l2 = (word a b), I should get (word 1 2) but would only get (word 1 b)
As far as I know you have basically two options here:
Call your transform function again and again until you reach a fixpoint, ie. there is no further replacement being made. For example you can call SUBLIS until the resulting form is EQUALP to the input form. Note that this algorithm might not terminate if for example you replace X by Y and Y by X.
Make a single pass version that use an intermediate resolve function, which recursively finds the actual binding of each symbol.
Let's write the second approach because it is simpler to detect circularity in my opinion.
Resolve a symbol
Given an association list of bindings (the environment), a symbol, let's define resolve so that it finds the non-symbol value transitively associated with your symbol:
(resolve 'x '((x . a) (y . 0) (a . b) (b . c) (c . y)))
=> 0
For example, let's start with a naive recursive function:
(defun resolve (value environment)
(typecase value
(symbol
(let ((entry (assoc value environment)))
(if entry
(resolve (cdr entry) environment)
(error "~S is unbound in ~S" value environment))))
(t value)))
Some tests:
(resolve 3 nil)
=> 3
(resolve 'x '((x . a) (y . 0) (a . b) (b . c) (c . y)))
=> 0
So far so good, but there is a problem if your environment has a circular dependency between symbols:
(resolve 'x '((x . y) (y . a) (a . b) (b . c) (c . y)))
=> CONTROL STACK EXHAUSTED
Tracing the calls to resolve shows that the function calls itself indefinitely:
0: (RESOLVE X ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
1: (RESOLVE Y ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
2: (RESOLVE A ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
3: (RESOLVE B ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
4: (RESOLVE C ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
5: (RESOLVE Y ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
6: (RESOLVE A ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
7: (RESOLVE B ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
8: (RESOLVE C ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
9: (RESOLVE Y ((X . Y) (Y . A) (A . B) (B . C) (C . Y)))
9: RESOLVE exited non-locally
Let's add a SEEN parameter that track which symbol has already been seen during our resolution process. I add an auxiliary function RECURSE so that I can avoid passing environment each time, and keep track of SEEN:
(defun resolve (value &optional environment)
(labels ((recurse (value seen)
(typecase value
(symbol
(assert (not (member value seen))
()
"Circularity detected: ~s already seen: ~s"
value
seen)
(let ((entry (assoc value environment)))
(if entry
(recurse (cdr entry) (cons value seen))
(error "~S is unbound in ~S" value environment))))
(t value))))
(recurse value nil)))
Some tests:
(resolve 3)
=> 3
(resolve 'x '((x . a) (y . 0) (a . b) (b . c) (c . y)))
=> 0
(resolve 'x '((x . y) (y . a) (a . b) (b . c) (c . y)))
=> Circularity detected: Y already seen: (C B A Y X)
Conclusion
Now that you can resolve one symbol, you should be able to resolve multiple symbols in a list (or a tree) of symbols.
Still new to Scheme, and I'm currently having trouble with the creation of a list of pairs constructed from two separate lists of different lengths.
Here is my current code:
#lang racket
(define letters '(a b c))
(define (create-lst-letters lst)
(map (lambda (x y) (list x y)) letters lst))
Console input:
(create-lst-letters '(1 2 3 4 5 6 7 8))
Current output:
map: all lists must have same size
first list length: 8
other list length: 3
Wanted output:
'((a . 1) (b . 2) (c . 3) (a . 4) (b . 5) (c . 6) (a . 7) (b . 8))
Another intuition would be to get the quotient and remainder of the length of the input list divided by "letters". Make a new list by appending "letters" quotient times, and then concatenating the first remainder number of elements of "letters". With that new list perform a map as above. I don't feel this is good practice nor an elegant solution, but I'm out of other ideas.
You can use in-cycle and for/list to concisely produce the output that you want.
#lang racket
(define letters '(a b c))
(define (create-lst-letters lst)
(for/list ([x (in-cycle letters)] [y lst])
(cons x y)))
(create-lst-letters '(1 2 3 4 5 6 7 8))
; '((a . 1) (b . 2) (c . 3) (a . 4) (b . 5) (c . 6) (a . 7) (b . 8))
A pure Scheme version:
#!r7rs
(import (scheme base)
(scheme list))
(define create-lst-letters
(let ((letters (circular-list 'a 'b 'c)))
(lambda (lst)
(map cons letters lst))))
(create-lst-letters '(1 2 3 4 5 6 7 8))
; ==> ((a . 1) (b . 2) (c . 3) (a . 4) (b . 5) (c . 6) (a . 7) (b . 8))
I use Racket and it doesn't have a Red edition of R7RS yet, but thsi can easily be rewritten to R6RS using SRFI-1 (same as (scheme list))
#!r6rs
(import (except (rnrs base) map)
(only (srfi :1) map circular-list))
(define create-lst-letters
(let ((letters (circular-list 'a 'b 'c)))
(lambda (lst)
(map cons letters lst))))
(create-lst-letters '(1 2 3 4 5 6 7 8))
; ==> ((a . 1) (b . 2) (c . 3) (a . 4) (b . 5) (c . 6) (a . 7) (b . 8))
And of course if you don't like writing Scheme code you can write almost the same using #lang racket language.
#lang racket
(require srfi/1)
(define create-lst-letters
(let ((letters (circular-list 'a 'b 'c)))
(lambda (lst)
(map cons letters lst))))
(create-lst-letters '(1 2 3 4 5 6 7 8))
; ==> ((a . 1) (b . 2) (c . 3) (a . 4) (b . 5) (c . 6) (a . 7) (b . 8))
I have a code like below. It return list as (((1 . 2) (1 . 0)) ((1 . 2) (1 . 1)) ((1 . 2) (1 . 3)) ((1 . 2) (1 . 4)) ((1 . 2) (1 . 5)) ((1 . 2) (1 . 6)) ((1 . 2) (1 . 7)) ((1 . 2) (0 . 2)) ((1 . 2) (2 . 2)))
I wonder if I can rewrite generHod function in the way to make it return list like ((1.2 1.0) (3.4 4.2) (1.3 1.3)...)
(setf hod '())
(defun generHod (CurrX CurrY)
(dotimes (y 8)
(if (/= y CurrY)
(setf hod (append hod (list (append (list (cons CurrX CurrY))(list (cons CurrX y))))))
)
)
(dotimes (x 8)
(if (/= x CurrX)
(setf hod (append hod (list (append (list (cons CurrX CurrY))(list (cons x CurrY))))))
)
)
)
Firstly:
(setf hod '())
This is a bad way to define a global variable; try
(defparameter hod ())
But why use a global variable at all? The function can construct a new list and just return it. If the caller wants to stick it into a global variable, that's up to the caller; it's extraneous to the operation of the function.
(defun generHod ...)
The syntax generHod is not distinguished from GENERHOD or generhod in Common Lisp, under the default readtable. All those tokens produce the same symbol. It is best not to play mixed case games in Lisp identifiers; if you want multiple words, put in a dash like gen-hod. Usually generate is abbreviated all the way to gen by English speaking hackers, not gener. See the gensym funtion in Common Lisp, for instance.
In your function, there is a completely superfluous append:
(append
(list (cons CurrX CurrY))
(list (cons CurrX y))))
The pattern (append (list X0) (list X1) ... (list XN)) can be rewritten (list X0 X1 ... XN). You're making superfluous lists of things only to append them together to make one list, instead of just listing the things in the first place.
To get the values from integer to floating point, the float function can be used, and the loop macro provides an idiom for iterating and collecting items:
(defun gen-hod (curr-x curr-y)
(let ((cxy (list (float curr-x) (float curr-y)))) ;; allocate just once!
(nconc ;; destructive append: use with care
(loop for y from 1 to 8
when (/= y curr-y)
append (list cxy (list (float curr-x) (float y))))
(loop for x from 1 to 8
when (/= x curr-x)
append (list cxy (list (float x) (float curr-y)))))))
Hello i have to programm this fucntion in lisp:
(defun combine-list-of-lsts (lst)...)
So when executing the function i should get
(combine-list-of-lsts '((a b c) (+-) (1 2 3 4)))
((A + 1) (A + 2) (A + 3) (A + 4) (A-1) (A-2) (A-3) (A-4) (B + 1) (B + 2) (B + 3) (B + 4) (B-1) (B-2) (B-3) (B-4)(C + 1) (C + 2) (C + 3) (C + 4) (C-1) (C-2) (C-3) (C-4))
What i have now is:
(defun combine-list-of-lsts (lst)
(if (null (cdr lst))
(car lst)
(if (null (cddr lst))
(combine-lst-lst (car lst) (cadr lst))
(combine-lst-lst (car lst) (combine-list-of-lsts (cdr lst))))))
Using this auxiliar functions:
(defun combine-lst-lst (lst1 lst2)
(mapcan #'(lambda (x) (combine-elt-lst x lst2)) lst1))
(defun combine-elt-lst (elt lst)
(mapcar #'(lambda (x) (list elt x)) lst))
But what i get with this:
((A (+ 1)) (A (+ 2)) (A (+ 3)) (A (+ 4)) (A(-1)) (A(-2)) (A(-3)) (A(-4))...)
I dont know how to make this but without the parenthesis
The first thing is to look at this case:
(combine-list-of-lsts '((a b c)))
What should that be? Maybe not what your function returns...
Then I would look at the function combine-list-of-lsts. Do you need two IF statements?
Then look at combine-elt-lst. Do you really want to use LIST? It creates a new list. Wouldn't it make more sense to just add the element to the front?
Usually, when you want to reduce mutliple arguments into single result, you need function #'reduce. Your combination of lists has name cartesian n-ary product.
Following function:
(defun cartesian (lst1 lst2)
(let (acc)
(dolist (v1 lst1 acc)
(dolist (v2 lst2)
(push (cons v1 v2) acc)))))
creates cartesian product of two supplied lists as list of conses, where #'car is an element of lst1, and #'cdr is an element of lst2.
(cartesian '(1 2 3) '(- +))
==> ((3 . -) (3 . +) (2 . -) (2 . +) (1 . -) (1 . +))
Note, however, that calling #'cartesian on such product will return malformed result - cons of cons and element:
(cartesian (cartesian '(1 2) '(+ -)) '(a))
==> (((1 . +) . A) ((1 . -) . A) ((2 . +) . A) ((2 . -) . A))
This happens, because members of the first set are conses, not atoms. On the other hand, lists are composed of conses, and if we reverse order of creating products, we could get closer to flat list, what is our goal:
(cartesian '(1 2)
(cartesian '(+ -) '(a)))
==> ((2 + . A) (2 - . A) (1 + . A) (1 - . A))
To create proper list, we only need to cons each product with nil - in other words to create another product.
(cartesian '(1 2)
(cartesian '(+ -)
(cartesian '(a) '(nil))))
==> ((2 + A) (2 - A) (1 + A) (1 - A))
Wrapping everything up: you need to create cartesian product of successive lists in reversed order, having last being '(nil), what can be achieved with reduce expression. Final code will look something like this:
(defun cartesian (lst1 lst2)
(let (acc)
(dolist (v1 lst1 acc)
(dolist (v2 lst2)
(push (cons v1 v2) acc)))))
(defun combine-lsts (lsts)
(reduce
#'cartesian
lsts
:from-end t
:initial-value '(nil)))
There is one more way you can try,
(defun mingle (x y)
(let ((temp nil))
(loop for item in x do
(loop for it in y do
(cond ((listp it) (setf temp (cons (append (cons item 'nil) it) temp)))
(t (setf temp (cons (append (cons item 'nil) (cons it 'nil)) temp))))))
temp))
Usage:(mingle '(c d f) (mingle '(1 2 3) '(+ -))) =>
((F 1 +) (F 1 -) (F 2 +) (F 2 -) (F 3 +) (F 3 -) (D 1 +) (D 1 -) (D 2 +)
(D 2 -) (D 3 +) (D 3 -) (C 1 +) (C 1 -) (C 2 +) (C 2 -) (C 3 +) (C 3 -))
Using only the cons command in the Scheme Programming Language, how can one write nested lists such as
'(a b (x y (m)))?
Hint: the car of a cons cell can be a cons cell too.
More particularly, the list you have is written in long form as:
(a . (b . ((x . (y . ((m . ()) . ()))) . ())))
(define a "a")
(define b "b")
(define x "x")
(define y "y")
(define m "m")
(define example (cons a (cons b (cons (cons x (cons y (cons (cons m '()) '()))) '()))))
Resultaat:
example
'("a" "b" ("x" "y" ("m")))