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)))
Related
I am working on a complicated macro and have run into a roadblock.
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o
(with-hash-table-iterator (next-entry ,on)
(destructuring-bind
,(apply #'append vars)
(let ((current-band (list ,#(mapcar #'not (apply #'append vars)))))
(for (i 1 ,(length (apply #'append vars)) 2)
(multiple-value-bind
(succ k v) (next-entry)
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
im getting "Evaluation aborted on #<UNDEFINED-FUNCTION NEXT-ENTRY {100229C693}>"
i dont understand why next-entry appears to be invisible to the macro i have created.
I've tried stripping down this to a small replicable example but i couldnt find a minimal scenario without the macro i created where next-entry would be invisible besides this scenario no matter what I tried, i've always managed to find a way to call next-entry in my other examples so im stumped as to why i cannot get it working here
I've tested the for macro ive created and it seems to generally work in most cases but for some reason it cannot see this next-entry variable. How do i make it visible?
In your code there are multiple places where the macro generates bindings in a way that is subject to variable capture (pdf).
(defmacro for-each-hashtable-band (body vars on &optional counter name)
`(block o ;; VARIABLE CAPTURE
(with-hash-table-iterator (next-entry ,on) ;; VARIABLE CAPTURE
(destructuring-bind ,(apply #'append vars)
(let ((current-band ;;; VARIABLE CAPTURE
(list ,#(mapcar #'not (apply #'append vars)))))
(for
(i ;;; VARIABLE CAPTURE
1 ,(length (apply #'append vars)) 2)
(multiple-value-bind (succ k v) ;;; VARIABLE CAPTURE
,(next-entry) ;;; WRONG EVALUATION TIME
(if succ
(progn
(setf (nth i current-band) k)
(setf (nth (+ 1 i) current-band) v))
(return-from o nil))))
current-band)
,#body))))
A simplified example of such a capture is:
`(let ((x 0)) ,#body)
Here above, the x variable is introduced, but if the code is expanded in a context where xis already bound, then body will not be able to reference that former x binding and will always see x bound to zero (you generally don't want this behavior).
Write a function instead
Instead of writing a big macro for this, let's first try understanding what you want to achieve and write instead a higher-order function, ie. a function that calls user-provided functions.
If I understand correctly, your function iterates over a hash-table by bands of entries. I assume vars holds a list of (key value) pairs of symbols, for example ((k1 v1) (k2 v2)). Then, body works on all the key/value pairs in the band.
In the following code, the function map-each-hashtable-band accepts a function, a hash-table, and instead of vars it accepts a size, the width of the band (the number of pairs).
Notice how in your code, you only have one loop, which builds a band using the hash-table iterator. But then, since the macro is named for-each-hashtable-band, I assume you also want to loop over all the bands. The macro with-hash-table-iterator provides an iterator but does not loop itself. That's why here I have two loops.
(defun map-each-hashtable-band (function hash-table band-size)
(with-hash-table-iterator (next-entry hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(apply function current-band))
(unless next-p
(return-from outer-loop)))))))
For example:
(map-each-hashtable-band (lambda (&rest band) (print `(:band ,band)))
(alexandria:plist-hash-table
'(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5 :g 6))
2)
NB. Iterating over a hash-table happens in an arbitrary order, there is no guarantee that you'll see the entries in any particular kind of order, this is implementation-dependant.
With my current version of SBCL this prints the following:
(:BAND (:A 0 :B 1))
(:BAND (:C 2 :D 3))
(:BAND (:E 4 :F 5))
(:BAND (:G 6))
Wrap the function in a macro
The previous function might not be exactly the behavior you want, so you need to adapt to your needs, but once it does what you want, you can wrap a macro around it.
(defmacro for-each-hashtable-band (vars hash-table &body body)
`(map-each-hashtable-band (lambda ,(apply #'append vars) ,#body)
,hash-table
,(length vars)))
For example:
(let ((test (alexandria:plist-hash-table '(:a 0 :b 1 :c 2 :d 3 :e 4 :f 5))))
(for-each-hashtable-band ((k1 v1) (k2 v2)) test
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2 v2)))
This prints:
A -> 0 && B -> 1
C -> 2 && D -> 3
E -> 4 && F -> 5
Macro-only solution, for completeness
If you want to have only one, single macro, you can start by inlining the body of the above function in the macro, you don't need to use apply anymore, but instead you need to establish bindings around the body, using destructuring-bind as you did. A first draft would be to simply as follows, but notice that this is not a proper solution:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (next-entry ,hash-table)
(loop :named outer-loop :do
(loop
:with key and value and next-p
:repeat ,band-size
:do (multiple-value-setq (next-p key value) (next-entry))
:while next-p
:collect key into current-band
:collect value into current-band
:finally (progn
(when current-band
(destructuring-bind ,(apply #'append vars) current-band
,#body))
(unless next-p
(return-from outer-loop))))))))
In order to be free of variable capture problems with macros, each temporary variable you introduce must be named after a symbol that cannot exist in any context you expand your code. So instead we first unquote all the variables, making the macro definition fail to compile:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop))))))))
When compiling the macro, the macro is supposed to inject symbols into the code, but here we have a compilation error that says undefined variables:
;; undefined variables: CURRENT-BAND KEY NEXT-ENTRY NEXT-P OUTER-LOOP VALUE
So now, those variables should be fresh symbols:
(defmacro for-each-hashtable-band (vars hash-table &body body)
(let ((band-size (length vars)))
(let ((current-band (gensym))
(key (gensym))
(next-entry (gensym))
(next-p (gensym))
(outer-loop (gensym))
(value (gensym)))
`(with-hash-table-iterator (,next-entry ,hash-table)
(loop :named ,outer-loop :do
(loop
:with ,key and ,value and ,next-p
:repeat ,band-size
:do (multiple-value-setq (,next-p ,key ,value) (,next-entry))
:while ,next-p
:collect ,key into ,current-band
:collect ,value into ,current-band
:finally (progn
(when ,current-band
(destructuring-bind ,(apply #'append vars) ,current-band
,#body))
(unless ,next-p
(return-from ,outer-loop)))))))))
This above is a bit verbose, but you could simplify that.
Here is what the previous for-each-hashtable-band example expands into with this new macro:
(with-hash-table-iterator (#:g1576 test)
(loop :named #:g1578
:do (loop :with #:g1575
and #:g1579
and #:g1577
:repeat 2
:do (multiple-value-setq (#:g1577 #:g1575 #:g1579) (#:g1576))
:while #:g1577
:collect #:g1575 into #:g1574
:collect #:g1579 into #:g1574
:finally (progn
(when #:g1574
(destructuring-bind
(k1 v1 k2 v2)
#:g1574
(format t "~a -> ~a && ~a -> ~a ~%" k1 v1 k2
v2)))
(unless #:g1577 (return-from #:g1578))))))
Each time you expand it, the #:gXXXX variables are different, and cannot possibly shadow existing bindings, so for example, the body can use variables named like current-band or value without breaking the expanded code.
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.
I'm looking at the LispWorks Hyperspec on dotimes but I don't understand what the third variable [result-form] is doing. The examples are as follows:
(dotimes (temp-one 10 temp-one)) => 10
(setq temp-two 0) => 0
(dotimes (temp-one 10 t) (incf temp-two)) => T
temp-two => 10
The Hyperspec says
...Then result-form is evaluated. At the time result-form is
processed, var is bound to the number of times the body was executed.
Not sure what this is saying. Why is the third variable necessary in these two dotimes examples? I seem to be able to leave it out entirely in the second example and it works. My next example (not sure where I found it),
(defun thing (n)
(let ((s 0))
(dotimes (i n s)
(incf s i))))
Puzzles me as well. What use is s serving?
Since dotimes is a macro, looking at it's macro expansion can make things clearer:
Take your first example and expand it:
(pprint (MACROEXPAND-1 '(dotimes (temp-one 10 temp-one))))
I get the following output: (Yours may vary depending on the CL implementation)
(BLOCK NIL
(LET ((#:G8255 10) (TEMP-ONE 0))
(DECLARE (CCL::UNSETTABLE TEMP-ONE))
(IF (CCL::INT>0-P #:G8255)
(TAGBODY
#:G8254 (LOCALLY (DECLARE (CCL::SETTABLE TEMP-ONE))
(SETQ TEMP-ONE (1+ TEMP-ONE)))
(UNLESS (EQL TEMP-ONE #:G8255) (GO #:G8254))))
TEMP-ONE))
There's a lot going on, but the key thing to look at is that temp-one is bound to the value 0, and is returned as the expression's value (in standard lisp evaluation order).
Take the last example:
(pprint (macroexpand-1 '(dotimes (i n s) (incf s i))))
outputs:
(BLOCK NIL
(LET ((#:G8253 N) (I 0))
(DECLARE (CCL::UNSETTABLE I))
(IF (CCL::INT>0-P #:G8253)
(TAGBODY
#:G8252 (INCF S I)
(LOCALLY (DECLARE (CCL::SETTABLE I))
(SETQ I (1+ I)))
(UNLESS (EQL I #:G8253) (GO #:G8252))))
S))
As you can see S here is treated the same way as temp-one in the example before.
Try one without passing the last variable:
(pprint (macroexpand-1 '(dotimes (i n) (do-something i))))
and you get:
(BLOCK NIL
(LET ((#:G8257 N) (I 0))
(DECLARE (CCL::UNSETTABLE I))
(IF (CCL::INT>0-P #:G8257)
(TAGBODY
#:G8256 (DO-SOMETHING I)
(LOCALLY (DECLARE (CCL::SETTABLE I))
(SETQ I (1+ I)))
(UNLESS (EQL I #:G8257) (GO #:G8256))))
NIL))
Notice how NIL is the return value.
I'm learning Common Lisp from Practical Common Lisp. It has an example of helper functions for reading and writing binary files in Chapter 24. Here's one example:
(defun read-u2 (in)
(+ (* (read-byte in) 256) (read-byte in)))
I can write functions for reading other kinds of binary numbers likewise. But I thought that doing so violates the DRY principle. Besides, these functions are going to be similar, so I tried to generate the functions with macros.
(defmacro make-read (n be)
`(defun ,(intern (format nil "READ~d~:[L~;B~]E" n be))
(&optional (stream *standard-input*))
(logior ,#(loop for i from 0 below n collect
`(ash (read-byte stream)
,(* 8 (if be (- n 1 i) i)))))))
(defmacro make-read-s (n be)
`(defun ,(intern (format nil "READ~d~:[L~;B~]E-S" n be))
(&optional (stream *standard-input*))
(let ((a (,(intern (format nil "READ~d~:[L~;B~]E" n be)) stream)))
(if (zerop (logand a ,(ash 1 (1- (* 8 n)))))
a
(logior a ,(ash -1 (* 8 n)))))))
(defmacro make-write (n be)
`(defun ,(intern (format nil "WRITE~d~:[L~;B~]E" n be))
(n &optional (stream *standard-output*))
(setf n (logand n ,(1- (ash 1 (* 8 n)))))
,#(loop for i from 0 below n collect
`(write-byte (ldb (byte 8 ,(* 8 (if be (- n 1 i) i))) n)
stream))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(dolist (cat '("READ" "READ-S" "WRITE"))
(dolist (be '(nil t))
(dolist (n '(1 2 4 8))
(eval `(,(intern (format nil "MAKE-~a" cat)) ,n ,be))))))
It works. It generates functions for reading and writing unsigned and signed integers in sizes of 1, 2, 4, and 8. SLIME understands it. But I wonder if there are better ways.
What's the best way to write a bunch of similar functions in Common Lisp?
There are some issues with this code, though the general approach to have macros generating functions is fine.
Naming
The macros should not be named make-..., because they are not functions which make something, but macros which define a function.
Code generation
The EVAL-WHEN ... EVAL code is really bad and should not be used this way.
The better way is to write macro which expands into a progn with the function definitions.
If I wanted to use EVAL, then I would not need to write code generating macros, but simply code generating functions. But I don't want to use EVAL, I want to create code for the compiler directly. If I have code generating macros, then I don't need EVAL.
EVAL is not a good idea, because it is not clear that the code would be compiled - which would be implementation dependent. Also the evaluation would take place at compile time and load time. It would be better to compile the functions at compile time and only load them at load time. A file compiler also might miss possible optimizations for the evaluated functions.
(defmacro def-read-fun (n be)
`(defun ,(intern (format nil "READ~d~:[L~;B~]E" n be))
(&optional (stream *standard-input*))
(logior ,#(loop for i from 0 below n collect
`(ash (read-byte stream)
,(* 8 (if be (- n 1 i) i)))))))
(defmacro def-read-s-fun (n be)
`(defun ,(intern (format nil "READ~d~:[L~;B~]E-S" n be))
(&optional (stream *standard-input*))
(let ((a (,(intern (format nil "READ~d~:[L~;B~]E" n be)) stream)))
(if (zerop (logand a ,(ash 1 (1- (* 8 n)))))
a
(logior a ,(ash -1 (* 8 n)) )))))
(defmacro def-write-fun (n be)
`(defun ,(intern (format nil "WRITE~d~:[L~;B~]E" n be))
(n &optional (stream *standard-output*))
(setf n (logand n ,(1- (ash 1 (* 8 n)))))
,#(loop for i from 0 below n collect
`(write-byte (ldb (byte 8 ,(* 8 (if be (- n 1 i) i))) n)
stream))))
Instead of the EVAL-WHEN ... EVAL we define another macro and then we use it later:
(defmacro def-reader/writer-functions (cat-list be-list n-list)
`(progn
,#(loop for cat in cat-list append
(loop for be in be-list append
(loop for n in n-list
collect `(,(intern (format nil "DEF-~a-FUN" cat))
,n
,be))))))
Now we can use above macro to generate all the functions:
(def-reader/writer-functions
("READ" "READ-S" "WRITE")
(nil t)
(1 2 4 8))
You can see the expansion here:
CL-USER 173 > (pprint (macroexpand-1 '(def-reader/writer-functions
("READ" "READ-S" "WRITE")
(nil t)
(1 2 4 8))))
(PROGN
(DEF-READ-FUN 1 NIL)
(DEF-READ-FUN 2 NIL)
(DEF-READ-FUN 4 NIL)
(DEF-READ-FUN 8 NIL)
(DEF-READ-FUN 1 T)
(DEF-READ-FUN 2 T)
(DEF-READ-FUN 4 T)
(DEF-READ-FUN 8 T)
(DEF-READ-S-FUN 1 NIL)
(DEF-READ-S-FUN 2 NIL)
(DEF-READ-S-FUN 4 NIL)
(DEF-READ-S-FUN 8 NIL)
(DEF-READ-S-FUN 1 T)
(DEF-READ-S-FUN 2 T)
(DEF-READ-S-FUN 4 T)
(DEF-READ-S-FUN 8 T)
(DEF-WRITE-FUN 1 NIL)
(DEF-WRITE-FUN 2 NIL)
(DEF-WRITE-FUN 4 NIL)
(DEF-WRITE-FUN 8 NIL)
(DEF-WRITE-FUN 1 T)
(DEF-WRITE-FUN 2 T)
(DEF-WRITE-FUN 4 T)
(DEF-WRITE-FUN 8 T))
Each of the subforms then will be expanded into the function definitions.
This way the compiler runs the macros to generate all the code at compile time and the compiler can then generate code for all the functions.
Efficiency / Defaults
In a lowest-level function I may not want to use an &optional parameter. The default call would get the value from a dynamic binding and, worse, *standard-input* / *standard-output* may not be a stream for which READ-BYTE or WRITE-BYTE works. Not in every implementation you can use a standard input/output stream as a binary stream.
LispWorks:
CL-USER 1 > (write-byte 13 *standard-output*)
Error: STREAM:STREAM-WRITE-BYTE is not implemented for this stream type: #<SYSTEM::TERMINAL-STREAM 40E01D110B>
1 (abort) Return to level 0.
2 Restart top-level loop.
I also may want to declare all generated functions to be inlined.
Type declarations would be another thing to think about.
Summmary: don't use EVAL.
Generally, I'd prefer to just add the number of bytes to read as another parameter to the function:
(defun read-integer (stream bytes)
(check-type bytes (integer 1 *))
(loop :repeat bytes
:for b := (read-byte stream)
:for n := b :then (+ (* n 256) b)
:finally (return n)))
Signedness and endianness could be added as keyword arguments. This way of programming is good for understandable code that is also easily navigated through tools like SLIME.
Unrolling this through macros is a valid optimization strategy, and I defer to Rainer's answer.
In the specific case of reading numbers from a stream, optimization is likely a valid goal from the start, since this tends to get used a lot in tight loops.
If you do this, however, you should also thoroughly document what gets generated. If a reader of the code sees an operator read8bes, he cannot easily find out where it was defined. You need to help him.
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