I've got this:
(let ((num 1))
(mapcar (lambda (x)
(cons x (if (evenp (setf num (random 299)))
(1+ num)
(num))))
'(a b c d e f)))
which should produce something like this:
((A . 37) (B . 283) (C . 232) (D . 251) (E . 273) (F . 170)
only with odd numbers. Yes, very kludgy looking. Is there something with random-state that would help? Or the "hidden system variable" that holds onto that initial random calculation? Here's a global function I tried:
(defun random-odd ()
(let ((num 0))
(if (evenp (setf num (random 299)))
(1+ num)
(num))))
Also not working. What am I missing here?
Your random-odd is almost fine except for the style and using num in
the function position (remember, Lisp parentheses are meaningful):
(defun random-odd ()
(let ((num (random 299)))
(if (evenp num)
(1+ num)
num)))
The subtle problem with this function is that the probability of getting 299 is half the probability of getting any other odd number from 1 to 297.
This is because (random 299) returns numbers from 0 to 298 inclusive with equal probability 1/299. Thus random-odd will return, say, 17 with probability 2/299 (if random returns 17 or 16) but it will return 299 with probability 1/299 (if random returns 298).
Thus I would suggest
(defun random-odd (even-limit)
"Return an odd random number from 0 to EVEN-LIMIT, exclusive."
(assert (evenp even-limit) (even-limit)
"~S: ~S must be even" 'random-odd 'even-limit)
(let ((num (random even-limit)))
(if (evenp num)
(1+ num)
num)))
A completely equivalent approach would be
(defun random-odd (half-limit)
"Return a random odd number from 1 to half-limit*2-1 inclusive."
(1+ (ash (random half-limit) 1)))
(mapcar #'(lambda (x)
(let ((num (random 299)))
(cons x (if (evenp num)
(1+ num)
num))))
'(a b c d e f))
Related
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))))))
I am reading sicp, there's a problem (practice 1.29), I write a scheme function to solve the the question, but it seems that the recursive call of the function get the wrong answer. Really strange to me. The code is following:
(define simpson
(lambda (f a b n)
(let ((h (/ (- b a) n))
(k 0))
(letrec
((sum (lambda (term start next end)
(if (> start end)
0
(+ (term start)
(sum term (next start) next end)))))
(next (lambda (x)
(let ()
(set! k (+ k 1))
(+ x h))))
(term (lambda (x)
(cond
((= k 0) (f a))
((= k n) (f b))
((even? k) (* 2
(f x)))
(else (* 4
(f x)))))))
(sum term a next b)))))
I didn't get the right answer.
For example, if I try to call the simpson function like this:
(simpson (lambda (x) x) 0 1 4)
I expected to get the 6, but it returned 10 to me, I am not sure where the error is.It seems to me that the function "sum" defined inside of Simpson function is not right.
If I rewrite the sum function inside of simpson using the iteration instead of recursive, I get the right answer.
You need to multiply the sum with h/3:
(* 1/3 h (sum term a next b))
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))))
I am learning Lisp. I have implemented a Common Lisp function that merges two strings that are ordered alphabetically, using recursion. Here is my code, but there is something wrong with it and I didn't figure it out.
(defun merge (F L)
(if (null F)
(if (null L)
F ; return f
( L )) ; else return L
;else if
(if (null L)
F) ; return F
;else if
(if (string< (substring F 0 1) (substring L 0 1)
(concat 'string (substring F 0 1)
(merge (substring F 1 (length F)) L)))
(
(concat 'string (substring L 0 1)
(merge F (substring L 1 (length L)) ))
))))
Edit :
I simply want to merge two strings such as the
inputs are string a = adf and string b = beg
and the result or output should be abdefg.
Thanks in advance.
Using string< is an overkill, char< should be used instead, as shown by Kaz. Recalculating length at each step would make this algorithm quadratic, so should be avoided. Using sort to "fake it" makes it O(n log n) instead of O(n). Using concatenate 'string all the time probably incurs extra costs of unneeded traversals too.
Here's a natural recursive solution:
(defun str-merge (F L)
(labels ((g (a b)
(cond
((null a) b)
((null b) a)
((char< (car b) (car a))
(cons (car b) (g a (cdr b))))
(t (cons (car a) (g (cdr a) b))))))
(coerce (g (coerce F 'list) (coerce L 'list))
'string)))
But, Common Lisp does not have a tail call optimization guarantee, let alone tail recursion modulo cons optimization guarantee (even if the latter was described as early as 1974, using "Lisp 1.6's rplaca and rplacd field assignment operators"). So we must hand-code this as a top-down output list building loop:
(defun str-merge (F L &aux (s (list nil)) ) ; head sentinel
(do ((p s (cdr p))
(a (coerce F 'list) (if q a (cdr a)))
(b (coerce L 'list) (if q (cdr b) b ))
(q nil))
((or (null a) (null b))
(if a (rplacd p a) (rplacd p b))
(coerce (cdr s) 'string)) ; FTW!
(setq q (char< (car b) (car a))) ; the test result
(if q
(rplacd p (list (car b)))
(rplacd p (list (car a))))))
Judging by your comments, it looks like you're trying to use if with a series of conditions (like a series of else ifs in some other languages). For that, you probably want cond.
I replaced that if with cond and cleaned up some other errors, and it worked.
(defun empty (s) (= (length s) 0))
(defun my-merge (F L)
(cond
((empty F)
(if (empty L)
F
L))
((empty L)
F)
(t
(if (string< (subseq F 0 1) (subseq L 0 1))
(concatenate 'string (subseq F 0 1) (my-merge (subseq F 1 (length F)) L))
(concatenate 'string (subseq L 0 1) (my-merge F (subseq L 1 (length L))))))))
Your test case came out as you wanted it to:
* (my-merge "adf" "beg")
"abdefg"
There were quite a few good answers, so why would I add one more? Well, the below is probably more efficient then the other answers here.
(defun merge-strings (a b)
(let* ((lena (length a))
(lenb (length b))
(len (+ lena lenb))
(s (make-string len)))
(labels
((safe-char< (x y)
(if (and x y) (char< x y)
(not (null x))))
(choose-next (x y)
(let ((ax (when (< x lena) (aref a x)))
(by (when (< y lenb) (aref b y)))
(xy (+ x y)))
(cond
((= xy len) s)
((safe-char< ax by)
(setf (aref s xy) ax)
(choose-next (1+ x) y))
(t
(setf (aref s xy) by)
(choose-next x (1+ y)))))))
(choose-next 0 0))))
(merge-strings "adf" "beg")
It is more efficient specifically in the sense of memory allocations - it only allocates enough memory to write the result string, never coerces anything (from list to string or from array to string etc.) It may not look very pretty, but this is because it is trying to do every calculation only once.
This is, of course, not the most efficient way to write this function, but programming absolutely w/o efficiency in mind is not going to get you far.
A recursive way to do it (fixed according to comment- other solutions can get an IF form as well).
(defun merge-strings (a b)
(concatenate 'string
(merge-strings-under a b)))
(defun merge-strings-under (a b)
(when (and
(= (length a)
(length b))
(> (length a) 0))
(append (if (string< (aref a 0) (aref b 0))
(list (aref a 0) (aref b 0))
(list (aref b 0) (aref a 0)))
(merge-strings-under (subseq a 1)
(subseq b 1)))))
Here's a iterative way to do it.
(concatenate 'string
(loop for i across "adf" for j across "beg" nconc (list i j)))
Note that these rely on building the string into a list of characters, then vectorizing it ( a string is a vector of characters).
You can also write a more C-esque approach...
(defun merge-strings-vector (a b)
(let ((retstr (make-array (list (+
(length a)
(length b)))
:element-type 'character)))
(labels ((merge-str (a b i)
(when (and
(= (length a)
(length b))
(/= i (length a)))
(setf (aref retstr (* 2 i)) (aref a i))
(setf (aref retstr (1+ (* 2 i))) (aref b i))
(merge-str a b (1+ i)))))
(merge-str a b 0)
retstr)))
Note that this one - unlike the other 2 - has side effects within the function. It also, imo, is more difficult to understand.
All 3 take varying numbers of cycles to execute on SBCL 56; each seems to take between 6K and 11K on most of my trials. I'm not sure why.
I'd like to turn integers into lists. For example, 2245 => (2 2 4 5).
I dislike (coerce (write-to-string 2245) 'list) because it yields (#\2 #\2 #\4 #\5).
Help please?
(map 'list #'digit-char-p (prin1-to-string n))
works well.
(defun number-to-list (n)
(loop for c across (write-to-string n) collect (digit-char-p c)))
An alternative loop based solution.
Same as jon_darkstar but in common lisp. This fails for negative numbers, but trivial to amend.
(defun number-to-list (number)
(assert (and (integerp number)
(>= number 0)))
(labels ((number-to-list/recursive (number) (print number)
(cond
((zerop number)
nil)
(t
(cons (mod number 10)
(number-to-list/recursive (truncate (/ number 10))))))))
(nreverse (number-to-list/recursive number))))
Common Lisp implementation for non-negative integers:
(defun number-to-list (n &optional tail)
(if (zerop n)
(or tail '(0))
(multiple-value-bind (val rem)
(floor n 10)
(number-to-list val (cons rem tail)))))
I don't really use common lisp, but I'd do it like this in Scheme. hopefully that can help?
(define (number-to-list x)
(define (mod-cons x l)
(if (zero? x)
l
(mod-cons (quotient x 10) (cons (remainder x 10) l))))
(mod-cons x '()))
(number-to-list 1234)
A variation on #Mark Cox's solution that also includes the '-' sign in case of negative integers. Inspired by #Terje Norderhaug's amendment to #rhombidodecahedron's solution, where negative numbers are represented by including a negative sign before the digits.
(defun number-to-numlist (number)
"Converts an integer to a list of its digits. Negative numbers
are represented by a '-' sign prepended to the digits of its absolute value."
(assert (integerp number))
(labels ((collect-digits (number number-components list-of-numbers)
(setf number-components (multiple-value-list (floor number 10)))
(if (zerop number)
(or list-of-numbers '(0))
(collect-digits (first number-components) nil
(cons (second number-components) list-of-numbers)))))
(let ((number-list (collect-digits (abs number) nil nil)))
(if (< number 0)
(append '(-) number-list)
number-list))))