I am a complete newbie with Lisp so go easy on me. Im trying to implement a binary search tree into an array and be able to output it in order.
I have this array where index 1 is the root and 2*i is the left child, 2*i + 1 is the right child:
#(NIL 30 15 50 10 20 NIL 70 3 NIL 17 NIL NIL NIL NIL 80 NIL NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
NIL NIL NIL)
And Im sending it to this function to extract the in order output from the tree:
(defun inOrder (tree rootIndex)
(setq leftI (* rootIndex 2))
(setq rightI (+ leftI 1))
(if (aref tree leftI)
(inOrder tree leftI))
(format t "~D," (aref tree rootIndex))
(if (aref tree rightI)
(inOrder tree rightI)))
The expected output should be 3,10,15,17,20,30,50,70,80, but I get 3,10,15,30.
It appears that the code after the format is not getting executed. If anyone can help me that would be greatly appreciated.
You are using leftI and rightI as absolute variables, so the recursion does not work as intended. Instead, define them as local variables with a let* :
(defun inOrder (tree rootIndex)
(let* ((leftI (* rootIndex 2))
(rightI (+ leftI 1)))
(if (aref tree leftI)
(inOrder tree leftI))
(format t "~D," (aref tree rootIndex))
(if (aref tree rightI)
(inOrder tree rightI))))
Related
I'm trying to define a type for Boolean simple-arrays. This should be easy enough:
(deftype boolean-vector (&optional (length '*))
"Simple vector of BOOLEAN elements."
`(simple-array boolean (,length)))
yet:
CL-USER> (typep #(nil nil t t t) 'boolean-vector)
T
CL-USER> (typep #(nil nil t t 5) 'boolean-vector)
T
CL-USER> (typep 5 'boolean)
NIL
Anyone have any ideas why this deftype isn't doing what it's supposed to and how to properly define a vector type that contains only elements of type boolean?
Answer
Two good explanations appear below. What I ended up doing:
(defun boolean? (object)
"Check type of OBJECT is BOOLEAN."
(typep object 'boolean))
(defun boolean-sequence-p (x)
(every #'boolean? x))
(deftype simple-boolean-vector (&optional (length '*))
"Vector of BOOLEAN elements."
`(and (simple-array * (,length))
(satisfies boolean-sequence-p)))
deftype is doing what it is supposed to do, but
> (upgraded-array-element-type 'boolean)
t
In other words there is no specialised array type which can hold only t and nil: you can't have an array which can hold only booleans in your implementation. Of course it is possible that an implementation could support such a thing but I think it would be extraordinarily unlikely.
If you want an array type which can hold only true or false values then you probably want bit-vectors which are required to exist, with some wrappers. For instance:
(deftype array-index ()
`(integer 0 (,array-dimension-limit)))
(defun make-boolean-vector (n &key (initial-element nil))
(declare (type array-index n)
(type boolean initial-element))
(make-array (list n) :element-type 'bit :initial-element (if initial-element 1 0)))
(declaim (inline bref (setf bref)))
(defun bref (v n)
(declare (type bit-vector v)
(type array-index n))
(= (bit v n) 1 t nil))
(defun (setf bref) (b v n)
(declare (type bit-vector v)
(type array-index n)
(type boolean b))
(setf (bit v n) (if b 1 0))
b)
Try this:
(defun bool-array (a)
(and (simple-array-p a)
(every (lambda (e) (typep e 'boolean)) a)))
(deftype boolean-vector ()
`(satisfies bool-array))
Test:
> (typep #(nil nil t t t) 'boolean-vector)
T
> (typep #(nil nil t t 5) 'boolean-vector)
NIL
> (typep 5 'boolean-vector)
NIL
I'm trying to do a recursive version of the function position called positionRec. The objective is define the position of an element in a list, and if the element is not in the list return "nil". For exemple:
(positionRec 'a '(b c d a e)) => 4
(positionRec 'a '(b c d e)) => nil
I have written:
(defun positionRec (c l)
(cond
((atom l) (return nil))
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l)))) ) )
I don't succeed to return nil. I have an error "*** - return-from: no block named nil is currently visible"
Anyone can teach me how to do it?
Lisp is an expression language: it has only expressions an no statemends. This means that the value of a call to a function is simply the value of the last form involved in that call This is different than many languages which have both statements and expressions and where you have to explicitly litter your code with explicit returns to say what the value of a function call is.
A cond form in turn is an expression. The value of an expression like
(cond
(<test1> <test1-form1> ... <test1-formn>)
(<test2> <test1-form1> ... <test1-formn>)
...
(<testn> <testn-form1> ... <testn-formnn>))
is the <testm-formn> of the first <testm> which is true, or nil if none of them are (and as a special case, if there are no forms after a test which is true the value is the value of that test).
So in your code you just need to make sure that the last form in the test which succeeds is the value you want:
(defun positionRec (c l)
(cond
((atom l) nil)
((equal c (first l)) 1)
(t (+ 1 (positionRec c (rest l))))))
So, what use is return? Well, sometimes you really do want to say 'OK, in the middle of some complicated loop or something, and I'm done now':
(defun complicated-search (...)
(dolist (...)
(dolist (...)
(dotimes (...)
(when <found-the-interesting-thing>
(return-from complicated-search ...))))))
return itself is simply equivalent to (return-from nil ...) and various constructs wrap blocks named nil around their bodies. Two such, in fact, are dotimes and dolist, so if you want to escape from a big loop early you can do that:
(defun complicated-search (...)
(dolist (...)
(when ...
(return 3)))) ;same as (return-from nil 3)
But in general because Lisp is an expression language you need to use return / return-from much less often than you do in some other languages.
In your case, the modified function is going to fail: if you get to the ((atom l) nil) case, then it will return nil to its parent which will ... try to add 1 to that. A better approach is to keep count of where you are:
(defun position-of (c l)
(position-of-loop c l 1))
(defun position-of-loop (c l p)
(cond
((atom l) nil)
((equal c (first l)) p)
(t (position-of-loop c (rest l) (1+ p)))))
Note that this (as your original) uses 1-based indexing: zero-based would be more compatible with the rest of CL.
It would probably be idiomatic to make position-of-loop a local function:
(defun position-of (c l)
(labels ((position-of-loop (lt p)
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
(position-of-loop l 1)))
And you could then use an iteration macro if you wanted to make it a bit more concise:
(defun position-of (c l)
(iterate position-of-loop ((lt l) (p 1))
(cond
((atom lt) nil)
((equal c (first lt)) p)
(t (position-of-loop (rest lt) (1+ p))))))
The main problem is that you're trying to deal with incommensurable values. On the one hand, you want to deak with numbers, on the other, you want to deal with the empty list. You cannot add a number to a list, but you will inherently try doing so (you have an unconditional (1+ ...) call in your default branch in your cond).
There are ways to work around that, one being to capture the value:
(cond
...
(t (let ((val (positionRec c (rest l))))
(when val ;; Here we "pun" on nil being both false and the "not found" value
(1+ val)))))
Another would be to use a method amenable to tail-recursion:
(defun positionrec (element list &optional (pos 1))
(cond ((null list) nil)
((eql element (head list)) pos)
(t (positionrec element (rest list) (1+ pos)))))
The second function can (with a sufficently smart compiler) be turned into, basically, a loop. The way it works is by passing the return value as an optional parameter.
You could build a version using return, but you would probably need to make use of labels for that to be straight-forward (if you return nil directly from the function, it still ends up in the (1+ ...), where you then have numerical incompatibility) so I would go with either "explicitly capture the value and do the comparison against nil/false" or "the version amenable to tail-call elimination" and simply pick the one you find the most readable.
Hi I'm adapting the following UCI lisp code to common lisp.
This is the original function:
(DE MATCH-ARGS (PAT-ARGS CONST BINDING-FORM)
(LOOP ((INITIAL PAT-ARG NIL CONST-VAL NIL)
(WHILE (SETQ PAT-ARG (POP PAT-ARGS)))
(DO (SETQ CONST-VAL (FILLER:ROLE (ROLE:PAIR PAT-ARG) CONST)))
(WHILE (SETQ BINDING-FORM
(MATCH (FILLER:PAIR PAT-ARG)
CONST-VAL
BINDING-FORM)))
(RESULT BINDING-FORM]
Here's my current adaptation of it:
(defun match-args (pat-args const binding-form)
(loop (initial pat-arg nil const-val nil)
(while (setq pat-arg (pop pat-args)))
do (setq const-val (filler/role (role/pair pat-arg) const))
(while (setq binding-form
(match (filler/pair pat-arg)
const-val
binding-form)))
(result binding-form)))
Here's the error that it shows:
*** - LOOP: illegal syntax near (INITIAL PAT-ARG NIL CONST-VAL NIL) in
(LOOP (INITIAL PAT-ARG NIL CONST-VAL NIL) (WHILE (SETQ PAT-ARG (POP PAT-ARGS))) DO
(SETQ CONST-VAL (FILLER/ROLE (ROLE/PAIR PAT-ARG) CONST))
(WHILE (SETQ BINDING-FORM (MATCH (FILLER/PAIR PAT-ARG) CONST-VAL BINDING-FORM)))
(RESULT BINDING-FORM))
Please help. Match, filler/role, filler/pair and role/pair are all custom functions.
i would say it'd look something like this:
(defun match-args (pat-args const binding-form)
(loop for pat-arg in pat-args
for const-val = (filler/role (role/pair pat-arg) const)
do (setq binding-form
(match (filler/pair pat-arg)
const-val
binding-form))
while binding-form
collect binding-form))
it would be better if you could show the source of those functions (or at least their protocol), and input parameters example.
I'm trying to get a binary search tree's struct print function as below to print out a node (with its children, recursively) in an xml-ish style. The idea being that adding appropriate indentation should make it easier to see the structure of the BST.
What I have currently is:
(defstruct
(node (:print-function
(lambda (n s d)
(format s "#<~A ~A ~A>" (node-elt n) (node-l n) (node-r n)))))
elt (l nil) (r nil))
This prints out a BST as, for example:
#<5 #<4 #<2 #<1 NIL NIL> #<3 NIL NIL>> NIL> #<8 #<6 NIL #<7 NIL NIL>> #<9 NIL NIL>>>
But I'd like something from which it is easier to visualise the tree structure.
I have something like this in mind:
#<5
#<4
#<2
#<1 NIL NIL>
#<3 NIL NIL>> NIL>
#<8
#<6 NIL
#<7 NIL NIL>>
#<9 NIL NIL>>>
Assuming my goal is a good one, the indentation depth of each line must depend on the depth of the recursion. I'm not sure how to do that within the format form above.
Actually, maybe this isn't a very good way to display it after all.
If not, what is a good way to print out a (small, of course) binary search tree in the REPL, such that one can easily see its structure? (as a tool to help with algorithm development).
Thanks.
You can use logical blocks.
(defstruct
(node
(:constructor bst (elt &optional l r))
(:print-function
(lambda (n s d)
(declare (ignore d))
(format s
"(~s ~#<~s ~_~s ~_~s)~:>"
'bst
(node-elt n) (node-l n) (node-r n)))))
elt (l nil) (r nil))
When you call PPRINT-LOGICAL-BLOCK, the stream being used becomes a pretty-printing stream during the extent of the block (if it is not already one). Functions that start with pprint- like pprint-newline or pprint-indent respect indentation levels, logical blocks, etc. Usual functions like terpri or fresh-line do not.
The above format defines a logical block after bst, and prints conditional newlines between each element. The added value of this particular printer is that it prints the form readably.
Input
Thanks to the :constructor option, we can write a BST as follows:
(bst t
(bst 1 (bst :x) (bst :y))
(bst 2 (bst :a) (bst :b)))
Printed result
When evaluated, the resulting tree is printed in a way that can be read back to produce an equivalent tree.
(BST T
(BST 1 (BST :X NIL NIL) (BST :Y NIL NIL))
(BST 2 (BST :A NIL NIL) (BST :B NIL NIL)))
Alternative printer
You could also define a printer that just prints the form using an intermediate list. This is simpler to write and relies on existing pretty print functions.
(defstruct
(node
(:constructor bst (elt &optional l r))
(:print-function
(lambda (n s d)
(declare (ignore d))
(princ (list 'bst
(node-elt n)
(node-l n)
(node-r n))
s))))
elt (l nil) (r nil))
Output for modified printer
(BST T (BST 1 (BST X NIL NIL) (BST Y NIL NIL))
(BST 2 (BST A NIL NIL) (BST B NIL NIL)))
I'm trying to make a Mancala game in Lisp. It's going to have an AI to play against a human player, but I'm stuck. I can't find the way to represent the board as list; the major issue in my mind is how to move the tokens. Here are the references of how to play mancala
I'm thinking about a circular list, but I can't find any clear documentation on how to do that in Lisp.
Sorry about my grammar; English is not my native language.
Now I havent read the rules (sorry!) so this is just to address the idea of using a circular data structure.
A data structure doesnt have to be circular. As long as you pretend it is it will work!
Have a read of the mod function.
;; a1 a6 b1 b6
(defparameter *board* '(nil nil nil nil nil nil nil nil nil nil nil nil))
(defun wrap-position (pos)
(mod pos (length *board*)))
(defun push-token (position)
(push t (nth (wrap-position position) *board*)))
(defun pull-token (position)
(let ((contents (nth (wrap-position position) *board*)))
(setf (nth (wrap-position position) *board*) (rest contents))))
(defun print-board ()
(format t "| ~{~10<~a~>~} |~%| ~{~10<~a~>~} |" (reverse (subseq *board* 6))
(subseq *board* 0 6))
*board*)
Now the technique above is destructive. If you don't know yet what that is in lisp have a google or search here on stackoveflow, there are some good descriptions. It is worth looking into as you may find that your AI want to 'try out' lots of potential moves with 'damaging' the actual game board, a non destructive approach can help with this. The phenomenal book land of lisp has some great info on this.
Here is a simple usage example
CL-USER> *board*
(NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL)
CL-USER> (push-token 5)
(T)
CL-USER> *board*
(NIL NIL NIL NIL NIL (T) NIL NIL NIL NIL NIL NIL)
CL-USER> (push-token 5)
(T T)
CL-USER> *board*
(NIL NIL NIL NIL NIL (T T) NIL NIL NIL NIL NIL NIL)
CL-USER> (PULL-token 5)
(T)
CL-USER> *board*
(NIL NIL NIL NIL NIL (T) NIL NIL NIL NIL NIL NIL)
...I change the board before doing the next bit...
CL-USER> (print-board)
| NIL NIL NIL NIL NIL NIL |
| NIL NIL NIL NIL NIL (T T T T) |
Now have a look at Sylwester's answer and see that you can replace the sublists with just a number of stones. You will need to change the print-board obviously but that gives you a very simple model you can manipulate very easily (almost can be the big step you need to make this non-destructive). Have a go!
I would have used an array of 14 fixnums. index 0-5 are pits for A, 6 is A's basket. 7-12 are pits for player B and 13 is B's basket. You do minimax with copy-array.
If you want lists I would have either had A and B's lists individually or interleaved them. You could also just have a list of 14 cons.
Sorry, I couldn't really understand how to play the game, but here's something I could think about w/r to how to go about the board:
(defstruct (mancala-cell
(:print-object
(lambda (cell stream)
(format stream "<stones: ~d>"
(length (mancala-cell-stones cell))))))
(stones nil :type list)
(next nil))
(defun make-cells ()
(labels ((%make-cells (head count)
(let ((next (make-mancala-cell)))
(setf (mancala-cell-next head) next)
(if (> count 0) (%make-cells next (1- count)) next))))
(let* ((first (make-mancala-cell))
(last (%make-cells first 12)))
(setf (mancala-cell-next last) first))))
(defstruct (mancala-board
(:print-object
(lambda (board stream)
(loop :for i :from 0 :below 12
:for cell := (mancala-board-cells board)
:then (mancala-cell-next cell)
:do (princ (case i
(6 #\Newline) (0 "") (otherwise #\-))
stream)
(princ cell stream)))))
(cells (make-cells) :type mancala-cell))
(print (make-mancala-board))
;; <stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>
;; <stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>-<stones: 0>
Then here's one more example:
(defstruct (mancala-cell
(:print-object
(lambda (cell stream)
(format stream "<stones: ~d>"
(mancala-cell-stones cell)))))
(stones 4 :type fixnum))
(defconstant +null-cell+ (make-mancala-cell))
(deftype mancala-grid () '(array mancala-cell (12)))
(defun make-cells ()
(loop
:for i :from 0 :below 12
:with result := (make-array
12 :element-type 'mancala-cell
:initial-element +null-cell+)
:do (setf (aref result i) (make-mancala-cell))
:finally (return result)))
(defstruct (mancala-board
(:print-object
(lambda (board stream)
(loop :for i :from 0 :below 12
:for cell :across (mancala-board-cells board)
:do (princ (case i
(6 #\Newline) (0 "") (otherwise #\-))
stream)
(princ cell stream)))))
(cells (make-cells) :type mancala-grid))
(defun map-cells-in-range (function board &key (start 0) (end 12))
(loop
:for i :from start :below end
:with board := (mancala-board-cells board)
:collect (funcall function (aref board (mod i 12)))))
(defun fold-cells-in-range (function board &key (start 0) (end 12))
(loop
:for i :from start :below (1- end)
:with board := (mancala-board-cells board)
:for cell := (aref board (mod i 12))
:for result := (funcall
function
(aref board (mod i 12))
(aref board (mod (1+ i) 12)))
:then (funcall function result (aref board (mod (1+ i) 12)))
:finally (return result)))
(fold-cells-in-range
(lambda (a b)
(+ (mancala-cell-stones b)
(if (integerp a) a (mancala-cell-stones a))))
(make-mancala-board)) ; 48