How to loop using recursion in ACL2? - lisp

I need to make something like this but in ACL2:
for (i=1; i<10; i++) {
print i;
}
It uses COMMON LISP, but I haven't any idea how to do this task...
We can't use standard Common Lisp constructions such as LOOP, DO. Just recursion.
I have some links, but I find it very difficult to understand:
Gentle Intro to ACL2 Programming

The section "Visiting all the natural numbers from n to 0" in A Gentle Introduction to ACL2 Programming explains how to do it.
In your case you want to visit numbers in ascending order, so your code should look something like this:
(defun visit (n max ...)
(cond ((> n max) ...) ; N exceeds MAX: nothing to do.
(t . ; N less than or equal to MAX:
. n ; do something with N, and
.
(visit (+ n 1) max ...) ; visit the numbers above it.
.
.
.)))

A solution that uses recursion:
> (defun for-loop (from to fn)
(if (<= from to)
(progn
(funcall fn from)
(for-loop (+ from 1) to fn))))
;; Test
> (for-loop 1 10 #'(lambda (i) (format t "~a~%" i)))
1
2
3
4
5
6
7
8
9
10
NIL

(defun foo-loop (n)
(cond ((zp n) "done")
(t (prog2$ (cw "~x0" n)
(foo-loop (1- n)))))
(foo-loop 10)
You can redo the termination condition and the recursion to mimic going from 1 to 10.

Related

Common Lisp - SLIME in infinte loop

I have started to learn Common Lisp a few days ago reading the book from Peter Seibel. I have downloaded the lispbox-0.7 for Windows and tried out some of the concepts in the SLIME REPL.
Now I'm at chapter 7. Macros and Standard Control Structures / Loops and I found this intressting do expression for the 11th Fibonacci number
(do ((n 0 (1+ n))
(cur 0 next)
(next 1 (+ cur next)))
((= 10 n) cur))
I defined following function
(defun fib (n) (do ((i 1 (1+ i)) (cur 0 next) (next 1 (+ cur next))) ((= n i) cur)))
The function does what I expected and returns the nth Fibonacci number. Now for curiosity i tried summing the first 10 fibonacci numbers using a dotimes loop
(let ((sum 0)) (dotimes (k 10) (setf sum (+ sum (fib k)))) sum)
But this expression runs indefinitly and i don't understand why. Maybe here is another concept I don't know. I tried a simpler example like
(dotimes (k 10) (fib k))
which should return NIL. But this also runs indefinitly. Can someone explain to me what I am missing?
Thx
Ok, nevermind, was not carefull enougth. the code tries to evaluate fib 0, but the test condition in do cannot be fulfilled. Thats why it runs indefinitly
fixing it by (fib (+ k 1))

Convert decimal number to octal in Lisp

I'm trying to write a function in Common Lisp to convert a base 10 number into a base 8 number, represented as a list, recursively.
Here's what I have so far:
(defun base8(n)
(cond
((zerop (truncate n 8)) (cons n nil))
((t) (cons (mod n 8) (base8 (truncate n 8))))))
This function works fine when I input numbers < 8 and > -8, but the recursive case is giving me a lot of trouble. When I try 8 as an argument (which should return (1 0)), I get an error Undefined operator T in form (T).
Thanks in advance.
Just for fun, here's a solution without recursion, using built-in functionality:
(defun base8 (n)
(reverse (coerce (format nil "~8R" n) 'list)))
It seems you have forgotten to (defun t ...) or perhaps it's not the function t you meant to have in the cond? Perhaps it's t the truth value?
The dual namespace nature of Common Lisp makes it possible for t to both be a function and the truth value. the difference is which context you use it and you clearly are trying to apply t as a function/macro.
Here is the code edited for the truth value instead of the t function:
(defun base8(n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (cons (mod n 8) (base8 (truncate n 8))))))
(base8 8) ; ==> (0 1)

Feedback on lisp program for project euler 4 [closed]

Closed. This question is off-topic. It is not currently accepting answers.
Want to improve this question? Update the question so it's on-topic for Stack Overflow.
Closed 10 years ago.
Improve this question
I just started learning common lisp and so I've been working on project euler problems. Here's my solution (with some help from https://github.com/qlkzy/project-euler-cl ). Do you guys have any suggestions for stylistic changes and the sort to make it more lisp-y?
; A palindromic number reads the same both ways. The largest palindrome made
; from the product of two 2-digit numbers is 9009 = 91 99.
; Find the largest palindrome made from the product of two 3-digit numbers.
(defun num-to-list (num)
(let ((result nil))
(do ((x num (truncate x 10)))
((= x 0 ) result)
(setq result (cons (mod x 10) result)))))
(defun palindrome? (num)
(let ((x (num-to-list num)))
(equal x (reverse x))))
(defun all-n-digit-nums (n)
(loop for i from (expt 10 (1- n)) to (1- (expt 10 n)) collect i))
(defun all-products-of-n-digit-nums (n)
(let ((nums (all-n-digit-nums n)))
(loop for x in nums
appending (loop for y in nums collecting (* x y)))))
(defun all-palindromes (n)
(let ((nums (all-products-of-n-digit-nums n)))
(loop for x in nums
when (palindrome? x) collecting x)))
(defun largest-palindrome (n)
(apply 'max (all-palindromes 3)))
(print (largest-palindrome 3))
Barnar's solution is great however there's just a small typo, to return a result it should be:
(defun largest-palindrome (n)
(loop with start = (expt 10 (1- n))
and end = (1- (expt 10 n))
for i from start to end
maximize (loop for j from i to end
for num = (* i j)
when (palindrome? num)
maximize num)))
(setq list (cons thing list))
can be simplified to:
(push thing list)
My other comments on your code are not so much about Lisp style as about the algorithm. Creating all those intermediate lists of numbers seems like a poor way to do it, just write nested loops that calculate and test the numbers.
(defun all-palindromes (n)
(loop for i from (expt 10 (1- n)) to (1- (expt 10 n))
do (loop for j from (expt 10 (1- n)) to (1- (expt 10 n))
for num = (* i j)
when (palindrome? num)
collect num)))
But LOOP has a feature you can use: MAXIMIZE. So instead of collecting all the palindroms in a list with COLLECT, you can:
(defun largest-palindrome (n)
(loop with start = (expt 10 (1- n))
and end = (1- (expt 10 n))
for i from start to end
do (loop for j from start to end
for num = (* i j)
when (palindrome? num)
maximize num)))
Here's another optimization:
(defun largest-palindrome (n)
(loop with start = (expt 10 (1- n))
and end = (1- (expt 10 n))
for i from start to end
do (loop for j from i to end
for num = (* i j)
when (palindrome? num)
maximize num)))
Making the inner loop start from i instead of start avoids the redundancy of checking both M*N and N*M.
The example below is a bit contrived, but it finds the palindrome in a lot less iterations than your original approach:
(defun number-to-list (n)
(loop with i = n
with result = nil
while (> i 0) do
(multiple-value-bind (a b)
(floor i 10)
(setf i a result (cons b result)))
finally (return result)))
(defun palindrome-p (n)
(loop with source = (coerce n 'vector)
for i from 0 below (floor (length source) 2) do
(when (/= (aref source i) (aref source (- (length source) i 1)))
(return))
finally (return t)))
(defun suficiently-large-palindrome-of-3 ()
;; This is a fast way to find some sufficiently large palindrome
;; that fits our requirement, but may not be the largest
(loop with left = 999
with right = 999
for maybe-palindrome = (number-to-list (* left right)) do
(cond
((palindrome-p maybe-palindrome)
(return (values left right)))
((> left 99)
(decf left))
((> right 99)
(setf left 999 right (1- right)))
(t ; unrealistic situation
; we didn't find any palindromes
; which are multiples of two 3-digit
; numbers
(return)))))
(defun largest-palindrome-of-3 ()
(multiple-value-bind (left right)
(suficiently-large-palindrome-of-3)
(loop with largest = (* left right)
for i from right downto left do
(loop for j from 100 to 999
for maybe-larger = (* i j) do
(when (and (> maybe-larger largest)
(palindrome-p (number-to-list maybe-larger)))
(setf largest maybe-larger)))
finally (return largest)))) ; 906609
It also tries to optimize a bit the way you check that number is a palindrome, for an additional memory cost though. It also splits the number into a list using somewhat longer code, but making less divisions (which are somewhat computationally expensive).
The whole idea is based on the concept that the largest palindrome will be somewhere more towards the... largest multipliers, so, by starting off with 99 * 99 you will have a lot of bad matches. Instead, it tries to go from 999 * 999 and first find some palindrome, which looks good, doing so in a "sloppy" way. And then it tries hard to improve upon the initial find.

Common Lisp: "no non-white-space characters in string"

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.

Is it correct to use the backtick / comma idiom inside a (loop ...)?

I have some code which collects points (consed integers) from a loop which looks something like this:
(loop
for x from 1 to 100
for y from 100 downto 1
collect `(,x . ,y))
My question is, is it correct to use `(,x . ,y) in this situation?
Edit: This sample is not about generating a table of 100x100 items, the code here just illustrate the use of two loop variables and the consing of their values. I have edited the loop to make this clear. The actual loop I use depends on several other functions (and is part of one itself) so it made more sense to replace the calls with literal integers and to pull the loop out of the function.
It would be much 'better' to just do (cons x y).
But to answer the question, there is nothing wrong with doing that :) (except making it a tad slower).
I think the answer here is resource utilization (following from This post)
for example in clisp:
[1]> (time
(progn
(loop
for x from 1 to 100000
for y from 1 to 100000 do
collect (cons x y))
()))
WARNING: LOOP: missing forms after DO: permitted by CLtL2, forbidden by ANSI
CL.
Real time: 0.469 sec.
Run time: 0.468 sec.
Space: 1609084 Bytes
GC: 1, GC time: 0.015 sec.
NIL
[2]> (time
(progn
(loop
for x from 1 to 100000
for y from 1 to 100000 do
collect `(,x . ,y)) ;`
()))
WARNING: LOOP: missing forms after DO: permitted by CLtL2, forbidden by ANSI
CL.
Real time: 0.969 sec.
Run time: 0.969 sec.
Space: 10409084 Bytes
GC: 15, GC time: 0.172 sec.
NIL
[3]>
dsm: there are a couple of odd things about your code here. Note that
(loop for x from 1 to 100000
for y from 1 to 100000 do
collect `(,x . ,y))
is equivalent to:
(loop for x from 1 to 100
collecting (cons x x))
which probably isn't quite what you intended. Note three things: First, the way you've written it, x and y have the same role. You probably meant to nest loops. Second, your do after the y is incorrect, as there is not lisp form following it. Thirdly, you're right that you could use the backtick approach here but it makes your code harder to read and not idiomatic for no gain, so best avoided.
Guessing at what you actually intended, you might do something like this (using loop):
(loop for x from 1 to 100 appending
(loop for y from 1 to 100 collecting (cons x y)))
If you don't like the loop macro (like Kyle), you can use another iteration construct like
(let ((list nil))
(dotimes (n 100) ;; 0 based count, you will have to add 1 to get 1 .. 100
(dotimes (m 100)
(push (cons n m) list)))
(nreverse list))
If you find yourself doing this sort of thing a lot, you should probably write a more general function for crossing lists, then pass it these lists of integers
If you really have a problem with iteration, not just loop, you can do this sort of thing recursively (but note, this isn't scheme, your implementation may not guaranteed TCO). The function "genint" shown by Kyle here is a variant of a common (but not standard) function iota. However, appending to the list is a bad idea. An equivalent implementation like this:
(defun iota (n &optional (start 0))
(let ((end (+ n start)))
(labels ((next (n)
(when (< n end)
(cons n (next (1+ n))))))
(next start))))
should be much more efficient, but still is not a tail call. Note I've set this up for the more usual 0-based, but given you an optional parameter to start at 1 or any other integer. Of course the above can be written something like:
(defun iota (n &optional (start 0))
(loop repeat n
for i from start collecting i))
Which has the advantage of not blowing the stack for large arguments. If your implementation supports tail call elimination, you can also avoid the recursion running out of place by doing something like this:
(defun iota (n &optional (start 0))
(labels ((next (i list)
(if (>= i (+ n start))
nil
(next (1+ i) (cons i list)))))
(next start nil)))
Hope that helps!
Why not just
(cons x y)
By the way, I tried to run your code in CLISP and it didn't work as expected. Since I'm not a big fan of the loop macro here's how you might accomplish the same thing recursively:
(defun genint (stop)
(if (= stop 1) '(1)
(append (genint (- stop 1)) (list stop))))
(defun genpairs (x y)
(let ((row (mapcar #'(lambda (y)
(cons x y))
(genint y))))
(if (= x 0) row
(append (genpairs (- x 1) y)
row))))
(genpairs 100 100)