I'm just starting to learn Common Lisp, and I was giving the first Project Euler problem a try (summing all numbers below x that are divisible by 3 or 5). I tried to define a macro to generalize the process to numbers that are divisible by a given list of factors, and ran into trouble: when I run the macro it says that there was an illegal function call with setf, and warned that sum is undefined. Other people have posted this question before and had problems with parentheses, but I made an example of what I hoped the macro would expand into, and that function works fine, and the parentheses are exactly in the same places. Here's the code for the example function (which works fine) and the macro (which throws the errors):
;;; Example function for macro
(defun count-multiples-example (limit)
(let ((sum 0))
(dotimes (n (1+ limit) sum)
(dolist (each '(3 5))
(when (= 0 (mod n each))
(setf sum (+ n sum))
(return))))))
;;; Macro for arbitrary numbers to divide by (eventually)
(defmacro count-arbitrary (limit &rest divisors)
(let ((sum 0))
`(dotimes (n (1+ ,limit) ,sum)
(dolist (each ,divisors)
(when (= 0 (mod n each))
(setf sum (+ n ,sum))
(return))))))
I'm using SBCL with lispstick. Thanks!
CL-USER 28 > (defmacro count-arbitrary (limit &rest divisors)
(let ((sum 0))
`(dotimes (n (1+ ,limit) ,sum)
(dolist (each ,divisors)
(when (= 0 (mod n each))
(setf sum (+ n ,sum))
(return))))))
COUNT-ARBITRARY
Let's look at the expansion:
CL-USER 29 > (pprint (macroexpand-1 '(count-arbitrary 30 3 5)))
(DOTIMES (N (1+ 30) 0)
(DOLIST (EACH (3 5))
(WHEN (= 0 (MOD N EACH))
(SETF SUM (+ N 0)) (RETURN))))
You can see that the LET for the sum variable is missing, (3 5) lacks a quote (it is thus an illegal function call) and both comma before sum are wrong.
Generally the macro makes little sense, since you can provide the numbers as an additional parameter to the function:
(defun count-multiples-example (limit divisors &aux (sum 0))
(dotimes (n (1+ limit) sum)
(dolist (each divisors)
(when (= 0 (mod n each))
(incf sum n)
(return)))))
or this:
CL-USER 35 > (defun count-multiples-example (limit &rest divisors &aux (sum 0))
(dotimes (n (1+ limit) sum)
(dolist (each divisors)
(when (zerop (mod n each))
(incf sum n)
(return)))))
COUNT-MULTIPLES-EXAMPLE
CL-USER 36 > (count-multiples-example 30 3 5)
225
If I move the small dots around a little, this works for me:
(defmacro count-arbitrary (limit &rest divisors)
`(let ((sum 0))
(dotimes (n (1+ ,limit) sum)
(dolist (each ',divisors)
(when (= 0 (mod n each))
(setf sum (+ n sum))
(return))))))
Related
I got an unexpected result while solving Problem 75 in Project Euler. My code does find the correct solution, but it behaves strangely.
My solution consists of traversing a Pythagorean tree (Barning's matrices) until the perimeter limit is reached, counting the numbers of times the perimeter assumed each value, and, lastly, counting the perimeter lengths that occurred only once. My admittedly untidy but functioning code is:
(defparameter *barning-matrixes*
'(#(1 -2 2) #(2 -1 2) #(2 -2 3)
#(1 2 2) #(2 1 2) #(2 2 3)
#(-1 2 2) #(-2 1 2) #(-2 2 3)))
(defparameter *lengths* (make-array 1500001 :initial-element 0))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x)
(reduce #'+ (map 'vector #'* n x))) *barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
(expand-node #(3 4 5)) ; Takes too darn long :-(
(count 1 *lengths*)
I expected the tree expansion to run in a few milliseconds, but the expand-node function took 8.65 seconds--a lot more than expected--to traverse a not very large tree.
However, I was surprised when I tweaked the code to remove the vectors...
(defparameter *barning-matrixes*
'((1 -2 2) (2 -1 2) (2 -2 3)
(1 2 2) (2 1 2) (2 2 3)
(-1 2 2) (-2 1 2) (-2 2 3)))
(defparameter *lengths* (make-array 1500001 :initial-element 0))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a list and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x) (reduce #'+ (mapcar #'* n x))) *barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
(expand-node '(3 4 5)) ; Much faster, but why?!
(count 1 *lengths*)
...and the traversing went hugely faster, taking only 35 ms. I'm intrigued by this massive difference and am hoping someone out there can explain why it happened.
Thanks,
Paulo
PS: I'm using CCL for all this.
You didn't say which implementation you were using.
You would need to find out, where the time is spend.
But for me it looks like the implementation of MAP of a list and a vector of equal length to a new vector in your Common Lisp might be very inefficient.
Even when consing a new vector, which has some overhead, the implementation can be much faster.
Try to implement the vector operation as a LOOP and compare:
(loop with v = (make-array (length n))
for n1 across n
for x1 across x
for i from 0
do (setf (aref v i) (* n1 x1))
finally (return v))
This faster version conses too, but has replaced the list operations with vector operations:
(defparameter *barning-matrixes*
#(#(1 -2 2) #(2 -1 2) #(2 -2 3) #(1 2 2) #(2 1 2) #(2 2 3) #(-1 2 2) #(-2 1 2) #(-2 2 3)))
(defparameter *lengths* (make-array 1500001 :initial-element 0))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes
(loop with v = (make-array (length *barning-matrixes*))
for e across *barning-matrixes*
for i from 0
do (setf (aref v i)
(reduce #'+
(loop with v = (make-array (length n))
for n1 across n
for x1 across e
for i from 0
do (setf (aref v i) (* n1 x1))
finally (return v))))
finally (return v))))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
(time (expand-node #(3 4 5)))
Let's look at your code:
(defun expand-node (n)
; here we don't know of which type N is. You call it from the toplevel
; with a vector, but recursive calls call it with a list
"Takes a primitive Pythagorean triple in a vector and traverses
subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x) ; this mapcar creates a list
(reduce #'+
(map 'vector
#'*
n ; <- list or vector
x))) ; <- vector
*barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3)) ; this subseq returns a list most of the times...
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
So you call MAP with a list and a vector most of the times.
What is the size of the result vector? MAP has to find out by traversing the list or by some other way. The result vector length is the shortest of the argument sequence lengths. Then it has to iterate over the list and the vector. If MAP now uses generic sequence operations, the element access into the list is always traversing the list. Obviously one can write an optimized version, which does all that faster, but a Common Lisp implementation might choose to provide only a generic implementation of MAP...
Welcome to the intricacies of Common Lisp optimization!
The first thing to note is about the different program optimization strategies performed by the different implementations: I tried your examples in SBCL, and both of them performed very efficiently with almost the same time, while in CCL the vector version was executed much much slower than the list version. I do not know which implementation you have tried, but you can try to use different implementations to see very different execution times.
From a few tests in CCL it seems to me that the main problem arises from this form:
(map 'vector #'* n x)
which is executed much much slowly than the corresponding list version:
(mapcar #'* n x)
Using time I have seen that the vector version conses a lot.
This first impression has been confirmed by simply changing map with map-into, using an auxiliary vector. Actually the following version is slightly faster in CCL than the list version:
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(let ((perimeter (reduce #'+ n))
(temp-vector (make-array 3 :initial-element 0)))
(unless (> perimeter 1500000)
(let ((next-nodes (mapcar #'(lambda (x)
(reduce #'+ (map-into temp-vector #'* n x))) *barning-matrixes*)))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(expand-node (subseq next-nodes 0 3))
(expand-node (subseq next-nodes 3 6))
(expand-node (subseq next-nodes 6 9))))))
Inspecting vector #(1 2 3) on SBCL gives:
Dimensions: (3)
Element type: T
Total size: 3
Adjustable: NIL
Fill pointer: NIL
Contents:
0: 1
1: 2
2: 3
You can see that there are a little more data to store than in a list, even though the exact internal representation of vectors varies among implementations. For small vectors that keep being copied like in your example, you are likely to end up allocating more memory than with lists, which is visible in the bytes consed lines below. Allocating memory contributes to the run time. In my tests, note that the difference in time is not as big as in your tests.
;; VECTORS
(time (expand-node #(3 4 5)))
;; Evaluation took:
;; 2.060 seconds of real time
;; 2.062500 seconds of total run time (1.765625 user, 0.296875 system)
;; [ Run times consist of 0.186 seconds GC time, and 1.877 seconds non-GC time. ]
;; 100.10% CPU
;; 4,903,137,055 processor cycles
;; 202,276,032 bytes consed
;; LISTS
(time (expand-node* '(3 4 5)))
;; Evaluation took:
;; 0.610 seconds of real time
;; 0.609375 seconds of total run time (0.609375 user, 0.000000 system)
;; [ Run times consist of 0.016 seconds GC time, and 0.594 seconds non-GC time. ]
;; 99.84% CPU
;; 1,432,603,387 processor cycles
;; 80,902,560 bytes consed
Everyone already answered while I was trying to optimize the code, so I'll just put this version here without bothering to explain too much. It should run pretty fast, at least on SBCL.
(declaim (optimize (speed 3) (safety 0) (debug 0)))
(declaim (type (simple-array (simple-array fixnum 1) 1) *barning-matrixes*))
(defparameter *barning-matrixes*
(map '(simple-array (simple-array fixnum 1) 1)
(lambda (list)
(make-array 3 :element-type 'fixnum
:initial-contents list))
'((1 -2 2) (2 -1 2) (2 -2 3)
(1 2 2) (2 1 2) (2 2 3)
(-1 2 2) (-2 1 2) (-2 2 3))))
(declaim (type (simple-array fixnum 1) *lengths*))
(defparameter *lengths* (make-array 1500001 :element-type 'fixnum
:initial-element 0))
(declaim (ftype (function ((simple-array fixnum 1))) expand-node))
(defun expand-node (n)
"Takes a primitive Pythagorean triple in a vector and traverses subsequent nodes in the the tree of primitives until perimeter > 1,500,000"
(loop with list-of-ns = (list n)
for n = (pop list-of-ns)
while n
do (let ((perimeter (let ((result 0))
(declare (type fixnum result))
(dotimes (i (length n) result)
(incf result (aref n i))))))
(declare (type fixnum perimeter))
(unless (> perimeter 1500000)
(let ((next-nodes
(let ((result (list)))
(dotimes (matrix 9 (nreverse result))
(let ((matrix (aref *barning-matrixes* matrix)))
(push (let ((result 0))
(declare (type fixnum result))
(dotimes (i 3 result)
(incf result
(the fixnum
(* (the fixnum (aref matrix i))
(the fixnum (aref n i)))))))
result))))))
(declare (type list next-nodes))
(loop for i from perimeter to 1500000 by perimeter
do (incf (aref *lengths* i)))
(dotimes (i 3)
(push (make-array 3 :element-type 'fixnum
:initial-contents (list (pop next-nodes)
(pop next-nodes)
(pop next-nodes)))
list-of-ns))))))
(values))
On my slow laptop,
CL-USER> (load (compile-file #P"e75.lisp"))
; ...compilation notes...
CL-USER> (time (expand-node (make-array 3 :element-type 'fixnum
:initial-contents '(3 4 5))))
Evaluation took:
0.274 seconds of real time
0.264000 seconds of total run time (0.264000 user, 0.000000 system)
96.35% CPU
382,768,596 processor cycles
35,413,600 bytes consed
; No values
CL-USER> (count 1 *lengths*)
161667 (18 bits, #x27783)
The original code ran at around ~1.8 seconds with vectors, and 0.8 seconds with lists.
I need some help to implement a function that receives a number and returns the number of bits that would have been required to be “on” in order to represent the input number in binary base.
For example, the number 5 is represented as 101 in binary and therefore requires two bits to be “on”.
Example:
(numOfBitsOn 5) will return 2 because 5 in binary is 101
(numOfBitsOn 101) will return 4 because 101 in binary is 1100101
The function must be written as tail recursion.
This is m first time learning Scheme. Up to now this is all I wrote:
(define (numOfBitsOn number)
(define (numOfBitsOn-2 number acc)
(cond ((eq? number 0)acc)
(not(eq? (modulo number 2)0) (+ acc 1))
(numOfBitsOn-2 (/ number 2) acc))))
And it gives me that:
begin (possibly implicit): no expression after a sequence of internal definitions in: (begin (define (numofbitson-2 number acc) (cond ((eq? number 0) acc) (not (eq? (modulo number 2) 0) (+ acc 1)) (numofbitson-2 (number) acc))))
I'm sure it doesn't even close to the solution =\
Can you help me please?
Thanks!
(define (slow-popcount n)
(do ((n n (quotient n 2))
(count 0 (+ count (modulo n 2))))
((zero? n) count)))
I'm a newbie in LISP. I'm trying to write a function in CLISP to generate the first n numbers of Fibonacci series.
This is what I've done so far.
(defun fibonacci(n)
(cond
((eq n 1) 0)
((eq n 2) 1)
((+ (fibonacci (- n 1)) (fibonacci (- n 2))))))))
The program prints the nth number of Fibonacci series. I'm trying to modify it so that it would print the series, and not just the nth term.
Is it possible to do so in just a single recursive function, using just the basic functions?
Yes:
(defun fibonacci (n &optional (a 0) (b 1) (acc ()))
(if (zerop n)
(nreverse acc)
(fibonacci (1- n) b (+ a b) (cons a acc))))
(fibonacci 5) ; ==> (0 1 1 2 3)
The logic behind it is that you need to know the two previous numbers to generate the next.
a 0 1 1 2 3 5 ...
b 1 1 2 3 5 8 ...
new-b 1 2 3 5 8 13 ...
Instead of returning just one result I accumulate all the a-s until n is zero.
EDIT Without reverse it's a bit more inefficient:
(defun fibonacci (n &optional (a 0) (b 1))
(if (zerop n)
nil
(cons a (fibonacci (1- n) b (+ a b)))))
(fibonacci 5) ; ==> (0 1 1 2 3)
The program prints the nth number of Fibonacci series.
This program doesn't print anything. If you're seeing output, it's probably because you're calling it from the read-eval-print-loop (REPL), which reads a form, evaluates it, and then prints the result. E.g., you might be doing:
CL-USER> (fibonacci 4)
2
If you wrapped that call in something else, though, you'll see that it's not printing anything:
CL-USER> (progn (fibonacci 4) nil)
NIL
As you've got this written, it will be difficult to modify it to print each fibonacci number just once, since you do a lot of redundant computation. For instance, the call to
(fibonacci (- n 1))
will compute (fibonacci (- n 1)), but so will the direct call to
(fibonacci (- n 2))
That means you probably don't want each call to fibonacci to print the whole sequence. If you do, though, note that (print x) returns the value of x, so you can simply do:
(defun fibonacci(n)
(cond
((eq n 1) 0)
((eq n 2) 1)
((print (+ (fibonacci (- n 1)) (fibonacci (- n 2)))))))
CL-USER> (progn (fibonacci 6) nil)
1
2
1
3
1
2
5
NIL
You'll see some repeated parts there, since there's redundant computation. You can compute the series much more efficiently, however, by starting from the first two numbers, and counting up:
(defun fibonacci (n)
(do ((a 1 b)
(b 1 (print (+ a b)))
(n n (1- n)))
((zerop n) b)))
CL-USER> (fibonacci 6)
2
3
5
8
13
21
An option to keep the basic structure you used is to pass an additional flag to the function that tells if you want printing or not:
(defun fibo (n printseq)
(cond
((= n 1) (if printseq (print 0) 0))
((= n 2) (if printseq (print 1) 1))
(T
(let ((a (fibo (- n 1) printseq))
(b (fibo (- n 2) NIL)))
(if printseq (print (+ a b)) (+ a b))))))
The idea is that when you do the two recursive calls only in the first you pass down the flag about doing the printing and in the second call instead you just pass NIL to avoid printing again.
(defun fib (n a b)
(print (write-to-string n))
(print b)
(if (< n 100000)
(funcall (lambda (n a b) (fib n a b)) (+ n 1) b (+ a b)))
)
(defun fibstart ()
(fib 1 0 1)
)
This is what I did until now it tells me that it is not of type list.
(defun number_list(n)
(setf x
(if (zerop (truncate n 10))
(list n)
(append (number_list (truncate n 10)) (list (mod n 10)))))
(length x))
When I remove the (length x) I can see that the result is a list however.
Would appreciate any help.
Your solution uses a global variable x, which is generally a bad idea, especially in recursive functions. Then, you create a list in order to count the number of digits. This is not really necessary.
Using a list
If you want to work with a list, I suggest you split the problem in 2 parts:
1. convert a number to a list
Your function works well for this if you remove setf x:
(defun number_list(n)
(if (zerop (truncate n 10))
(list n)
(append (number_list (truncate n 10)) (list (mod n 10)))))
2. count the number of digits
(defun numdigits (n)
(length (number_list n))).
Alternative
But I would suggest a simple recursive definition such as:
(defun numdigits (n)
(if (< -10 n 10)
1
(1+ (numdigits (truncate n 10)))))
If you want to get the decimal digits and then count the length, assuming that numbers are 0 or greater integers.
(defun number-list (n)
(if (< n 10)
(list n)
(cons (mod n 10)
(number-list (truncate n 10)))))
CL-USER 44 > (length (number-list 123456789))
9
But it is preferable to directly count the digits. See the other answers.
I have very recently started learning lisp. Like many others, I am trying my hand at Project Euler problems, however I am a bit stuck at Problem 14 : Longest Collatz Sequence.
This is what I have so far:
(defun collatz (x)
(if (evenp x)
(/ x 2)
(+ (* x 3) 1)))
(defun collatz-sequence (x)
(let ((count 1))
(loop
(setq x (collatz x))
(incf count)
(when (= x 1)
(return count)))))
(defun result ()
(loop for i from 1 to 1000000 maximize (collatz-sequence i)))
This will correctly print the longest sequence (525) but not the number producing the longest sequence.
What I want is
result = maximum [ (collatz-sequence n, n) | n <- [1..999999]]
translated into Common Lisp if possible.
With some help from macros and using iterate library, which allows you to extend its loop-like macro, you could do something like the below:
(defun collatz (x)
(if (evenp x) (floor x 2) (1+ (* x 3))))
(defun collatz-path (x)
(1+ (iter:iter (iter:counting (setq x (collatz x))) (iter:until (= x 1)))))
(defmacro maximizing-for (maximized-expression into (cause result))
(assert (eq 'into into) (into) "~S must be a symbol" into)
`(progn
(iter:with ,result = 0)
(iter:reducing ,maximized-expression by
(lambda (so-far candidate)
(if (> candidate so-far)
(progn (setf ,result i) candidate) so-far)) into ,cause)))
(defun euler-14 ()
(iter:iter
(iter:for i from 1000000 downto 1)
(maximizing-for (collatz-path i) into (path result))
(iter:finally (return (values result path)))))
(Presented without claim of generality. :))
The LOOP variant is not that pretty:
(defun collatz-sequence (x)
(1+ (loop for x1 = (collatz x) then (collatz x1)
count 1
until (= x1 1))))
(defun result ()
(loop with max-i = 0 and max-x = 0
for i from 1 to 1000000
for x = (collatz-sequence i)
when (> x max-x)
do (setf max-i i max-x x)
finally (return (values max-i max-x))))
A late answer but a 'pretty' one, albeit a losing one:
(defun collatz-sequence (x)
(labels ((collatz (x)
(if (evenp x)
(/ x 2)
(+ (* 3 x) 1))))
(recurse scan ((i x) (len 1) (peak 1) (seq '(1)))
(if (= i 1)
(values len peak (reverse seq))
(scan (collatz i) (+ len 1) (max i peak) (cons i seq))))))
(defun collatz-check (n)
(recurse look ((i 1) (li 1) (llen 1))
(if (> i n)
(values li llen)
(multiple-value-bind (len peak seq)
(collatz-sequence i)
(if (> len llen)
(look (+ i 1) i len)
(look (+ i 1) li llen))))))
(defmacro recurse (name args &rest body)
`(labels ((,name ,(mapcar #'car args) ,#body))
(,name ,#(mapcar #'cadr args))))