Solving the Euler project problems I get that I need to make operations with the digits of a long number normally as a string. I work in linux, emacs, slime with sbcl.
For example, to get the sum of the digits of this power 2¹⁰⁰⁰, I work this way,
1) Get the power
CL-USER> (defparameter *answer-as-integer* (expt 2 1000))
*ANSWER-AS-INTEGER*
CL-USER> *ANSWER-AS-INTEGER*
10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376
Thanks to Common Lisp this is very easy. Now I believe that a good way should be to apply reduce to this sequence of digits.
2) Get the string
CL-USER> (defparameter *answer-as-string* (write-to-string *ANSWER-AS-INTEGER*))
*ANSWER-AS-STRING*
CL-USER> *ANSWER-AS-STRING*
"10715086071862673209484250490600018105614048117055336074437503883703510511249361224931983788156958581275946729175531468251871452856923140435984577574698574803934567774824230985421074605062371141877954182153046474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376"
Now I have the sequence, so apply reduce, but I get wrong things: This is a char so I apply a conversion char to integer:
CL-USER> (reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*)
but I get an error:
The value 1 is not of type CHARACTER.
[Condition of type TYPE-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {1005DE80B3}>)
Backtrace:
0: (DIGIT-CHAR-P 1) [optional]
1: ((LAMBDA (X Y)) 1 #\7)
2: (REDUCE #<FUNCTION (LAMBDA (X Y)) {100523C79B}> "1071508607186267320948425049060001810561404811705533607443750388370351051124936122493198378815695858127594672917553146825187145285692314043598457757469..
3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (REDUCE (FUNCTION (LAMBDA # #)) *ANSWER-AS-STRING*) #<NULL-LEXENV>)
4: (EVAL (REDUCE (FUNCTION (LAMBDA # #)) *ANSWER-AS-STRING*))
5: (SWANK::EVAL-REGION "(reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*) ..)
Locals:
SB-DEBUG::ARG-0 = "(reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*)\n"
6: ((LAMBDA NIL :IN SWANK-REPL::REPL-EVAL))
7: (SWANK-REPL::TRACK-PACKAGE #<CLOSURE (LAMBDA NIL :IN SWANK-REPL::REPL-EVAL) {10051F065B}>)
8: (SWANK::CALL-WITH-RETRY-RESTART "Retry SLIME REPL evaluation request." #<CLOSURE (LAMBDA NIL :IN SWANK-REPL::REPL-EVAL) {10051F059B}>)
9: (SWANK::CALL-WITH-BUFFER-SYNTAX NIL #<CLOSURE (LAMBDA NIL :IN SWANK-REPL::REPL-EVAL) {10051F057B}>)
10: (SWANK-REPL::REPL-EVAL "(reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*) ..)
11: (SB-INT:SIMPLE-EVAL-IN-LEXENV (SWANK-REPL:LISTENER-EVAL "(reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*) ..)
12: (EVAL (SWANK-REPL:LISTENER-EVAL "(reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*) ..)
13: (SWANK:EVAL-FOR-EMACS (SWANK-REPL:LISTENER-EVAL "(reduce #'(lambda (x y) (+ (digit-char-p x) (digit-char-p y))) *ANSWER-AS-string*) ..)
14: (SWANK::PROCESS-REQUESTS NIL)
15: ((LAMBDA NIL :IN SWANK::HANDLE-REQUESTS))
16: ((LAMBDA NIL :IN SWANK::HANDLE-REQUESTS))
17: (SWANK/SBCL::CALL-WITH-BREAK-HOOK #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<CLOSURE (LAMBDA NIL :IN SWANK::HANDLE-REQUESTS) {1005DF00DB}>)
18: ((FLET SWANK/BACKEND:CALL-WITH-DEBUGGER-HOOK :IN "/home/anquegi/quicklisp/dists/quicklisp/software/slime-2.13/swank/sbcl.lisp") #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<CLOSURE (LAMBDA NIL :IN SWANK::H..
19: (SWANK::CALL-WITH-BINDINGS ((*STANDARD-OUTPUT* . #1=#<SWANK/GRAY::SLIME-OUTPUT-STREAM {1005DCF343}>) (*STANDARD-INPUT* . #2=#<SWANK/GRAY::SLIME-INPUT-STREAM {1006160003}>) (*TRACE-OUTPUT* . #1#) (*ERR..
20: (SWANK::HANDLE-REQUESTS #<SWANK::MULTITHREADED-CONNECTION {1005078BE3}> NIL)
21: ((FLET #:WITHOUT-INTERRUPTS-BODY-1226 :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
22: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
23: ((FLET #:WITHOUT-INTERRUPTS-BODY-647 :IN SB-THREAD::CALL-WITH-MUTEX))
24: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE) {7FFFEA81ED1B}> #<SB-THREAD:MUTEX "thread result lock" owner: #<SB-THREAD:THR..
25: (SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE #<SB-THREAD:THREAD "repl-thread" RUNNING {1005DE80B3}> #S(SB-THREAD:SEMAPHORE :NAME "Thread setup semaphore" :%COUNT 0 :WAITCOUNT 0 :MUTEX #<SB-THREAD:MU..
26: ("foreign function: call_into_lisp")
27: ("foreign function: new_thread_trampoline")
and if I try to use this as digits without conversion the inteerpreter says that this is not a integer, so I'm getting crazy, because this is right but the above code not:
(reduce #'+ *ANSWER-AS-string*)
The value #\1 is not of type NUMBER.
[Condition of type TYPE-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {1005DE80B3}>)
Backtrace:
0: (+ #\1 #\0)
1: (REDUCE #<FUNCTION +> "107150860718626732094842504906000181056140481170553360744375038837035105112493612249319837881569585812759467291755314682518714528569231404359845775746985748039345677748242309854..
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (REDUCE (FUNCTION +) *ANSWER-AS-STRING*) #<NULL-LEXENV>)
3: (EVAL (REDUCE (FUNCTION +) *ANSWER-AS-STRING*))
4: (SWANK::EVAL-REGION "(reduce #'+ *ANSWER-AS-string*) ..)
Locals:
SB-DEBUG::ARG-0 = "(reduce #'+ *ANSWER-AS-string*)\n"
5: ((LAMBDA NIL :IN SWANK-REPL::REPL-EVAL))
6: (SWANK-REPL::TRACK-PACKAGE #<CLOSURE (LAMBDA NIL :IN SWANK-REPL::REPL-EVAL) {100566384B}>)
7: (SWANK::CALL-WITH-RETRY-RESTART "Retry SLIME REPL evaluation request." #<CLOSURE (LAMBDA NIL :IN SWANK-REPL::REPL-EVAL) {100566378B}>)
8: (SWANK::CALL-WITH-BUFFER-SYNTAX NIL #<CLOSURE (LAMBDA NIL :IN SWANK-REPL::REPL-EVAL) {100566376B}>)
9: (SWANK-REPL::REPL-EVAL "(reduce #'+ *ANSWER-AS-string*) ..)
10: (SB-INT:SIMPLE-EVAL-IN-LEXENV (SWANK-REPL:LISTENER-EVAL "(reduce #'+ *ANSWER-AS-string*) ..)
11: (EVAL (SWANK-REPL:LISTENER-EVAL "(reduce #'+ *ANSWER-AS-string*) ..)
12: (SWANK:EVAL-FOR-EMACS (SWANK-REPL:LISTENER-EVAL "(reduce #'+ *ANSWER-AS-string*) ..)
13: (SWANK::PROCESS-REQUESTS NIL)
14: ((LAMBDA NIL :IN SWANK::HANDLE-REQUESTS))
15: ((LAMBDA NIL :IN SWANK::HANDLE-REQUESTS))
16: (SWANK/SBCL::CALL-WITH-BREAK-HOOK #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<CLOSURE (LAMBDA NIL :IN SWANK::HANDLE-REQUESTS) {1005DF00DB}>)
17: ((FLET SWANK/BACKEND:CALL-WITH-DEBUGGER-HOOK :IN "/home/anquegi/quicklisp/dists/quicklisp/software/slime-2.13/swank/sbcl.lisp") #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<CLOSURE (LAMBDA NIL :IN SWANK::H..
18: (SWANK::CALL-WITH-BINDINGS ((*STANDARD-OUTPUT* . #1=#<SWANK/GRAY::SLIME-OUTPUT-STREAM {1005DCF343}>) (*STANDARD-INPUT* . #2=#<SWANK/GRAY::SLIME-INPUT-STREAM {1006160003}>) (*TRACE-OUTPUT* . #1#) (*ERR..
19: (SWANK::HANDLE-REQUESTS #<SWANK::MULTITHREADED-CONNECTION {1005078BE3}> NIL)
20: ((FLET #:WITHOUT-INTERRUPTS-BODY-1226 :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
21: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
22: ((FLET #:WITHOUT-INTERRUPTS-BODY-647 :IN SB-THREAD::CALL-WITH-MUTEX))
23: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE) {7FFFEA81ED1B}> #<SB-THREAD:MUTEX "thread result lock" owner: #<SB-THREAD:THR..
24: (SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE #<SB-THREAD:THREAD "repl-thread" RUNNING {1005DE80B3}> #S(SB-THREAD:SEMAPHORE :NAME "Thread setup semaphore" :%COUNT 0 :WAITCOUNT 0 :MUTEX #<SB-THREAD:MU..
25: ("foreign function: call_into_lisp")
26: ("foreign function: new_thread_trampoline")
I solved this by doing this:
CL-USER> (defun sum-digits-in-a-string (str)
(reduce #'+ (map 'list #'digit-char-p str)))
SUM-DIGITS-IN-A-STRING
CL-USER> (sum-digits-in-a-string *ANSWER-AS-STRING*)
1366
So my question is to why I get that error first an integer and after a char, and what is the better way of work with the digits of a long integer. If my aproximation is good: long-integer -> string -> list of integers -> apply reduce.
This isn't Common Lisp specific, but I think it may be a general help if you start by adding some debug output to your functions. E.g., in this case, if you print x and y before adding and calling digit-char-p with them, you can see that after the first two elements are processed, the third gets processed with the result from the previous addition, which is a number, not a character:
CL-USER> (reduce (lambda (x y)
(write (list x y))
(+ (digit-char-p x)
(digit-char-p y)))
"1234")
(#\1 #\2)(3 #\3)
; Evaluation aborted on #<TYPE-ERROR expected-type: CHARACTER datum: 3>.
You can think about what a manual unrolling would look like:
(+ (digit-char-p (+ (digit-char-p (+ (digit-char-p #\1)
(digit-char-p #\2)))
(digit-char-p #\3)))
(digit-char-p #\4))
In those intermediate calls, you call digit-char-p on something that's a number, not a character.
You got to a good point with your final solution:
(defun sum-digits-in-a-string (str)
(reduce #'+ (map 'list #'digit-char-p str)))
but that has the unfortunate issue that it creates a whole new sequence to contain the digits and then reduces over them. Another common anti-pattern is (apply '+ (map …)). Yours is a bit better, because it uses reduce, but reduce actually takes a key argument that eliminates the need for the map. You can use the key argument to reduce to specify how values should be extracted from the sequence elements, and you can use an initial value (which is important if your sequence is empty, or has just one element):
CL-USER> (reduce '+ "1234" :key 'digit-char-p :initial-value 0)
;=> 10
One can avoid to print the number to a string and generate a list of the decimal digits directly.
EXPLODE and IMPLODE
Usually this operation is called explode. Typically the explode operation could deal with symbols, integers and similar. It creates a list of the components. The inverse operating is called implode.
This would be explode for positive integers:
(defun explode-integer (integer)
"Explode a positve integer."
(labels ((aux-explode-integer (integer)
(nreverse
(loop with i = integer and r = 0
while (> i 0)
do (multiple-value-setq (i r) (floor i 10))
collect r))))
(cond ((plusp integer)
(aux-explode-integer integer))
((zerop integer) (list 0)))))
Example:
CL-USER 31 > (explode-integer 572304975029345020734)
(5 7 2 3 0 4 9 7 5 0 2 9 3 4 5 0 2 0 7 3 4)
The computation performed by (reduce f "125") is
(f (f #\1 #\2) #\5)
In your case, this means that it is going to compute
(+ (digit-char-p (+ (digit-char-p #\1) (digit-char-p #\2)))
(digit-char-p #\5))
so it's going to evaluate
(+ (digit-char-p 3) (digit-char-p #\5))
which breaks with a type error.
The simplest solution is to write a variant of digit-char-p that works on integers:
(defun digit-to-int (x)
(etypecase x
(integer x)
(character (digit-char-p x))))
(reduce #'(lambda (x y) (+ (digit-to-int x) (digit-to-int y))) *ANSWER-AS-string*)
As pointed out by Joshua Taylor, a cleaner solution is to use the :key parameter to reduce, which is roughly equivalent to using map but avoids the need to generate an intermediary sequence:
(reduce #'+ *ANSWER-AS-string* :key #'digit-char-p)
Related
I am working on a program that generates program (Genetic Programming). I build at runtime an s-expression and today I use eval like this:
(defvar *program* '(+ x 1))
(defvar x 10)
(eval *program*) ;; returns 11
Evaluation is done for multiple x and I want to compile the s-expression into a function at runtime and then call it for multiple x to improve performance.
I can't figure out how to do it and I will appreciate some help. Here is what I have:
;;;; This is not working code
(defmacro compile-program (args &body body)
(compile nil `(lambda (,#args)
(declare (ignorable ,#args))
(progn ,#body))))
(funcall (compile-program (x) *program*) 10) ;; returns (+ X 1)
(funcall (compile-program (x) (+ x 1)) 10) ;; returns 11
Edit:
Thx to #RainerJoswig I made the following modifications and it works:
;;;; Working Code
(defvar *program* '(+ x 1))
(defun compile-program (args program)
(compile nil `(lambda ,args
(declare (ignorable ,#args))
,program)))
(funcall (compile-program '(x) *program*) 10) ;; returns 11
Thx to #RainerJoswig and #coredump I made the following modifications and it works:
;;;; Working Code
(defvar *program* '(+ x 1))
(defun compile-program (args program)
(compile nil `(lambda ,args
(declare (ignorable ,#args))
,program)))
(funcall (compile-program '(x) *program*) 10) ;; returns 11
I want to build an application into a bundle with Ceramic. I can run the app with it. The error arises with:
(ceramic:bundle :WEBLOCKS-TODOMVC :bundle-pathname #p"build/todomvc.tar")
it runs…
Ceramic: Compiling app...
Launch:
"/usr/local/bin/sbcl" --noinform --no-userinit --no-sysinit
--load "/home/vince/quicklisp/setup.lisp"
--eval "(setf *debugger-hook*
#'(lambda (c h)
(declare (ignore h))
(uiop:print-condition-backtrace c)
(uiop:quit -1)))"
--eval "(asdf:load-system :WEBLOCKS-TODOMVC)"
--eval "(setf uiop:*image-entry-point*
#'(lambda ()
(ceramic-entry::weblocks-todomvc)))"
--eval "(uiop:dump-image #P\"/home/vince/.ceramic/working/weblocks-todomvc\"
:executable t
#+sb-core-compression :compression
#+sb-core-compression t)"
and crashes:
Subprocess with command "\"/usr/local/bin/sbcl\" --noinform --no-userinit --no-sysinit --load \"/home/vince/quicklisp/setup.lisp\" --eval \"(setf *debugger-hook* #'(lambda (c h) (declare (ignore h)) (uiop:print-condition-backtrace c) (uiop:quit -1)))\" --eval \"(asdf:load-system :WEBLOCKS-TODOMVC)\" --eval \"(setf uiop:*image-entry-point* #'(lambda () (ceramic-entry::weblocks-todomvc)))\" --eval \"(uiop:dump-image #P\\\"/home/vince/.ceramic/working/weblocks-todomvc\\\" :executable t
#+sb-core-compression :compression #+sb-core-compression t)\""
exited with error code 255
[Condition of type UIOP/RUN-PROGRAM:SUBPROCESS-ERROR]
However, the log error, the backtrace don't contain much information at all. Is there a way to ask for more ?
I did a mkdir build/ to be sure.
[![image][1]][1]
(source: toile-libre.org)
Given coredump's answer:
I went up in the source (with M-.) from ceramic:bundle to find the call to uiop:run-process, which I added the two parameters and wrapped around a multiple-value-bind:
(multiple-value-bind (zero one two)
(uiop:run-program command
:output *standard-output*
:error :output
:error-output :lines
:ignore-error-status t)
(format t "------------ printing error messages:")
(log:info zero)
(log:info one)
(log:info two))))
and running the build command again:
------------ printing error messages:
<INFO> [19:09:32] trivial-build slimeCUlUAR (boot-and-build) -
TRIVIAL-BUILD::ZERO: NIL
<INFO> [19:09:32] trivial-build slimeCUlUAR (boot-and-build) -
TRIVIAL-BUILD::ONE: ("WARNING: Setting locale failed."
" Check the following variables for correct values:"
" LC_CTYPE=en_US.UTF-8" " LANG=fr_FR.UTF-8"
"Backtrace for: #<SB-THREAD:THREAD \"main thread\" RUNNING {10019BB4E3}>"
"0: ((LAMBDA NIL :IN UIOP/IMAGE:PRINT-BACKTRACE))"
"1: ((FLET \"THUNK\" :IN UIOP/STREAM:CALL-WITH-SAFE-IO-SYNTAX))"
"2: (SB-IMPL::%WITH-STANDARD-IO-SYNTAX #<CLOSURE (FLET \"THUNK\" :IN UIOP/STREAM:CALL-WITH-SAFE-IO-SYNTAX) {7FFFF70BF27B}>)"
"3: (UIOP/STREAM:CALL-WITH-SAFE-IO-SYNTAX #<CLOSURE (LAMBDA NIL :IN UIOP/IMAGE:PRINT-BACKTRACE) {10035ABAAB}> :PACKAGE :CL)"
"4: (UIOP/IMAGE:PRINT-CONDITION-BACKTRACE Component :WEBLOCKS-TODOMVC not found :STREAM NIL :COUNT NIL)"
"5: ((LAMBDA (COMMON-LISP-USER::C COMMON-LISP-USER::H))
Component :WEBLOCKS-TODOMVC not found #<unused argument>)"
"6: (SB-DEBUG::RUN-HOOK *DEBUGGER-HOOK*
Component :WEBLOCKS-TODOMVC not found)"
"7: (INVOKE-DEBUGGER
Component :WEBLOCKS-TODOMVC not found)"
"8: (ERROR ASDF/FIND-SYSTEM:MISSING-COMPONENT :REQUIRES :WEBLOCKS-TODOMVC)"
"9: ((:METHOD ASDF/OPERATE:OPERATE (SYMBOL T)) ASDF/LISP-ACTION:LOAD-OP :WEBLOCKS-TODOMVC) [fast-method]"
"10: ((SB-PCL::EMF ASDF/OPERATE:OPERATE) #<unused argument> #<unused argument> ASDF/LISP-ACTION:LOAD-OP :WEBLOCKS-TODOMVC)"
"11: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))"
"12: ((:METHOD ASDF/OPERATE:OPERATE :AROUND (T T)) ASDF/LISP-ACTION:LOAD-OP :WEBLOCKS-TODOMVC) [fast-method]"
"13: ((LAMBDA NIL :IN ASDF/OPERATE:OPERATE))"
"14: (ASDF/CACHE:CALL-WITH-ASDF-CACHE #<CLOSURE (LAMBDA NIL :IN ASDF/OPERATE:OPERATE) {1001ED497B}> :OVERRIDE NIL :KEY NIL)"
"15: ((:METHOD ASDF/OPERATE:OPERATE :AROUND (T T)) ASDF/LISP-ACTION:LOAD-OP :WEBLOCKS-TODOMVC) [fast-method]"
"16: (ASDF/OPERATE:LOAD-SYSTEM :WEBLOCKS-TODOMVC)"
"17: (SB-INT:SIMPLE-EVAL-IN-LEXENV (ASDF/OPERATE:LOAD-SYSTEM :WEBLOCKS-TODOMVC) #<NULL-LEXENV>)"
"18: (EVAL (ASDF/OPERATE:LOAD-SYSTEM :WEBLOCKS-TODOMVC))"
"19: (SB-IMPL::PROCESS-EVAL/LOAD-OPTIONS ((:LOAD . \"/home/vince/quicklisp/setup.lisp\") (:EVAL . \"(setf *debugger-hook* #'(lambda (c h) (declare (ignore h)) (uiop:print-condition-backtrace c) (uiop:quit -1)))\") (:EVAL . \"(asdf:load-system :WEBLOCKS-TODOMVC)\") (:EVAL . \"(setf uiop:*image-entry-point* #'(lambda () (ceramic-entry::weblocks-todomvc)))\") (:EVAL . \"(uiop:dump-image #P\\\"/home/vince/.ceramic/working/weblocks-todomvc\\\" :executable t"
" #+sb-core-compression :compression #+sb-core-compression t)\")))"
"20: (SB-IMPL::TOPLEVEL-INIT)"
"21: ((FLET \"WITHOUT-INTERRUPTS-BODY-6\" :IN SB-EXT:SAVE-LISP-AND-DIE))"
"22: ((LABELS SB-IMPL::RESTART-LISP :IN SB-EXT:SAVE-LISP-AND-DIE))"
"Above backtrace due to this condition:"
"Component :WEBLOCKS-TODOMVC not found")
<INFO> [19:09:32] trivial-build slimeCUlUAR (boot-and-build) -
TRIVIAL-BUILD::TWO: 255
Ceramic: Compressing...
so it seems that the build can not find my component "weblocks-todomvc". Which I find surprising because my .asdf file compiles correctly, I can run a Ceramic window,…
Given the comments under this question, I make trivial-build load my package by adding (format nil "(load #p\"/home/vince/projets/weblocks-todomvc/weblocks-todomvc.asd/\"") in trivial-build:load-and-build-code and I get a different stacktrace:
------------ printing error messages:
<INFO> [21:49:12] trivial-build trivial-build.lisp (boot-and-build) -
TRIVIAL-BUILD::ZERO: NIL
<INFO> [21:49:12] trivial-build trivial-build.lisp (boot-and-build) -
TRIVIAL-BUILD::ONE: ("WARNING: Setting locale failed."
" Check the following variables for correct values:"
" LC_CTYPE=en_US.UTF-8" " LANG=fr_FR.UTF-8"
"Backtrace for: #<SB-THREAD:THREAD \"main thread\" RUNNING {10019BB783}>"
"0: ((LAMBDA NIL :IN UIOP/IMAGE:PRINT-BACKTRACE))"
"1: ((FLET \"THUNK\" :IN UIOP/STREAM:CALL-WITH-SAFE-IO-SYNTAX))"
"2: (SB-IMPL::%WITH-STANDARD-IO-SYNTAX #<CLOSURE (FLET \"THUNK\" :IN UIOP/STREAM:CALL-WITH-SAFE-IO-SYNTAX) {7FFFF70BF66B}>)"
"3: (UIOP/STREAM:CALL-WITH-SAFE-IO-SYNTAX #<CLOSURE (LAMBDA NIL :IN UIOP/IMAGE:PRINT-BACKTRACE) {1001EB3A2B}> :PACKAGE :CL)"
"4: (UIOP/IMAGE:PRINT-CONDITION-BACKTRACE
#<END-OF-FILE {1001EB3473}> :STREAM NIL :COUNT NIL)"
"5: ((LAMBDA (COMMON-LISP-USER::C COMMON-LISP-USER::H))
#<END-OF-FILE {1001EB3473}> #<unused argument>)"
"6: (SB-DEBUG::RUN-HOOK *DEBUGGER-HOOK*
#<END-OF-FILE {1001EB3473}>)"
"7: (INVOKE-DEBUGGER #<END-OF-FILE {1001EB3473}>)"
"8: (ERROR END-OF-FILE :STREAM #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}>)"
"9: (SB-IMPL::STRING-INCH #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}> T NIL)"
"10: (SB-IMPL::FLUSH-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}>)"
"11: (SB-IMPL::READ-LIST #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}> #<unused argument>)"
"12: (SB-IMPL::READ-MAYBE-NOTHING #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}> #\\()"
"13: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}> T (NIL) T)"
"14: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}> T (NIL) NIL)"
"15: (READ #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}> T NIL NIL)"
"16: (SB-IMPL::%READ-FROM-STRING \"(load #p\\\"/home/vince/projets/weblocks-todomvc/weblocks-todomvc.asd/\\\"\" T NIL 0 NIL NIL)"
"17: (SB-IMPL::PROCESS-EVAL/LOAD-OPTIONS ((:LOAD . \"/home/vince/quicklisp/setup.lisp\") (:EVAL . \"(setf *debugger-hook* #'(lambda (c h) (declare (ignore h)) (uiop:print-condition-backtrace c) (uiop:quit -1)))\") (:EVAL . \"NIL\") (:EVAL . \"(load #p\\\"/home/vince/projets/weblocks-todomvc/weblocks-todomvc.asd/\\\"\") (:EVAL . \"(ql:quickload :WEBLOCKS-TODOMVC)\") (:EVAL . \"(setf uiop:*image-entry-point* #'(lambda () (ceramic-entry::weblocks-todomvc)))\") (:EVAL . \"(uiop:dump-image #P\\\"/home/vince/.ceramic/working/weblocks-todomvc\\\" :executable t"
" #+sb-core-compression :compression #+sb-core-compression t)\")))"
"18: (SB-IMPL::TOPLEVEL-INIT)"
"19: ((FLET \"WITHOUT-INTERRUPTS-BODY-6\" :IN SB-EXT:SAVE-LISP-AND-DIE))"
"20: ((LABELS SB-IMPL::RESTART-LISP :IN SB-EXT:SAVE-LISP-AND-DIE))"
"Above backtrace due to this condition:"
"end of file on #<SB-IMPL::STRING-INPUT-STREAM {1001EB2F53}>")
<INFO> [21:49:12] trivial-build trivial-build.lisp (boot-and-build) -
TRIVIAL-BUILD::TWO: 255
[1]: https://i.stack.imgur.com/OxVHf.png
You need to:
pass :ignore-error-status t
define how you want to retrieve the error messages with :error-output (e.g. :lines)
Then, run-program won't signal an error but you have to check the error status (third value), and print/inspect the error message (second value).
RUN-PROGRAM returns 3 values:
0- the result of the OUTPUT slurping if any, or NIL
1- the result of the ERROR-OUTPUT slurping if any, or NIL
2- either 0 if the subprocess exited with success status,
or an indication of failure via the EXIT-CODE of the process
I came across Pavel's tutorial about writing a web app using CL and RESTAS as a frame work. While simple Hello, World! examples work. I am not able to get the blog example from chapter 4 running.
Using (restas:debug-mode-on) I end up with the following backtrace:
invalid number of arguments: 0
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
Restarts:
0: [ABORT] abort thread (#<THREAD "hunchentoot-worker-127.0.0.1:59876" RUNNING {1009975FD3}>)
Backtrace:
0: (BLOGDEMO::HTML-FRAME) [tl,external]
1: (RESTAS::ROUTE-RENDER-METHOD #<RESTAS:ROUTE {100A16FE53}>)
2: ((:METHOD RESTAS:PROCESS-ROUTE (RESTAS:ROUTE T)) #<RESTAS:ROUTE {100A16FE53}> NIL) [fast-method]
3: ((FLET CALL-NEXT-METHOD :IN "C:/Users/martin_b/portacle/quicklisp/dists/quicklisp/software/restas-20170124-git/src/route.lisp"))
4: ((:METHOD RESTAS:PROCESS-ROUTE :AROUND (ROUTES:BASE-ROUTE T)) #<RESTAS:ROUTE {100A16FE53}> NIL) [fast-method]
5: (RESTAS::RESTAS-DISPATCH-REQUEST #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<RESTAS::RESTAS-REQUEST {1003E5B383}>)
6: ((:METHOD HUNCHENTOOT:ACCEPTOR-DISPATCH-REQUEST (RESTAS:RESTAS-ACCEPTOR T)) #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<RESTAS::RESTAS-REQUEST {1003E5B383}>) [fast-method]
7: ((:METHOD HUNCHENTOOT:HANDLE-REQUEST (HUNCHENTOOT:ACCEPTOR HUNCHENTOOT:REQUEST)) #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<RESTAS::RESTAS-REQUEST {1003E5B383}>) [fast-method]
8: ((:METHOD HUNCHENTOOT:PROCESS-REQUEST (T)) #<RESTAS::RESTAS-REQUEST {1003E5B383}>) [fast-method]
9: ((FLET CALL-NEXT-METHOD :IN "C:/Users/martin_b/portacle/quicklisp/dists/quicklisp/software/restas-20170124-git/src/hunchentoot.lisp"))
10: ((:METHOD HUNCHENTOOT:PROCESS-REQUEST :AROUND (RESTAS::RESTAS-REQUEST)) #<RESTAS::RESTAS-REQUEST {1003E5B383}>) [fast-method]
11: ((LAMBDA NIL :IN HUNCHENTOOT:PROCESS-CONNECTION))
12: (HUNCHENTOOT::DO-WITH-ACCEPTOR-REQUEST-COUNT-INCREMENTED #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<CLOSURE (LAMBDA NIL :IN HUNCHENTOOT:PROCESS-CONNECTION) {1003C3439B}>)
13: ((:METHOD HUNCHENTOOT:PROCESS-CONNECTION (HUNCHENTOOT:ACCEPTOR T)) #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<USOCKET:STREAM-USOCKET {1009971333}>) [fast-method]
14: ((FLET CALL-NEXT-METHOD :IN "C:/Users/martin_b/portacle/quicklisp/dists/quicklisp/software/hunchentoot-1.2.35/acceptor.lisp"))
15: ((:METHOD HUNCHENTOOT:PROCESS-CONNECTION :AROUND (HUNCHENTOOT:ACCEPTOR T)) #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<USOCKET:STREAM-USOCKET {1009971333}>) [fast-method]
16: ((FLET HUNCHENTOOT::PROCESS-CONNECTION% :IN HUNCHENTOOT::HANDLE-INCOMING-CONNECTION%) #<RESTAS:RESTAS-ACCEPTOR (host *, port 8080)> #<USOCKET:STREAM-USOCKET {1009971333}>)
17: ((:METHOD HUNCHENTOOT::HANDLE-INCOMING-CONNECTION% (HUNCHENTOOT:ONE-THREAD-PER-CONNECTION-TASKMASTER T)) #<HUNCHENTOOT:ONE-THREAD-PER-CONNECTION-TASKMASTER {10081F24C3}> #<USOCKET:STREAM-USOCKET {1009..
18: ((LAMBDA NIL :IN HUNCHENTOOT:CREATE-REQUEST-HANDLER-THREAD))
19: ((LAMBDA NIL :IN BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS))
20: ((FLET #:WITHOUT-INTERRUPTS-BODY-1169 :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
21: ((FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE))
22: ((FLET #:WITHOUT-INTERRUPTS-BODY-359 :IN SB-THREAD::CALL-WITH-MUTEX))
23: (SB-THREAD::CALL-WITH-MUTEX #<CLOSURE (FLET SB-THREAD::WITH-MUTEX-THUNK :IN SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE) {6DAFB4B}> #<SB-THREAD:MUTEX "thread result lock" owner: #<SB-THREAD:THREAD "..
24: (SB-THREAD::INITIAL-THREAD-FUNCTION-TRAMPOLINE #<SB-THREAD:THREAD "hunchentoot-worker-127.0.0.1:59876" RUNNING {1009975FD3}> NIL #<CLOSURE (LAMBDA NIL :IN BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS) {..
25: ("foreign function: #x42BEFC")
26: ("foreign function: #x4038C1")
27: ("foreign function: #x447080")
Obviously, there is a problem between the number of arguments the function html-frame is expecting and the number it is called using render-method. I checked the source and the RESTAS docs (which seem to be slightly out-dated) but could not understand what to change.
Is someone using RESTAS? Are there other up-to-date real life examples available one could study to learn? My impressions from Cliki was that there are several web-frameworks around but I found it hard to see which are actually used and maintained.
I fixed this by changing back his:
(defun start-blogdemo (&optional (port 8080))
(start '#:blogdemo :port port :render-method 'html-frame))
To:
(defun start-blogdemo (&optional (port 8080))
(start '#:blogdemo :port port))
in util.lisp.
Then you need to make each of your routes in blogdemo.lisp read not like:
(define-route home ("")
(list :title "Blogdemo"
:body (mapcar #'render-post *posts*)))
But instead like:
(define-route home ("")
(html-frame
(list :title "Blogdemo"
:body (mapcar #'render-post *posts*))))
The origin of this solution is that I didn't entirely understand the correctness of abstraction he was making (and wrangled quite a bit about on p37, which he also discusses here) so I reversed that and it worked.
Note also that the route add should look as below (the form with :requirement needs to come before html-frame, the latter being the last form hence the return value).
(define-route add ("add")
(:requirement #'logged-on-p)
(html-frame
(list :title "Add a blog post"
:body (add-post-form))))
Likewise, the :sift-variables forms should also come first in author & post routes, just like :requirement. Then the whole app should work for you.
(defun foo (&aux (defvar x 10))
(print x))
defines a local variable X, just like a LET would do.
same function if written in a file and then compiled on sbcl as: sbcl --script file.lisp
gives error:
; in: DEFUN FOO
; (DEFUN FOO (&AUX (DEFVAR X 10)) (PRINT X))
; --> PROGN SB-INT:NAMED-LAMBDA
; ==>
; #'(SB-INT:NAMED-LAMBDA FOO
; (&AUX (DEFVAR X 10))
; (BLOCK FOO (PRINT X)))
;
; caught ERROR:
; malformed &AUX binding specifier: (DEFVAR X 10)
;
; compilation unit finished
; caught 1 ERROR condition
unhandled SB-INT:COMPILED-PROGRAM-ERROR in thread #<SB-THREAD:THREAD
"main thread" RUNNING
{10029B8FC3}>:
Execution of a form compiled with errors.
Form:
#'(NAMED-LAMBDA FOO
(&AUX (DEFVAR X 10))
(BLOCK FOO (PRINT X)))
Compile-time error:
malformed &AUX binding specifier: (DEFVAR X 10)
0: (SB-DEBUG::MAP-BACKTRACE
#<CLOSURE (LAMBDA # :IN BACKTRACE) {1002A39DEB}>
:START
0
:COUNT
128)
1: (BACKTRACE 128 #<SB-SYS:FD-STREAM for "standard error" {10029BA863}>)
2: (SB-DEBUG::DEBUGGER-DISABLED-HOOK
#<SB-INT:COMPILED-PROGRAM-ERROR {1002A373D3}>
#<unavailable argument>)
3: (SB-DEBUG::RUN-HOOK
*INVOKE-DEBUGGER-HOOK*
#<SB-INT:COMPILED-PROGRAM-ERROR {1002A373D3}>)
4: (INVOKE-DEBUGGER #<SB-INT:COMPILED-PROGRAM-ERROR {1002A373D3}>)
5: (ERROR
SB-INT:COMPILED-PROGRAM-ERROR
:MESSAGE
"malformed &AUX binding specifier: (DEFVAR X 10)"
:SOURCE
"#'(NAMED-LAMBDA FOO
(&AUX (DEFVAR X 10))
(BLOCK FOO (PRINT X)))")
6: (#:EVAL-THUNK)
7: (SB-INT:SIMPLE-EVAL-IN-LEXENV
(SB-INT:NAMED-LAMBDA FOO
(&AUX (DEFVAR X 10))
(BLOCK FOO (PRINT X)))
#<NULL-LEXENV>)
8: (SB-INT:SIMPLE-EVAL-IN-LEXENV
(SB-IMPL::%DEFUN 'FOO
(SB-INT:NAMED-LAMBDA FOO
(&AUX (DEFVAR X 10))
(BLOCK FOO (PRINT X)))
NIL 'NIL (SB-C:SOURCE-LOCATION))
#<NULL-LEXENV>)
9: (SB-INT:SIMPLE-EVAL-IN-LEXENV
(EVAL-WHEN (:LOAD-TOPLEVEL :EXECUTE)
(SB-IMPL::%DEFUN 'FOO
(SB-INT:NAMED-LAMBDA FOO
(&AUX (DEFVAR X 10))
(BLOCK FOO (PRINT X)))
NIL 'NIL (SB-C:SOURCE-LOCATION)))
#<NULL-LEXENV>)
10: (SB-INT:SIMPLE-EVAL-IN-LEXENV
(DEFUN FOO (&AUX (DEFVAR X 10)) (PRINT X))
#<NULL-LEXENV>)
11: (EVAL-TLF (DEFUN FOO (&AUX (DEFVAR X 10)) (PRINT X)) 7 #<NULL-LEXENV>)
12: ((FLET SB-FASL::EVAL-FORM :IN SB-INT:LOAD-AS-SOURCE)
(DEFUN FOO (&AUX (DEFVAR X 10)) (PRINT X))
7)
13: (SB-INT:LOAD-AS-SOURCE
#<SB-SYS:FD-STREAM for "file /home/student/3357/fib.lisp" {10029C1513}>
:VERBOSE
NIL
:PRINT
NIL
:CONTEXT
"loading")
14: ((FLET SB-FASL::LOAD-STREAM :IN LOAD)
#<SB-SYS:FD-STREAM for "file /home/student/3357/fib.lisp" {10029C1513}>
NIL)
15: (LOAD
#<SB-SYS:FD-STREAM for "file /home/student/3357/fib.lisp" {10029C1513}>
:VERBOSE
NIL
:PRINT
NIL
:IF-DOES-NOT-EXIST
T
:EXTERNAL-FORMAT
:DEFAULT)
16: ((FLET SB-IMPL::LOAD-SCRIPT :IN SB-IMPL::PROCESS-SCRIPT)
#<SB-SYS:FD-STREAM for "file /home/student/3357/fib.lisp" {10029C1513}>)
17: ((FLET #:WITHOUT-INTERRUPTS-BODY-5599 :IN SB-IMPL::PROCESS-SCRIPT))
18: (SB-IMPL::PROCESS-SCRIPT "fib.lisp")
19: (SB-IMPL::TOPLEVEL-INIT)
20: ((FLET #:WITHOUT-INTERRUPTS-BODY-236911 :IN SAVE-LISP-AND-DIE))
21: ((LABELS SB-IMPL::RESTART-LISP :IN SAVE-LISP-AND-DIE))
unhandled condition in --disable-debugger mode, quitting
what is the problem with old version of assigning the variable &aux ?
If we look at the syntax of lambda lists, we see this:
lambda-list::= (var*
[&optional {var | (var [init-form [supplied-p-parameter]])}*]
[&rest var]
[&key {var | ({var | (keyword-name var)}
[init-form [supplied-p-parameter]])}*
[&allow-other-keys]]
[&aux {var | (var [init-form])}*])
Above is the syntax for argument list declarations for normal functions.
If you look at your form, you might want to find out what the symbol DEFVAR is supposed to do and if it makes any sense in a lambda list...
Let's run try it in a REPL
* (defun foo (&aux (defvar x 10))
(print x))
; in: DEFUN FOO
; (SB-INT:NAMED-LAMBDA FOO
; (&AUX (DEFVAR X 10))
; (BLOCK FOO (PRINT X)))
;
; caught ERROR:
; malformed &AUX binding specifier: (DEFVAR X 10)
debugger invoked on a SB-INT:SIMPLE-PROGRAM-ERROR:
malformed &AUX binding specifier: (DEFVAR X 10)
SBCL clearly detects the syntax error.
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