I need to write a non-recursive version of the function sum-squares and Use a do-loop that is based on the length of the argument list.
Here's how it's done generally:
(defun sum-squares (list) (loop for x in list
for y = (* x x)
summing y into total
finally (return total)))
A do loop solution is even simpler, but not half as elegant:
(defun sum-squares (list)
(let ((sum 0)) (do ((i 0 (1+ i)))
((>= i (length list)))
(setq sum (+ sum (* (nth i list) (nth i list)))))
sum))
Related
(defun suma (L)
(setq var 0)
(do
((i 0 (+ i 1)))
((= i (length L)))
(+ var (nth i L)))
var)
Why does it always returns 0?
Shouldn't it return sum of list L?
+ does not modify its arguments, so, since you never modify var, its initial value of 0 is returned.
You need to replace (+ var (nth i L)) with (incf var (nth i L)), of, equivalently, (setq var (+ var (nth i L))).
See incf.
Note that you should bind var with let instead of making it global with setq.
Most importantly, note that your algorithm is quadratic in the length of the list argument (because nth scans your list every time from the start).
Here are some better implementations:
(defun sum-1 (l)
(reduce #'+ l))
(defun sum-2 (l)
(loop for x in l sum x))
(defun sum-3 (l)
(let ((sum 0))
(dolist (x l sum)
(incf sum x))))
Here is a bad implementation:
(defun sum-4 (l)
(apply #'+ l))
The problem with sum-4 is that it will fail if the length of the supplied list is larger than call-arguments-limit.
I thought this would be a comment for the full learning experience, but I was not able to put code in the comment.
There is a way to do sums without modifying any argument, and that is by doing it recursively:
(defun recsum (list)
(if list
(+ (first list) (recsum (rest list)))
0))
This version can be tail call optimized by the compiler, and as fast as a loop:
(defun recsum2 (list &optional (accumulator 0))
(if list
(recsum2 (rest list) (+ accumulator (first list)))
accumulator))
What you are trying to do could be done with do like this:
(defun suma (l)
(do
((var 0)
(i 0 (+ i 1)))
((= i (length l)) var)
(incf var (nth i l))))
But we don't usually do anything in dos body, so it's like this then:
(defun suma (l)
(do
((i 0 (+ i 1))
(var 0 (+ var (nth i l))))
((= i (length l)) var)))
But nth and length are slow, so better do it this way:
(defun suma (l)
(do*
((var (first l) (+ var (first list)))
(list (rest l) (rest list)))
((null list) var)))
This one is without the * in do, and returns 0 on empty list:
(defun suma (l)
(do
((acc 0 (+ acc (first list)))
(list l (rest list)))
((null list) acc)))
But my favorite is the reduce version from #sds which also can return 0 on empty list with :initial-value 0
EDIT: recsum2 did not return anything, so it needed a fix.
I have two lists as follows:
(x y z) & (2 1)
and I want to have a result like:
((x y) (z))
The relation of the lists is quite clear. So basically I want to rearrange the members of the first list into a list of lists with two (length of second list) lists.
I have tried running two dotimes iterations to do this:
(let ((result) (list1* list1))
(dotimes (n (length list2) result)
(progn (setq result
(append result
(list (let ((result2))
(dotimes (m (nth n list2) result2)
(setq result2
(append result2
(list (nth m list1*)))))))))
(setq list1*
(subseq list1* 0 (nth n list2))))))
The idea is that I make the first list of the expected result (x y), and then I want to update the (x y z) list so that the x any y are removed and I only have (z). Then the loop runs again to get the (z) list in the expected result. This does not work correctly and results in:
((x y) (x))
which means apparently the second command for progn which is basically updating the list1* is not working. Clearly there must be a correct and better way of doing this and I was wondering whether anyone can help with this. Also explain why it is not possible to have the solution explained?
If I see that right, your problem is in (subseq list1* 0 (nth n list2)), which returns the part of the list that you do not want.
I have the following to offer:
(defun partition-list (list lengths)
(mapcar (lambda (length)
(loop :repeat length
:collect (pop list)))
lengths))
This is a bit simplistic, of course, as it does not handle unexpected input, such as (length list) being smaller than (reduce #'+ lengths), but it can be expanded upon.
Just for the sake of example, an alternative using iterate:
(defun partition-list (list by)
(iter:iter
(iter:for element in list)
(iter:for i from 1)
(iter:generating measure in by)
(iter:collect element into sublist)
(when (= (or measure (iter:next measure)) i)
(iter:collect sublist)
(iter:next measure)
(setf i 0 sublist nil))))
SICP contains an partially complete example of the n-queens solutions, by walking a tree of every possible queen placement in the last row, generating more possible positions in the next row to combine the results so far, filtering the possibilities to keep only ones where the newest queen is safe, and repeating recursively.
This strategy blows up after about n=11 with a maximum recursion error.
I've implemented an alternate strategy that does a smarter tree-walk from the first column, generating possible positions from a list of unused rows, consing each position-list onto an updated list of yet-unused rows. Filtering those pairs considered safe, and recursively mapping over these pairs for the next column. This doesn't blow up (so far) but n=12 takes a minute and n=13 takes about 10 minutes to solve.
(define (queens board-size)
(let loop ((k 1) (pp-pair (cons '() (enumerate-interval 1 board-size))))
(let ((position (car pp-pair))
(potential-rows (cdr pp-pair)))
(if (> k board-size)
(list position)
(flatmap (lambda (pp-pair) (loop (++ k) pp-pair))
(filter (lambda (pp-pair) (safe? k (car pp-pair))) ;keep only safe
(map (lambda (new-row)
(cons (adjoin-position new-row k position)
(remove-row new-row potential-rows))) ;make pp-pair
potential-rows)))))))
;auxiliary functions not listed
Not really looking for code, but a simple explanation of a strategy or two that's less naive and that clicks well with a functional approach.
I can offer you a simplification of your code, so it may run a little bit faster. We start by renaming some variables for improved readability (YMMV),
(define (queens board-size)
(let loop ((k 1)
(pd (cons '() (enumerate-interval 1 board-size))))
(let ((position (car pd))
(domain (cdr pd)))
(if (> k board-size)
(list position)
(flatmap (lambda (pd) (loop (1+ k) pd))
(filter (lambda (pd) (safe? k (car pd))) ;keep only safe NewPositions
(map (lambda (row)
(cons (adjoin-position row k position) ;NewPosition
(remove-row row domain))) ;make new PD for each Row in D
domain))))))) ; D
Now, filter f (map g d) == flatmap (\x->let {y=g x} in [y | f y]) d (using a bit of Haskell syntax there), i.e. we can fuse the map and the filter into one flatmap:
(flatmap (lambda (pd) (loop (1+ k) pd))
(flatmap (lambda (row) ;keep only safe NewPositions
(let ( (p (adjoin-position row k position))
(d (remove-row row domain)))
(if (safe? k p)
(list (cons p d))
'())))
domain))
then, flatmap h (flatmap g d) == flatmap (h <=< g) d (where <=< is right-to-left Kleisli composition operator, but who cares), so we can fuse the two flatmaps into just one, with
(flatmap
(lambda (row) ;keep only safe NewPositions
(let ((p (adjoin-position row k position)))
(if (safe? k p)
(loop (1+ k) (cons p (remove-row row domain)))
'())))
domain)
so the simplified code is
(define (queens board-size)
(let loop ((k 1)
(position '())
(domain (enumerate-interval 1 board-size)))
(if (> k board-size)
(list position)
(flatmap
(lambda (row) ;use only the safe picks
(if (safe_row? row k position) ;better to test before consing
(loop (1+ k) (adjoin-position row k position)
(remove-row row domain))
'()))
domain))))
Here's what I came up with a second time around. Not sure it's terribly much faster though. Quite a bit prettier though.
(define (n-queens n)
(let loop ((k 1) (r 1) (dangers (starting-dangers n)) (res '()) (solutions '()))
(cond ((> k n) (cons res solutions))
((> r n) solutions)
((safe? r k dangers)
(let ((this (loop (+ k 1) 1 (update-dangers r k dangers)
(cons (cons r k) res) solutions)))
(loop k (+ r 1) dangers res this)))
(else (loop k (+ r 1) dangers res solutions)))))
Big thing is using a let statement to serialize recursion, limiting depth to n. Solutions come out backwards (could probably fix by going n->1 instead of 1->n on r and k) but a backwards set is the same set as the frowards set.
(define (starting-dangers n)
(list (list)
(list (- n))
(list (+ (* 2 n) 1))))
;;instead of terminating in null list, terminate in term that cant threaten
small improvement, a danger can come from a row, a down diagonal, or and up diagonal, keep track of each as the board evolves.
(define (safe? r k dangers)
(and (let loop ((rdangers (rdang dangers)))
(cond ((null? rdangers) #t)
((= r (car rdangers))
#f)
(else (loop (cdr rdangers)))))
(let ((ddiag (- k r)))
(let loop ((ddangers (ddang dangers)))
(if (<= (car ddangers) ddiag)
(if (= (car ddangers) ddiag)
#f
#t)
(loop (cdr ddangers)))))
(let ((udiag (+ k r)))
(let loop ((udangers (udang dangers)))
(if (>= (car udangers) udiag)
(if (= (car udangers) udiag)
#f
#t)
(loop (cdr udangers)))))))
medium improvement in the change of format, only needing to do one comparison to check vs prior two. Don't think keeiping diagonals sorted cost me anything, but I don't think it saves time either.
(define (update-dangers r k dangers)
(list
(cons r (rdang dangers))
(insert (- k r) (ddang dangers) >)
(insert (+ k r) (udang dangers) <)))
(define (insert x sL pred)
(let loop ((L sL))
(cond ((null? L) (list x))
((pred x (car L))
(cons x L))
(else (cons (car L)
(loop (cdr L)))))))
(define (rdang dangers)
(car dangers))
(define (ddang dangers)
(cadr dangers))
(define (udang dangers)
(caddr dangers))
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.
I want to change the nth element of a list and return a new list.
I've thought of three rather inelegant solutions:
(defun set-nth1 (list n value)
(let ((list2 (copy-seq list)))
(setf (elt list2 n) value)
list2))
(defun set-nth2 (list n value)
(concatenate 'list (subseq list 0 n) (list value) (subseq list (1+ n))))
(defun set-nth3 (list n value)
(substitute value nil list
:test #'(lambda (a b) (declare (ignore a b)) t)
:start n
:count 1))
What is the best way of doing this?
How about
(defun set-nth4 (list n val)
(loop for i from 0 for j in list collect (if (= i n) val j)))
Perhaps we should note the similarity to substitute and follow its convention:
(defun substitute-nth (val n list)
(loop for i from 0 for j in list collect (if (= i n) val j)))
BTW, regarding set-nth3, there is a function, constantly, exactly for situation like this:
(defun set-nth3 (list n value)
(substitute value nil list :test (constantly t) :start n :count 1))
Edit:
Another possibility:
(defun set-nth5 (list n value)
(fill (copy-seq list) value :start n :end (1+ n)))
It depends on what you mean for "elegance", but what about...
(defun set-nth (list n val)
(if (> n 0)
(cons (car list)
(set-nth (cdr list) (1- n) val))
(cons val (cdr list))))
If you have problems with easily understanding recursive definitions then a slight variation of nth-2 (as suggested by Terje Norderhaug) should be more "self-evident" for you:
(defun set-nth-2bis (list n val)
(nconc (subseq list 0 n)
(cons val (nthcdr (1+ n) list))))
The only efficiency drawback I can see of this version is that traversal up to nth element is done three times instead of one in the recursive version (that's however not tail-recursive).
How about this:
(defun set-nth (list n value)
(loop
for cell on list
for i from 0
when (< i n) collect (car cell)
else collect value
and nconc (rest cell)
and do (loop-finish)
))
On the minus side, it looks more like Algol than Lisp. But on the plus side:
it traverses the leading portion of the input list only once
it does not traverse the trailing portion of the input list at all
the output list is constructed without having to traverse it again
the result shares the same trailing cons cells as the original list (if this is not desired, change the nconc to append)