What is the difference between the following solutions (a setf function and a function)? Is one of them preferable, or are they only two ways to get the same result?
(defparameter *some-array* (make-array 10))
(defun (setf arr-index) (new-value index-string)
(setf (aref *some-array* (parse-integer index-string)) new-value))
(defun arr-index-1 (index-string new-value )
(setf (aref *some-array* (parse-integer index-string)) new-value))
CL-USER> *some-array*
#(0 0 0 0 0 0 0 0 0 0)
CL-USER> (setf (arr-index "2") 7)
7
CL-USER> (arr-index-1 "3" 5)
5
CL-USER> *some-array*
#(0 0 7 5 0 0 0 0 0 0)
Thank you for your answers.
The setf function works as a place (aka. generalized reference). This means it can be used with modify macros such as INCF or ROTATEF. You do also have to write a corresponding getter function for them to work though.
(defparameter *some-array* (make-array 10))
(defun arr-index (index-string)
(aref *some-array* (parse-integer index-string)))
(defun (setf arr-index) (new-value index-string)
(setf (aref *some-array* (parse-integer index-string)) new-value))
CL-USER> (setf (arr-index "3") 10)
10
CL-USER> (incf (arr-index "3"))
11
CL-USER> (incf (arr-index "3"))
12
CL-USER> (rotatef (arr-index "3")
(arr-index "6"))
NIL
CL-USER> (incf (arr-index "3") 100)
100
CL-USER> *some-array*
#(0 0 0 100 0 0 12 0 0 0)
A setf function is generally preferred unless you are, for some reason, making a stylistic choice not to use setf or modify macros.
Related
I'm trying to write a recursive function to check if the elements of a list are increasing consecutively.
(defun test (lst)
(if (null lst)
1
(if (= (car lst) (1- (test (cdr lst))))
1
0)))
(setq consecutive '(1 2 3 4))
(setq non-consecutive '(2 5 3 6))
The results are:
CL-USER> (test non-consecutive)
0
CL-USER> (test consecutive)
0
(test consecutive) should return 1. How can I write this function correctly?
To check that the numbers in the sequence are consecutive, i.e.,
increasing with step 1, you need this:
(defun list-consecutive-p (list)
(or (null (cdr list))
(and (= 1 (- (second list) (first list)))
(list-consecutive-p (rest list)))))
Then
(list-consecutive-p '(1 2 3 4))
==> T
(list-consecutive-p '(1 4))
==> NIL
(list-consecutive-p '(4 1))
==> NIL
NB. Numbers are a poor substitute for booleans.
PS. I wonder if this is related to How to check if all numbers in a list are steadily increasing?...
my task is to count all element within a list, which have duplicates, eg
( 2 2 (3 3) 4 (3)) will result in 2 (because only 2 and 3 have duplicates)
Searchdeep - just returns a nill if WHAT isn't find in list WHERE
Count2 - go through the single elements and sub-lists
If it finds atom he will use SEARCHDEEP to figure out does it have duplicates, then list OUT will be checked (to make sure if this atom was not already counted (e.g. like ( 3 3 3), which should return 1, not 2)
, increase counter and add atom to the OUT list.
However, i don't understand why, but it constantly returns only 1. I think it is some kind of logical mistake or wrong use of function.
My code is:
(SETQ OUT NIL)
(SETQ X (LIST 2 -3 (LIST 4 3 0 2) (LIST 4 -4) (LIST 2 (LIST 2 0 2))-5))
(SETQ count 0)
(DEFUN SEARCHDEEP (WHAT WHERE) (COND
((NULL WHERE) NIL)
(T (OR
(COND
((ATOM (CAR WHERE)) (EQUAL WHAT (CAR WHERE)))
(T (SEARCHDEEP WHAT (CAR WHERE)))
)
(SEARCHDEEP WHAT (CDR WHERE))
)
)
)
)
(DEFUN Count2 ( input)
(print input)
(COND
((NULL input) NIL)
(T
(or
(COND
((ATOM (CAR input))
(COND
(
(and ;if
(SEARCHDEEP (CAR INPUT) (CDR INPUT))
(NOT (SEARCHDEEP (CAR INPUT) OUT))
)
(and ;do
(Setq Count (+ count 1))
(SETQ OUT (append OUT (LIST (CAR INPUT))))
(Count2 (CDR input))
)
)
(t (Count2 (CDR input)))
)
)
(T (Count2 (CAR input)))
)
(Count2 (CDR input))
)
)
)
)
(Count2 x)
(print count)
First, your code has some big style issues. Don't write in uppercase (some, like myself, like to write symbols in uppercase in comments and in text outside of code, but the code itself should be written in lowercase), and don't put parentheses on their own lines. So the SEARCHDEEP function should look more like
(defun search-deep (what where)
(cond ((null where) nil)
(t (or (cond ((atom (car where)) (equal what (car where)))
(t (searchdeep what (car where))))
(searchdeep what (cdr where))))))
You also should not use SETQ to define variables. Use DEFPARAMETER or DEFVAR instead, although in this case you should not use global variables in the first place. You should name global variables with asterisks around the name (*X* instead of x, but use a more descriptive name).
For the problem itself, I would start by writing a function to traverse a tree.
(defun traverse-tree (function tree)
"Traverse TREE, calling FUNCTION on every atom."
(typecase tree
(atom (funcall function tree))
(list (dolist (item tree)
(traverse-tree function item))))
(values))
Notice that TYPECASE is more readable than COND in this case. You should also use the mapping or looping constructs provided by the language instead of writing recursive loops yourself. The (values) at the end says that the function will not return anything.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(traverse-tree (lambda (item)
(format t "~a " item))
tree))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
; No values
If you were traversing trees a lot, you could hide that function behind a DO-TREE macro
(defmacro do-tree ((var tree &optional result) &body body)
`(progn (traverse-tree (lambda (,var)
,#body)
,tree)
,result))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(do-tree (item tree)
(format t "~a " item)))
; 2 -3 4 3 0 2 4 -4 2 2 0 2 -5
;=> NIL
Using this, we can write a function that counts every element in the tree, returning an alist. I'll use a hash table to keep track of the counts. If you're only interested in counting numbers that will stay in a small range, you might want to use a vector instead.
(defun tree-count-elements (tree &key (test 'eql))
"Count each item in TREE. Returns an alist in
form ((item1 . count1) ... (itemn . countn))"
(let ((table (make-hash-table :test test)))
(do-tree (item tree)
(incf (gethash item table 0)))
(loop for value being the hash-value in table using (hash-key key)
collect (cons key value))))
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(tree-count-elements tree))
;=> ((2 . 5) (-3 . 1) (4 . 2) (3 . 1) (0 . 2) (-4 . 1) (-5 . 1))
The function takes a keyword argument for the TEST to use with the hash table. For numbers or characters, EQL works.
Now you can use the standard COUNT-IF-function to count the elements that occur more than once.
(let ((tree '(2 -3 (4 3 0 2) (4 -4) (2 (2 0 2)) -5)))
(count-if (lambda (item)
(> item 1))
(tree-count-elements tree)
:key #'cdr))
;=> 3
I am creating a heuristic function and it returns what it is supposed to but also there is a stack overflow problem and I can't understand where is the problem. Here is the code of the functions i created:
(defun nextPositions (position)
(let*((listaPosAdjacentes)
(positionFinal position)
(listaFinal NIL))
(setf listaPosAdjacentes (possible-actions2))
(dolist (posAdjacente listaPosAdjacentes)
(setf positionFinal position)
(setf positionFinal (list (+ (nth 0 positionFinal) (nth 0 posAdjacente))
(+ (nth 1 positionFinal) (nth 1 posAdjacente))))
(push positionFinal listaFinal))
listaFinal))
(defun push-unique (element lista)
(let ((auxlist lista))
(dolist (i lista)
(if (and (equal (nth 0 i) (nth 0 element)) (equal (nth 1 i) (nth 1 element)))
(return-from push-unique auxlist)))
(push element auxlist)
auxlist))
(defun recursive (track1 positionslist distance track)
(let ((NextValidPositions NIL))
(dolist (position positionslist)
(if (equal (track-startpos track) position)
(return-from recursive track1)
(progn (dolist (i (nextPositions position))
(if (equal (nth (nth 1 i) (nth (nth 0 i) track1)) T)
(progn
(setf NextValidPositions (push-unique i NextValidPositions))
(setf (nth (nth 1 i) (nth (nth 0 i) track1)) (+ 1 distance))))))))
(recursive track1 NextValidPositions (+ 1 distance) track)))
(defun compute-heuristic(st)
(let* ((track (state-track st))
(distance 0)
(track1Final nil)
(track1heuristica (track-env track)))
(dolist (position (track-endpositions track))
(setf (nth (nth 1 position) (nth (nth 0 position) track1heuristica)) distance))
(setf track1Final (recursive track1heuristica (track-endpositions track) distance track))
(print track1Final)
(return-from compute-heuristic track1Final)))
The result is the following:
The list it returns is what it is supposed to return but I can't understand the stack overflow problem.
The code is called like this:
(format t "~&Exercise 3.1 - Heuristic~&")
(with-open-file (str "out3.1.txt"
:direction :input)
(format t "~% Solution is correct? ~a~&" (equal (list (compute-heuristic (initial-state *t1*)) (compute-heuristic (make-state :pos '(1 6) :track track)) (compute-heuristic (make-state :pos '(2 8) :track track))) (read str))))
It is a local test and this code was provided by our professor to test our code and that's why I think the problem is not there.
Any ideas what the problem might be?
Thanks.
About style:
Generally the code is not well written, since it uses too many control structures and variables which are not really needed.
Example:
(defun push-unique (element lista)
(let ((auxlist lista))
(dolist (i lista)
(if (and (equal (nth 0 i)
(nth 0 element))
(equal (nth 1 i)
(nth 1 element)))
(return-from push-unique auxlist)))
(push element auxlist)
auxlist))
unnecessary variable auxlist
no dolist needed, use member
no return-from needed, just return the value. In many case the use of return-from is a code smell, indicating too complicated code.
no push needed, just return the result of cons
Better:
(defun push-unique (element list)
(if (member element list
:test (lambda (a b)
(and (equal (first a) (first b))
(equal (second a) (second b)))))
list
(cons element list)))
The functionality exists already
The function push-unique exists already in standard Common Lisp. It is called adjoin:
CL-USER 34 > (adjoin 1 '(2 3 4 1 3))
(2 3 4 1 3)
CL-USER 35 > (adjoin 1 '(2 3 4 3))
(1 2 3 4 3)
Just pass the right test function for your purpose...
(defun push-unique (element list)
(adjoin element list
:test (lambda (a b)
(and (equal (first a) (first b))
(equal (second a) (second b))))))
Comments & documentation
Probably it's also a good idea to write comments and documentation.
Otherwise one has to guess/infer what the purpose of these functions is.
I'm having a problem transforming a vector like this:
#(#(1 2 3)#(1 2 3)#(1 2 3)#(1 2 3)#(1 2 3)))
Into one like this:
#(#(1 1 1 1 1) #(2 2 2 2 2) #(3 3 3 3 3))
I wrote a piece of test code but the output is wrong. I went into the debugger and I think I know which line of code cause the problem. I can't seems to find a way to make it work. Any help is greatly appreciated.
(define (test)
(let* ((table #(#(1 2 3)#(1 2 3)#(1 2 3)#(1 2 3)#(1 2 3)))
(counter 5)
(size 3)
(new-table (make-vector size (make-vector counter #f))))
(let loop ((sc 0)
(cc 0))
(when (not (= cc counter))
(if (not (= sc size))
(begin (vector-set! (vector-ref new-table sc) cc (vector-ref (vector-ref table cc) sc))
(loop (+ 1 sc) cc))
(loop 0 (+ 1 cc)))))
(display new-table)))
> (test)
#(#(3 3 3 3 3) #(3 3 3 3 3) #(3 3 3 3 3))
You can also use vector-map to get the desired output:
(define table #(#(1 2 3) #(1 2 3) #(1 2 3) #(1 2 3) #(1 2 3)))
(apply vector-map vector (vector->list table))
There's a problem in this part:
(make-vector size (make-vector counter #f))
Why? because you're copying the exact same vector in all off new-table's positions, so whenever you update one value, it'll change all of them at the same time. It's easy to see this:
(define new-table (make-vector 3 (make-vector 3 #f)))
(vector-set! (vector-ref new-table 0) 0 42) ; we modify a single position ...
new-table
=> '#(#(42 #f #f) #(42 #f #f) #(42 #f #f)) ; ... but all of them changed!
You have to initialize the vector at the beginning; a fixed version of your code would look like this:
(let* ((table '#(#(1 2 3) #(1 2 3) #(1 2 3) #(1 2 3) #(1 2 3)))
(counter (vector-length table))
(size (vector-length (vector-ref table 0)))
(new-table (make-vector size)))
; initialization
(let loop ((i 0))
(when (< i size)
(vector-set! new-table i (make-vector counter))
(loop (+ i 1))))
(let loop ((sc 0)
(cc 0))
(when (not (= cc counter))
(if (not (= sc size))
(begin
(vector-set! (vector-ref new-table sc) cc
(vector-ref (vector-ref table cc) sc))
(loop (+ 1 sc) cc))
(loop 0 (+ 1 cc))))
new-table))
However, the above solution is hard to understand. Fortunately, this seems like a good problem to use Racket's Iterations and Comprehensions, so you don't have to worry about explicitly using recursion for iteration, leading to a much clearer solution:
(let* ((table '#(#(1 2 3) #(1 2 3) #(1 2 3) #(1 2 3) #(1 2 3)))
(counter (vector-length table))
(size (vector-length (vector-ref table 0)))
(new-table (make-vector size)))
(for ([sc (in-range size)])
(vector-set! new-table sc (make-vector counter)) ; initialization
(for ([cc (in-range counter)])
(vector-set! (vector-ref new-table sc) cc
(vector-ref (vector-ref table cc) sc))))
new-table)
Either way, the output is as expected:
=> '#(#(1 1 1 1 1) #(2 2 2 2 2) #(3 3 3 3 3))
Note: As it is, this is a procedural programming-style solution, which modifies the new vectors in-place and has the advantage of being fast and efficient (it doesn't create more vectors or lists beyond the strictly necessary), but truth be told, this is not the usual way to solve problems in Scheme. For a functional programming-style solution, more in the spirit of Scheme, see #Ankur's answer.
I need a function that concatenates multiple values into (simple) vector, similar to (concatenate ). However, unlike concatenate, it should be able to handle arguments that are not vectors or sequences.
I.e. it should work like this:
(concat #(1 2) 3) => #(1 2 3)
(concat 1 2 3) => #(1 2 3)
(concat 1 #(2 3 4)) => #(1 2 3 4)
(concat #(1 2) 2 #(3 4 5)) => #(1 2 3 4 5)
How can I do this? I think I've forgotten some trivial lisp construct that makes it possible.
As far as I can tell, concatenate can't do it. and I'm not quite sure how to use make it with macro (there's ,# consturct that inserts list into resulting lisp form, but but I'm not quite sure how to distinguish between non-sequences and sequences in this case).
The reduce approach in the other reply is quadratic in time.
Here is a linear solution:
(defun my-concatenate (type &rest args)
(apply #'concatenate type
(mapcar (lambda (a) (if (typep a 'sequence) a (list a)))
args)))
Since we can compute the length of the sequence, we can allocate the result sequence and then copy the elements into it.
(defun concat (type &rest items)
(let* ((len (loop for e in items
if (typep e 'sequence)
sum (length e)
else sum 1))
(seq (make-sequence type len)))
(loop with pos = 0
for e in items
if (typep e 'sequence)
do (progn
(setf (subseq seq pos) e)
(incf pos (length e)))
else
do (progn
(setf (elt seq pos) e)
(incf pos)))
seq))
CL-USER 17 > (concat 'string "abc" #\1 "def" #\2)
"abc1def2"
Above works well for vectors. A version for lists is left as an exercise.
defun my-concatenate (type &rest vectors)
(reduce (lambda (a b)
(concatenate
type
(if (typep a 'sequence) a (list a))
(if (typep b 'sequence) b (list b))))
vectors))
You can use reduce with a little modification of #'concatenate on your arguments. If one of the arguments is not a sequence, just transform it into a list (concatenate works even with mixed arguments of simple-vectors and lists).
CL-USER> (my-concatenate 'list #(1 2 3) 3 #(3 5))
(1 2 3 3 3 5)
CL-USER> (my-concatenate 'simple-vector #(1 2 3) 3 #(3 5))
#(1 2 3 3 3 5)
CL-USER> (my-concatenate 'simple-vector 1 #(2 3) (list 4 5))
#(1 2 3 4 5)
EDIT: well, you should probably accept the other answer.