I have this code:
(defparameter fc #\F)
(defparameter bc #\B)
(defparameter gap #\G)
(defun solp (seq)
(if (eql fc (car seq))
(not (if (listp (cdr seq))
(find bc (cdr seq))
(eql seq bc)))
(solp (cdr seq))))
(defun heuristic (seq &optional (f 0))
(if (eql nil seq)
0
(if (eql bc (car seq))
(+ f (heuristic (cdr seq) f))
(heuristic (cdr seq) (+ f 1)))))
(defun genneighbors (seq)
;seq == (fc fc gap bc bc) ===> neighbors == ( (gap fc fc bc bc)
; (fc gap fc bc bc)
; (fc fc bc gap)
; (fc fc bc bc gap) )
;I can't figure out how to do this
)
I can't figure out how to code the genneighbors function. How do I access an element (2 | 1) slots before gap How to generate all four possible neighbors? Can someone give me some pointers?
All the functions from the CLHS chapters conses and sequences apply to lists.
Also note that it is good programming style (for various reasons) to name global variables like this: *bc*, *fc* and *gap*.
Also note that in newer code one often uses FIRST instead of CAR and REST instead of CDR.
Related
Preface
I am working on implementing the Genetic Algorithm for the Traveling Salesman problem. I am making some base line assumption such as you can travel to any city from any city. While this is for an assignment, I have extended this to a personal project as the deadline is past and I have chosen to use Lisp which definitely was not required. The point of encoding my data in this way listed below is to easily perform cross-over later in the algorithm.
Problem
Suppose you have a list of cities, given similar to the following
(defvar *data* (list
'(A 20 10)
'(B 5 16)
'(C 12 18)
'(D x y)
'(E x y)
...
I want to encode this data in a way similar to this:
and I for the life of me cannot figure out how to implement this in Lisp. If anyone has some insight, it would be much appreciated. If there is a better way to create my *data* set that would make this easier feel free to include it!
Now I understood it. Here is the solution:
(defparameter *data* (list
'(A 20 10)
'(B 5 16)
'(C 12 18)
'(D x y)
'(E x y)))
For one step you need a function which looks up index position of the city in the city-list (*data*) and also removes its entry in the city-list and returns the updated city-list.
(defun choose-city (city-list city-name)
"Return city-name with its index position
and city-list with the chosen city removed, keeping the order."
(let* ((cities (mapcar #'car city-list))
(pos (position city-name cities)))
(list city-name
pos
(append (subseq city-list 0 pos)
(subseq city-list (+ pos 1) (length city-list))))))
;; improved version by #Kaz - thanks! (lispier)
(defun choose-city (city-list city-name)
(list city-name
(positiion city-name city-list :key #'car :test #'eql)
(remove city-name city-list :key #'car :test #'eql)))
Then, you need a function which applies the previous function
over and over again while collecting the index positions and updates from step to step the city-list by removing the matched current-city in the city-sequence.
A typical pattern occuring in lisp for this is
to define the to-be-mutated variable as a local variable in a let expression and from the body of the let-expression to update the variable value using setf (setf-ing).
(defun choose-cities-subsequently (city-list city-sequence)
"Return sequence of subsequent-index-positions of the cities
given in city-sequence. After choosing a sequence, the city is
removed from the city-list and its index position of the previous
pool taken for record."
(let ((index-positions '()) ; initiate collector variable
(current-city-list city-list)) ; current state of city-list
(loop for current-city in city-sequence
do (progn
;; call `choose-city` and capture its results
(destructuring-bind
(name index new-city-list) ; capturing vars
;; and in the following the function call:
(choose-city current-city-list current-city)
;; update collector variable and
;; current-city-list using the captured values
(setf index-positions (cons index index-positions))
(setf current-city-list new-city-list)))
;; if city-sequence processed in this way,
;; return the collected index-positions.
;; remark: cons-ing during collecting and
;; at the end nreverse-ing the result
;; when/while returning
;; is a very typical lisp idiom
finally (return (nreverse index-positions)))))
;; improved version by #Kaz - thanks!
(defun choose-cities-subsequently (city-list city-sequence)
(let ((index-positions '()) ; initiate collector variable
(current-city-list city-list)) ; current state of city-list
(loop for current-city in city-sequence
collect (destructuring-bind
(name index new-city-list)
(choose-city current-city-list current-city)
(setf current-city-list new-city-list)
index)
into index-positions
finally (return index-positions)))))
Now, if you run
(choose-cities-subsequently *data* '(A D E B C))
it returns correctly:
(0 2 2 0 0)
By defining more let-variables in the last function and
setf-fing to those in the destructuring-bind expression's body, and returning the final value in the final list,
you can collect more informations and make them visibile.
Tried to simplify a little and recursive definition
(defparameter *data* (list
'(A 20 10)
'(B 5 16)
'(C 12 18)
'(D x y)
'(E x y)))
(defun choose-city (city-list city-name)
(list (position city-name city-list :key #'car :test #'eql)
(remove city-name city-list :key #'car :test #'eql)))
;; when city names are strings use `:test #'string=
(defun choose-cities-subsequently (city-list city-sequence)
(let ((current-cities city-list))
(loop for current-city in city-sequence
for (idx updated-cities) = (choose-city current-cities current-city)
collect (progn (setf current-cities updated-cities)
idx)
into index-positions
finally (return index-positions))))
(choose-cities-subsequently *cities* '(A D E B C))
;; (0 2 2 0 0)
;; a tail-call recursive version:
(defun choose-cities-subsequently (cities city-sequence
&key (acc-cities '())
(acc-positions '())
(pos-counter 0)
(test #'eql))
(cond ((or (null city-sequence) (null cities)) (nreverse acc-positions))
((funcall test (car city-sequence) (car cities))
(choose-cities-subsequently (append (nreverse acc-cities) (cdr cities))
(cdr city-sequence)
:acc-cities '()
:acc-positions (cons pos-counter acc-positions)
:pos-counter 0
:test test))
(t (choose-cities-subsequently (cdr cities)
city-sequence
:acc-cities (cons (car cities) acc-cities)
:acc-positions acc-positions
:pos-counter (1+ pos-counter)
:test test))))
Hello i am trying to create a function in common-lisp that takes two lists, and output their intersections, assuming there is no repetition in each list without using intersection function. It seems that it is not working. Can anyone help?
(defun isect (lst_1 lst_2)
(setq newlist nil)
(dolist (x lst_1 newlist)
(dolist (y lst_2)
(if (equal x y) (setf newlist (append newlist x)))
)
)
)
I assume isect with both arguments being the same list should return an equal list and not one that is flattened. In that case (append newlist x) is not adding an element to the end of a list. Here is my suggestion:
(defun intersect (lst-a lst-b &aux result)
(dolist (a lst-a (nreverse result))
(dolist (b lst-b)
(when (equal a b)
(push a result)))))
This is O(n^2) while you can do it in O(n) using a hash table.
A built-in way (that won't work for homeworks ;) ) is to use intersection: https://lispcookbook.github.io/cl-cookbook/data-structures.html#intersection-of-lists
What elements are both in list-a and list-b ?
(defparameter list-a '(0 1 2 3))
(defparameter list-b '(0 2 4))
(intersection list-a list-b)
;; => (2 0)
If you can ensure that the lists are sorted (ascending) you could do something like
(defun isect (l1 l2 acc)
(let ((f1 (car l1))
(f2 (car l2))
(r1 (cdr l1))
(r2 (cdr l2)))
(cond ((or (null l1) (null l2)) acc)
((= f1 f2) (isect r1 r2 (cons f1 acc)))
((< f1 f2) (isect r1 l2 acc))
((> f1 f2) (isect l1 r2 acc)))))
Note though, that the result is in reversed order. Also, the example assumes that the
elements are numbers. If you wanted to generalize, you could pass an ordering as an optional argument to make it work with arbitrary elements.
NB: A solution using loop would likely be faster but I could not think of how to partially "advance" the lists when the cars are different.
;; the key function for simple lists
(defun id (x) x)
;; the intersect function for two lists
;; with sorting included:
;; you need an equality-test:
;; default is #'eql (for simple numbers or symbols this is sufficient)
;; - for numbers only #'=
;; - for characters only #'char=
;; - for strings only #'string=
;; - for lists #'equal
;; - for nearly everything #'equalp (case insensitive for char/strings!)
;; then you need also a sorting tester:
;; - increasing number: #'<
;; - decreasing number: #'>
;; - increasing char: #'char<
;; - decreasing char: #'char>
;; - increasing strings: #'string<
;; - decreasing strings: #'string>
;; - other cases I haven't think of - does somebody have an idea?
;; (one could sort by length of element etc.)
;; so sort-test should be a diadic function (function taking 2 arguments to compare)
;; then you also need an accessor function
;; so, how withing each element the to-be-sorted element should be accessed
;; for this, I prepared the `id` - identity - function because this is the
;; sort-key when simple comparison of the elements of the two lists
;; should be compared - and this function is also used for testing
;; for equality in the inner `.isect` function.
(defun isect (lst-1 lst-2 &key (equality-test #'eql) (sort-test #'<) (sort-key #'id))
(let ((lst-1-sorted (stable-sort lst-1 sort-test :key sort-key))
(lst-2-sorted (stable-sort lst-2 sort-test :key sort-key)))
(labels ((.isect (l1 l2 acc)
(cond ((or (null l1) (null l2)) (nreverse acc))
(t (let ((l1-element (funcall sort-key (car l1)))
(l2-element (funcall sort-key (car l2))))
(cond ((funcall sort-test l1-element l2-element)
(.isect (cdr l1) l2 acc))
((funcall equality-test l1-element l2-element)
(.isect (cdr l1) (cdr l2) (cons (car l1) acc)))
(t (.isect l1 (cdr l2) acc))))))))
(.isect lst-1-sorted lst-2-sorted '()))))
Simple tests:
(isect '(0 1 2 3 4 5 6) '(9 0 3 5 12 24 8 6))
;; => (0 3 5 6)
(isect '(#\a #\c #\h #\t #\e #\r #\b #\a #\h #\n)
'(#\a #\m #\s #\e #\l #\s #\t #\a #\r)
:equality-test #'char=
:sort-test #'char<
:key #'id)
;; => (#\a #\a #\e #\r #\t)
(isect '("this" "is" "just" "a" "boring" "test")
'("this" "boring" "strings" "are" "to" "be" "intersected")
:equality-test #'string=
:sort-test #'string<
:key #'id)
;; => ("boring" "this")
I have this example in LISP that removes from every level of a list a given number:
(defun remove_aux (e l)
(cond
((equal e l) nil)
((atom l) (list l))
(t(list(apply 'append (mapcar #'(lambda (l) (remove_aux e l)) l))))))
(defun remove_el (e l)
(car (remove_aux e l)))
So, if it run like this: (remove_el 2 '(1 2 3 ((2 3 2) 4))) => (1 3 ((3) 4))
What I don't exactly understand is how this line works: (t(list(apply 'append (mapcar #'(lambda (l) (sterge_aux e l)) l))))
If I have the line without list and append ((t(mapcar #'(lambda (l) (remove_aux e l)) l))) the result is ((1) NIL (3) ((NIL (3) NIL) (4)))) if it has append but not list ( (t(apply 'append (mapcar #'(lambda (l) (remove_aux e l)) l))) ) then the result is (1 3 3 4) and I don't get why because I did (apply 'append '((1) NIL (3) ((NIL (3) NIL) (4))))) in the Common Lisp console and the result was ((1 3 (NIL (3) NIL) (4))) so I'm really confused. Can somebody explain to me how this all works step by step?
I've annotated the code below to, I hope, explain what's going on. You're probably getting confused because l is getting redefined within a lambda... so the t line (in your example) has 2 "l"s on it but the first one isn't the same as the second one.
(defun remove_aux (e l)
(cond
((equal e l) nil) ;if e equals l return nil
((atom l) (list l)) ;if l is an atom return a list with just l in it
(t ; otherwise...
(list ;create a list
(apply 'append ; whose contents are created by appending
; together the lists that come out of this mapcar
; (apply the append method)
(mapcar #'(lambda (l) ( ; iterate over each of the elements in list l
; the one after the lambda not the one
; being passed to the lambda.
; (this is a horrible name choice
; lambda(l-item) would be much better)
remove_aux e l
; recursively call this method
; with e (which was passed in at the start)
; and l which isn't the l passed in,
; but is an entry of it (see why naming's
; so important?)
; this returns a list
; which will get appended by the append
; with the results of all the other calls
; to remove_aux for each item in the outer l
)
) l)
)))))
(defun remove_el (e l)
(car (remove_aux e l)
)
)
;; append elements of each list in argument together
(append '(a) '(b) '(c d) '(e)) ; ==> (a b c d e)
;; append elements of each sublist in argument
(apply #'append '((a) (b) (c d) (e))) ; ==> (a b c d e)
;; apply function on each element of list into new list
(mapcar #'(lambda (x) (+ x 1)) '(1 3 5 6)) ; ==> (2 4 6 7)
So what does the default case do in your function.. Well it applies itself to each sublist of lst and wrap it in a list so if l is '(a y 2 z) and e is 2, well then the result from mapcar is '((a) (y) () (z)) which is then the argument to apply-append which connects the elements together into one list again. When connecting the lists the element that was to be removed is an empty list and it's effectively ignored in the concatenation process.
Since all the lists appended you create in the helper, you could replace the apply-append with (mapcan #'(lambda (l) (remove_aux e l)) l). A more obvious way to do this would be using reduce while a more efficient way might use loop.
A procedure that achieve what you want to achieve is essentially like below procedure:
(defun remove-all (e l)"Removes all occurrences of e from a list l."
(cond
((null l) '())
((equal e (car l)) (remove-all e (cdr l)))
((not (atom (car l)))
(cons (remove-all e (car l))
(remove-all e (cdr l))))
(t (cons (car l)
(remove-all e (cdr l))))))
;note: the e is not neccessarily an atom, the l is not necessarily a list of atoms.
The procedure in your question has unnecessarily cluttered pieces, like append, maps etc.
if you recomment below i will explain the algorithm.
have a nice hack.
I would like to write a function that reverses the elements of a list, but it should happen in place (that is, don't create a new reversed list).
Something like:
>> (setq l ' (a b c d))
((a b c d)
>> (rev l)
(d c b a)
>> l
(d c b a)
What flags should I follow to achieve this?
Have a look at nreverse which will modify the list in place (see HyperSpec).
As per the comments, do note the comments that #Barmar made and this bit from the spec:
For nreverse, sequence might be destroyed and re-used to produce the result. The result might or might not be identical to sequence. Specifically, when sequence is a list, nreverse is permitted to setf any part, car or cdr, of any cons that is part of the list structure of sequence.
It's not difficult to implement this (ignoring fault cases). The keys are to use (setf cdr) to reuse a given cons cell and not to lose the reference to the prior cdr.
(defun nreverse2 (list)
(recurse reving ((list list) (rslt '()))
(if (not (consp list))
rslt
(let ((rest (cdr list)))
(setf (cdr list) rslt)
(reving rest list)))))
(defmacro recurse (name args &rest body)
`(labels ((,name ,(mapcar #'car args) ,#body))
(,name ,#(mapcar #'cadr args))))
[edit] As mentioned in a comment, to do this truly in-place (and w/o regard to consing):
(defun reverse-in-place (l)
(let ((result l))
(recurse reving ((l l) (r (reverse l))
(cond ((not (consp l)) result)
(else (setf (car l) (car r))
(reving (cdr l) (cdr r)))))))
> (defvar l '(1 2 3))
> (reverse-in-place l))
(3 2 1)
> l
(3 2 1)
Is it possible to implement set-car! and set-cdr! portably as macros using set! in Scheme? Or would this require special access to the underlying storage system?
I'm asking because I'm implementing my own Scheme interpreter, and I'd like to have as much as possible out in scheme code.
My first attempt on set-cdr! was:
(define-syntax set-cdr!
(syntax-rules ()
((set-cdr! location value)
(set! location (cons (car location) value)))))
This mostly works, but not for circular lists:
#; mickey> (define x (list 1 2))
#; mickey> x
(1 2)
#; mickey> (set-cdr! x x)
#; mickey> x
(1 1 2)
Wrapping the macro body in let did not help me either, because when I do (set! (cons (car location) value), then value has already been evaluated to be '(1 2).
In
(set! location (cons (car location) value))
the expression (cons (car location) value) allocates a new pair.
The purpose of set-cdr! is to mutate an existing pair.
So implementing set-cdr! does require "special" access to the underlying storage.
Here is an example of implementing Cons, Car, Cdr, Set-car! and Set-cdr! using closures.
(define (Cons x y)
(lambda (message . val)
(cond
[(eq? message 'car) x]
[(eq? message 'cdr) y]
[(eq? message 'set-car!)
(set! x (car val))]
[(eq? message 'set-cdr!)
(set! y (car val))]
[else 'unknown-message])))
(define (Car pair)
(pair 'car))
(define (Cdr pair)
(pair 'cdr))
(define (Set-cdr! pair val)
(pair 'set-cdr! val))
(define (Set-car! pair val)
(pair 'set-car! val))
(define p (Cons 1 2))
(Car p)
(Cdr p)
(Set-car! p 3)
(Car p)
(Set-cdr! p 4)
(Cdr p)
Basically you can implement set! without set!, but I don't think you can implement set-car!/set-cdr! without either mutating pairs or simulating pairs (like soegaard's example)
Since it seems you're making your Scheme implementation in Scheme I would have used set-car!/set-cdr! to implement it in the interpreter or just not implemented them at all. I would have started with define, if, quote, pair?, eq?, cons, car and cdr (similar to The roots of LISP, but more schemish) to have a base minimum implementation to start with and then enhanced it further.
Anyway.. Your implementation, if you do implement it should be able to do this:
(define odds (list 1 3 5 7 9 11))
(set-car! (cddr odds) #f)
odds
===> (1 3 #f 7 9 11)