How to use IF condition with AND operator?
I'm getting an error
(princ"Enter a year: ")
(defvar y(read))
(defun leap-year(y)
(if(and(= 0(mod y 400)(= 0(mod y 4))
(print"Is a leap year"))
(print"Is not"))))
(leap-year y)
Note that your code should ideally look like this:
(princ "Enter a year: ")
(finish-output) ; make sure that output is done
(defvar *year* ; use the usual naming convention for
; global variables.
(let ((*read-eval* nil)) ; don't run code during reading
(read)))
(defun leap-year-p (y)
; your implementation here
; return a truth value
)
(print (if (leap-year-p *year*) "yes" "no"))
Alternatively it also is a good idea to not work on the top-level with function calls and global variables. Write procedures/functions for everything. That way your code automatically is more modular, testable and reusable.
(defun prompt-for-year ()
(princ "Enter a year: ")
(finish-output)
(let ((*read-eval* nil))
(read)))
(defun leap-year-p (y)
; your implementation here
; return a truth value
)
(defun check-leap-year ()
(print (if (leap-year-p (prompt-for-year))
"yes"
"no")))
(check-leap-year)
How often happens in lisp languages, the problem is in missing (or extra) parentheses.
In your case you have multiple parentheses issues in the definition of the function, which should be:
(defun leap-year (y)
(if (and (= 0 (mod y 400)) (= 0(mod y 4)))
(print "Is a leap year")
(print "Is not")))
A good discipline on expression alignments and a good program editor like for instance Emacs are in fact very important (I would say “essential”) in programming in these languages.
Note that if you use the function in a REPL, you could omit the print:
(defun leap-year (y)
(if (and (= 0 (mod y 400)) (= 0(mod y 4)))
"Is a leap year"
"Is not"))
Finally, note that the check for a leap year is incorrect. A correct definition could be the following:
(defun leap-year (y)
(cond ((/= 0 (mod y 4)) "no")
((/= 0 (mod y 100)) "yes")
((/= 0 (mod y 400)) "no")
(t "yes")))
or, with the if:
(defun leap-year (y)
(if (or (and (zerop (mod y 4))
(not (zerop (mod y 100))))
(zerop (mod y 400)))
"yes"
"no"))
Related
I am learning Lisp and, just for practice/education, am trying to define a function that will
ask the user to enter a number until they enter an integer > 0 [copied from Paul Graham's Ansi Common Lisp]
print that number and subtract 1 from it, repeat until the number hits 0, then return.
I am trying to do this via passing 2 functions into a higher-order function - one to get the number from the user, and another recursive [just for fun] function that prints the number while counting it down to 0.
Right now my higher-order function is not working correctly [I've tested the first 2 and they work fine] and I cannot figure out why. I am using SBCL in SLIME. My code for the 3 functions looks like this:
(defun ask-number ()
(format t "Please enter a number. ")
(let ((val (read))) ; so val is a single-item list containing the symbol 'read'?
(cond ; no here read is a function call
((numberp val)
(cond
((< val 0) (ask-number))
(T val)))
(t (ask-number))))))
(defun count-down (n)
(cond
((eql n 0) n)
(t
(progn
(format t "Number is: ~A ~%" n)
(let ((n (- n 1)))
(count-down n))))))
(defun landslide (f1 f2)
(let (x (f1))
(progn
(format t "x is: ~A ~%" x)
(f2 x)))))
but calling slime-eval-defun in landslide yields:
; SLIME 2.27; in: DEFUN LANDSLIDE
; (F1)
;
; caught STYLE-WARNING:
; The variable F1 is defined but never used.
; (SB-INT:NAMED-LAMBDA LANDSLIDE
; (F1 F2)
; (BLOCK LANDSLIDE
; (LET (X (F1))
; (PROGN (FORMAT T "x is: ~A ~%" X) (F2 X)))))
;
; caught STYLE-WARNING:
; The variable F1 is defined but never used.
;
; caught STYLE-WARNING:
; The variable F2 is defined but never used.
; in: DEFUN LANDSLIDE
; (F2 X)
;
; caught STYLE-WARNING:
; undefined function: COMMON-LISP-USER::F2
;
; compilation unit finished
; Undefined function:
; F2
; caught 4 STYLE-WARNING conditions
I have tried several [what I consider] obvious modifications to the code, and they all fail with different warnings. Calling the function like (landslide (ask-number) (count-down)), ask-number prompts for user input as expected, but then SLIME fails with
invalid number of arguments: 0
[Condition of type SB-INT:SIMPLE-PROGRAM-ERROR]
I know I have to be missing something really obvious; can someone tell me what it is?
First: You are missing a set of parens in your let:
You have (let (x (f1)) ...) which binds 2 variables x and f1 to nil.
What you want is (let ((x (f1))) ...) which binds 1 variable x to the values of function call (f1)
Second: Common Lisp is a "lisp-2", so to call f2 you need to use funcall: (funcall f2 ...).
Finally: all your progns are unnecessary, and your code is hard to read because of broken indentation, you can use Emacs to fix it.
Before I reach an error in landslide, there are some notes about this code:
Your first function is hard to read- not just because of indentation, but because of nested cond.
You should always think about how to simplify condition branches- using and, or, and if you have only two branches of code, use if instead.
There are predicates plusp and minusp.
Also, don't forget to flush.
I'd rewrite this as:
(defun ask-number ()
(format t "Please enter a number. ")
(finish-output)
(let ((val (read)))
(if (and (numberp val)
(plusp val))
val
(ask-number))))
Second function, count-down.
(eql n 0) is zerop
cond here has only two branches, if can be better
cond has implicit progn, so don't use progn inside cond
let is unnecessary here, you can use 1- directly when you call count-down
Suggested edit:
(defun count-down (n)
(if (zerop n) n
(progn
(format t "Number is: ~A ~%" n)
(count-down (1- n)))))
Also, this function can be rewritten using loop and downto keyword, something like:
(defun count-down (n)
(loop for i from n downto 0
do (format t "Number is: ~A ~%" i)))
And finally, landslide. You have badly formed let here and as Common Lisp is Lisp-2, you have to use funcall. Note that let has also implicit progn, so you can remove your progn:
(defun landslide (f1 f2)
(let ((x (funcall f1)))
(format t "x is: ~A ~%" x)
(finish-output)
(funcall f2 x)))
Then you call it like this:
(landslide #'ask-number #'count-down)
I'm new to lisp programming and I'm trying to create a program that accept six numbers and check whether each number is either odd or even number.
(princ"Input six number: ")
(setq a(read))
(setq b(read))
(setq c(read))
(setq d(read))
(setq e(read))
(setq f(read))
(format t "~% ~d" a)
(format t "~% ~d" b)
(format t "~% ~d" c)
(format t "~% ~d" d)
(format t "~% ~d" e)
(format t "~% ~d" f)
(if(= 0(mod a 2))
(print"even")
(print"odd"))
(if(= 0(mod b 2))
(print"even")
(print"odd"))
(if(= 0(mod c 2))
(print"even")
(print"odd"))
(if(= 0(mod d 2))
(print"even")
(print"odd"))
(if(= 0(mod e 2))
(print"even")
(print"odd"))
(if(= 0(mod f 2))
(print"even")
(print"odd"))
(terpri)
You have a lot of code that looks like this:
(if(= 0(mod ... 2))
(print"even")
(print"odd"))
(this might be a copy/paste problem but in your question they are indented more and more to the right. They are however not nested, they are all at the same depth (they are toplevel expressions) so by convention they should not be indented).
A first step would be to factor them using a function like this one:
(defun check-even-odd (number)
(if (= 0 (mod number 2))
(print "even")
(print "odd")))
The above defines a function named check-even-odd of one parameter number, and it applies the same logic you originally had for any arbitrary number.
The rest of your code can be simplified as:
(check-even-odd a)
(check-even-odd b)
(check-even-odd c)
(check-even-odd d)
(check-even-odd e)
(check-even-odd f)
Now, you can define two additional global variables:
(defparameter total-even 0)
(defparameter total-odd 0)
Each of them holds a sum, and is initialized to 0.
You can rewrite the check-even-odd function as follows to update the counters. First of all, let's just rewrite the current code by using cond, since we are going to need to perform multiple actions in each case, and if only accepts one expression for each branch (the combination if and progn is a bit ugly):
(defun check-even-odd (number)
(cond
((= 0 (mod number 2))
(print "even"))
(t
(print "odd"))))
This above behaves as the original code.
In order to increment a variable by a certain amount, you can use INCF:
(defun check-even-odd (number)
(cond
((= 0 (mod number 2))
(print "even")
(incf total-even number))
(t
(print "odd")
(incf total-odd number))))
When you execute your whole script, the total will be initialized to zero, then each call to check-even-odd will add the number to the appropriate counter.
Notes:
You may find other places where you can use functions to abstract duplicated code
You should use defparameter instead of setq when initializing a, b, etc, because otherwise the variables are not declared and calling setq on undeclared variables is not standard
In fact, it is possible to rewrite the whole program without having any global state, this could be a good next exercise
You can generalize for less or more numbers instead of 6, you would need to write a loop or a recursive function to repeat the same code an arbitrary amount of time
Input/output may need to be flushed (see finish-output, clear-input) otherwise you could experience strange behavior when the underlying stream is buffered.
I'm new to lisp, and have been trying to learn Common Lisp by diving in and writing some code. I've read plenty of documentation on the subject, but it's taking a while to really sink in.
I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty. The code is at the end of the post, to avoid cluttering the actual question.
Here is an example of usage:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
And an example of output:
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
Now, the existing code works. Unfortunately, the (? ...) macro is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?
I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
Output:
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.
Also, I'll be wanting to handle exceptions in the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.
I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?
Can anyone help me out here, please?
A complete code listing follows:
(defmacro with-gensyms ((&rest names) &body body)
`(let ,(loop for n in names collect `(,n (gensym)))
,#body))
(defmacro while (condition &body body)
`(loop while ,condition do (progn ,#body)))
(defun flatten (L)
"Converts a list to single level."
(if (null L)
nil
(if (atom (first L))
(cons (first L) (flatten (rest L)))
(append (flatten (first L)) (flatten (rest L))))))
(defun starts-with-p (str1 str2)
"Determine whether `str1` starts with `str2`"
(let ((p (search str2 str1)))
(and p (= 0 p))))
(defmacro pop-first-char (string)
`(with-gensyms (c)
(if (> (length ,string) 0)
(progn
(setf c (schar ,string 0))
(if (> (length ,string) 1)
(setf ,string (subseq ,string 1))
(setf ,string ""))))
c))
(defmacro pop-chars (string count)
`(with-gensyms (result)
(setf result ())
(dotimes (index ,count)
(push (pop-first-char ,string) result))
result))
(defun format-ansi-codes (text)
(let ((result ()))
(while (> (length text) 0)
(cond
((starts-with-p text "\\e")
(push (code-char #o33) result)
(pop-chars text 2)
)
((starts-with-p text "\\r")
(push (code-char 13) result)
(pop-chars text 2)
)
(t (push (pop-first-char text) result))
))
(setf result (nreverse result))
(coerce result 'string)))
(defun kv-lookup (values key)
"Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
(setf key (if (typep key 'cons) (nth 1 key) key))
(while values
(let ((k (pop values)) (v (pop values)))
(setf k (if (typep k 'cons) (nth 1 k) k))
(if (eql (symbol-name key) (symbol-name k))
(return v)))))
(defun make-ansi-escape (ansi-name)
(let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
:red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
:cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
:bg-dark-grey "\\e[100m"
:bold "\\e[1m" :underline "\\e[4m"
:start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
(format-ansi-codes (kv-lookup ansi-codes ansi-name))
))
(defun format-ansi-escaped-arg (out-stream arg)
(cond
((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
((typep arg 'string) (format out-stream arg))
(t (format out-stream "~a" arg))
))
(defun format-ansi-escaped (out-stream &rest args)
(while args
(let ((arg (pop args)))
(if (typep arg 'list)
(let ((first-arg (eval (first arg))))
(format out-stream first-arg (second arg))
)
(format-ansi-escaped-arg out-stream arg)
))
))
(defmacro while-pop ((var sequence &optional result-form) &rest forms)
(with-gensyms (seq)
`(let (,var)
(progn
(do () ((not ,sequence))
(setf ,var (pop ,sequence))
(progn ,#forms))
,result-form))))
(defun report-start (form)
(format t "( ) '~a'~%" form))
(defun report-result (result form)
(format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
result)
(defmacro ? (name &body body-forms)
"Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
(with-gensyms (result indent indent-string)
(if (not body-forms)
:empty
(progn
(setf result () indent 0 indent-string " ")
(cond
((typep (first body-forms) 'integer)
(setf indent (pop body-forms))))
`(progn
(format t "~v#{~A~:*~}" ,indent ,indent-string)
(format-ansi-escaped t "[" :white ,name :normal "]~%")
(with-gensyms (test-results)
(setf test-results ())
,(while-pop (body-form body-forms `(progn ,#(nreverse result)))
(cond
( (EQL (first body-form) '?)
(push `(progn
(setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,#(nthcdr 2 body-form))))
(format t "~%")
test-results
) result)
)
(t
(push `(progn
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(report-start ',body-form)
(with-gensyms (result label)
(setf result ,body-form)
(format-ansi-escaped t :move-up :start-of-line :clear-line)
(format t "~v#{~A~:*~}" ,(1+ indent) ,indent-string)
(push (report-result result ',body-form) test-results)
test-results
)) result))))))))))
(defun ?? (&rest results)
"Run any number of tests, and print a summary afterward"
(setf results (flatten results))
(format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
(if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
:yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
:brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
:normal "~%"))
For my part, the ? macro is rather technical and it's hard to follow the logic behind the formatting functions. So instead of tracking errors I'd like to suggest my own attempt, perhaps it'll be of use.
I think that actually your ?? doesn't want to evaluate anything, but rather to treat its body as individual tests or sections. If the body includes a list starting with ?, this list represents a section; other elements are test forms optionally followed by descriptions. So in my implementation ?? will be a macro, and ? will be just a symbol.
I start with wishful thinking. I suppose I can create individual tests using a function make-test-item and test sections using a function make-test-section (their implementation is unimportant for now), that I can display them using an auxiliary function display-test and compute results using the function results, which returns two values: the total number of tests and the number of passed ones. Then I'd like the code
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
to expand into something like
(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
Here a list of tests is created; then we traverse it printing each test (0 denotes the zero level of indentation and t is as in format) and keeping track of the results, finally displaying the total results. I don't think explicit eval is needed here.
It may not be the most exquisite piece of code ever, but it seems manageable. I supply missing definitions below, they are rather trivial (and can be improved) and have nothing to do with macros.
Now we pass on to the macros. Consider both pieces of code as data, then we want a list processing function which would turn the first one into the second. A few auxiliary functions would come in handy.
The major task is to parse the body of ?? and generate the list of test to go inside the let.
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,#items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
Here parse-test essentially absorbs the syntax of ??. Each iteration consumes one or two forms and collects corresponding make-... forms. The functions can be easily tested in REPL (and, of course, I did test them while writing).
Now the macro becomes quite simple:
(defmacro ?? (&body body)
`(let ((tests (list ,#(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
It captures a few symbols, both in the variable name space and in the function one (the expansion may contain make-test-item and make-test-section). A clean solution with gensyms would be cumbersome, so I'd suggest just moving all the definitions in a separate package and exporting only ?? and ?.
For completeness, here is an implementation of the test API. Actually, it's what I started coding with and proceeded until I made sure the big let-form works; then I passed on to the macro part. This implementation is fairly sloppy; in particular, it doesn't support terminal colours and display-test can't even output a section into a string.
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
All the code is licenced under WTFPL.
For Project Euler Problem 8, I am told to parse through a 1000 digit number.
This is a brute-force Lisp solution, which basically goes through every 5 consecutive digits and multiplies them from start to finish, and returns the largest one at the end of the loop.
The code:
(defun pep8 ()
(labels ((product-of-5n (n)
(eval (append '(*)
(loop for x from n to (+ n 5)
collect (parse-integer
1000digits-str :start x :end (+ x 1)))))))
(let ((largestproduct 0))
(do ((currentdigit 0 (1+ currentdigit)))
((> currentdigit (- (length 1000digits-str) 6)) (return largestproduct))
(when (> (product-of-5n currentdigit) largestproduct)
(setf largestproduct (product-of-5n currentdigit)))))))
It compiles without any warnings, but upon running it I get:
no non-whitespace characters in string "73167176531330624919225119674426574742355349194934...".
[Condition of type SB-INT:SIMPLE-PARSE-ERROR]
I checked to see if the local function product-of-5n was working by writing it again as a global function:
(defun product-of-5n (n)
(eval (append '(*)
(loop for x from n to (+ n 5)
collect (parse-integer
1000digits-str :start x :end (+ x 1))))))
This compiled without warnings and upon running it, appears to operate perfectly. For example,
CL_USER> (product-of-5n 1) => 882
Which appears to be correct since the first five digits are 7, 3, 1, 6 and 7.
As for 1000digits-str, it was simply compiled with defvar, and with Emacs' longlines-show-hard-newlines, I don't think there are any white-space characters in the string, because that's what SBCL is complaining about, right?
I don't think there are any white-space characters in the string, because that's what SBCL is complaining about, right?
The error-message isn't complaining about the presence of white-space, but about the absence of non-white-space. But it's actually a bit misleading: what the message should say is that there's no non-white-space in the specific substring to be parsed. This is because you ran off the end of the string, so were parsing a zero-length substring.
Also, product-of-5n is not defined quite right. It's just happenstance that (product-of-5n 1) returns the product of the first five digits. Strings are indexed from 0, so (product-of-5n 1) starts with the second character; and the function iterates from n + 0 to n + 5, which is a total of six characters; so (product-of-5n 1) returns 3 × 1 × 6 × 7 × 1 × 7, which happens to be the same as 7 × 3 × 1 × 6 × 7 × 1.
EVAL is not a good idea.
Your loop upper bound is wrong.
Otherwise I tried it with the number string and it works.
It's also Euler 8, not 9.
This is my version:
(defun euler8 (string)
(loop for (a b c d e) on (map 'list #'digit-char-p string)
while e maximize (* a b c d e)))
since I don't know common lisp, I slightly modified your code to fit with elisp. As far as finding bugs go and besides what have been said ((product-of-5n 1) should return 126), the only comment I have is that in (pep8), do length-4 instead of -6 (otherwise you loose last 2 characters). Sorry that I don't know how to fix your parse-error (I used string-to-number instead), but here is the code in case you find it useful:
(defun product-of-5n (n) ;take 5 characters from a string "1000digits-str" starting with nth one and output their product
(let (ox) ;define ox as a local variable
(eval ;evaluate
(append '(*) ;concatenate the multiplication sign to the list of 5 numbers (that are added next)
(dotimes (x 5 ox) ;x goes from 0 to 4 (n is added later to make it go n to n+4), the output is stored in ox
(setq ox (cons ;create a list of 5 numbers and store it in ox
(string-to-number
(substring 1000digits-str (+ x n) (+ (+ x n) 1) ) ;get the (n+x)th character
) ;end convert char to number
ox ) ;end cons
) ;end setq
) ;end dotimes, returns ox outside of do, ox has the list of 5 numbers in it
) ;end append
) ;end eval
) ;end let
)
(defun pep8 () ;print the highest
(let ((currentdigit 0) (largestproduct 0)) ;initialize local variables
(while (< currentdigit (- (length 1000digits-str) 4) ) ;while currentdigit (cd from now on) is less than l(str)-4
;(print (cons "current digit" currentdigit)) ;uncomment to print cd
(when (> (product-of-5n currentdigit) largestproduct) ;when current product is greater than previous largestproduct (lp)
(setq largestproduct (product-of-5n currentdigit)) ;save lp
(print (cons "next good cd" currentdigit)) ;print cd
(print (cons "with corresponding lp" largestproduct)) ;print lp
) ;end when
(setq currentdigit (1+ currentdigit)) ;increment cd
) ;end while
(print (cons "best ever lp" largestproduct) ) ;print best ever lp
) ;end let
)
(setq 1000digits-str "73167176531330624919")
(product-of-5n 1)
(pep9)
which returns (when ran on the first 20 characters)
"73167176531330624919"
126
("next good cd" . 0)
("with corresponding lp" . 882)
("next good cd" . 3)
("with corresponding lp" . 1764)
("best ever lp" . 1764)
I've done this problem some time ago, and there's one thing you are missing in the description of the problem. You need to read consequent as starting at any offset into a sting, not only the offsets divisible by 5. Therefore the solution to the problem will be more like the following:
(defun pe-8 ()
(do ((input (remove #\Newline
"73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450"))
(tries 0 (1+ tries))
(result 0))
((= tries 5) result)
(setq result
(max result
(do ((max 0)
(i 0 (+ 5 i)))
((= i (length input)) max)
(setq max
(do ((j i (1+ j))
(current 1)
int-char)
((= j (+ 5 i)) (max current max))
(setq int-char (- (char-code (aref input j)) 48))
(case int-char
(0 (return max))
(1)
(t (setq current (* current int-char))))))))
input (concatenate 'string (subseq input 1) (subseq input 0 1)))))
It's a tad ugly, but it illustrates the idea.
EDIT sorry, I've confused two of your functions. So that like was incorrect.
Learning Common Lisp (using GNU CLISP 2.43) .. so might be a noob mistake. Example is the 'print prime numbers between x and y'
(defun is-prime (n)
(if (< n 2) (return-from is-prime NIL))
(do ((i 2 (1+ i)))
((= i n) T)
(if (= (mod n i) 0)
(return NIL))))
(defun next-prime-after (n)
(do ((i (1+ n) (1+ i)))
((is-prime i) i)))
(defmacro do-primes-v2 ((var start end) &body body)
`(do ((,var (if (is-prime ,start)
,start
(next-prime-after ,start))
(next-prime-after ,var)))
((> ,var ,end))
,#body))
(defmacro do-primes-v3 ((var start end) &body body)
(let ((loop-start (gensym))
(loop-end (gensym)))
`(do ((,loop-start ,start)
(,loop-end ,end)
(,var (if (is-prime ,loop-start)
,loop-start
(next-prime-after ,loop-start))
(next-prime-after ,var)))
((> ,var ,loop-end))
,#body )))
do-primes-v2 works perfectly.
[13]> (do-primes-v2 (p 10 25) (format t "~d " p))
11 13 17 19 23
Next I tried using gensym to avoid naming clashes in macro expansion - do-primes-v3. However I'm stuck with a
*** - EVAL: variable #:G3498 has no value
Tried using macro-expand to see if i could spot the mistake but I can't.
[16]> (macroexpand-1 `(do-primes-v3 (p 10 25) (format t "~d " p)))
(DO
((#:G3502 10) (#:G3503 25)
(P (IF (IS-PRIME #:G3502) #:G3502 (NEXT-PRIME-AFTER #:G3502))
(NEXT-PRIME-AFTER P)))
((> P #:G3503)) (FORMAT T "~d " P)) ;
Use DO* instead of DO.
DO Initializes the bindings in a scope where they are not yet visible. DO* initializes the bindings in a scope where they are visible.
In this particular case var needs to reference the other binding loop-start.
You don't actually need the gensym here for avoiding variable capture, because you do not introduce any variables that would be "local to the macro". When you macroexpand your do-primes-v2, you will see that no variable is introduced that didn't exist outside of the macro.
You do need it for a different thing, though: avoiding multiple evaluation.
If you call the macro like this:
(do-primes-v2 (p (* x 2) (* y 3))
(format "~a~%" p))
it expands to
(do ((p (if (is-prime (* x 2))
(* x 2)
(next-prime-after (* x 2))
(next-prime-after p)))
((> p (* y 3))
(format "~a~%" p))
At best, this is inefficient, because those multiplications are done multiple times. However, if you use a function with side effects as inputs, like setf or incf, this can be a big problem.
Either move the binding of your loop-start and loop-end to an enclosing LET block or use DO*. The reason is that all loop variables in DO are bound "in parallel", so for the first binding, the (expanded) loop-start variable does not yet have a binding.
I know this doesn't really answer your question, but I do think it is relevant. In my experience, the type of macro you are attempting to write is a very common one. One problem I have with the way you have approached the problem is that it doesn't handle another common use case: functional composition.
I don't have the time to highlight some of the difficulties you will probably encounter using your macro, I will however highlight that, had you built your prime iterator geared towards functional composition, your macro turns out to be extremely simple, avoiding your question altogether.
Note: I have slightly modified some of your functions.
(defun is-prime (n)
(cond
((< n 2)
nil)
((= n 2)
t)
((evenp n)
nil)
(t
(do ((i 2 (1+ i)))
((= i n) t)
(when (or (= (mod n i) 0))
(return nil))))))
(defun next-prime (n)
(do ((i n (1+ i)))
((is-prime i) i)))
(defun prime-iterator (start-at)
(let ((current start-at))
(lambda ()
(let ((next-prime (next-prime current)))
(setf current (1+ next-prime))
next-prime))))
(defun map-primes/iterator (fn iterator end)
(do ((i (funcall iterator) (funcall iterator)))
((>= i end) nil)
(funcall fn i)))
(defun map-primes (fn start end)
(let ((iterator (prime-iterator start)))
(map-primes/iterator fn iterator end)))
(defmacro do-primes ((var start end) &body body)
`(map-primes #'(lambda (,var)
,#body)
,start ,end))
I too recommend that you look at Series. The generator pattern is also a very common occurrence in lisp programs. You may also want to look at Alexandria, in particular the function ALEXANDRIA:COMPOSE to see what cool stuff you can do with functional composition.
I suggest avoiding DO/DO* and macros altogether and instead going for Series (an implementation of which can be found on series.sourceforge.net).
If that's too complex then consider just generating a list of primes with recursion or a generator (for on-demand generation).