I am just trying to learn some Lisp, so I am going through project euler problems. I found problem no. 14 interesting (so if you are planning to solve this problems stop reading now, because I pasted my solution at the bottom). With my algorithm it was so slow, but after using memoization (I copied the function from Paul Graham's "on Lisp" book) it was much more faster (around 4 to 8 seconds).
My question is about this bunch of warnings that I got:
Am I doing something wrong? Can I improve my style?
> ;; Loading file
> /euler-lisp/euler-14.lisp
> ... WARNING in COLLATZ-SERIE :
> COLLATZ-SERIE-M is neither declared
> nor bound, it will be treated as if it
> were declared SPECIAL. WARNING in
> COLLATZ-SERIE : COLLATZ-SERIE-M is
> neither declared nor bound, it will be
> treated as if it were declared
> SPECIAL. WARNING in COMPILED-FORM-314
> : COLLATZ-SERIE-M is neither declared
> nor bound, it will be treated as if it
> were declared SPECIAL. (525 837799)
> Real time: 18.821894 sec. Run time:
> 18.029127 sec. Space: 219883968 Bytes GC: 35, GC time: 4.080254 sec. Las
> siguientes variables especiales no han
> sido definidas: COLLATZ-SERIE-M 0
> errores, 0 advertencias ;; Loaded file
This is the code:
(defun collatz (n)
(if (evenp n) (/ n 2) (+ (* 3 n) 1)))
(defun memoize (fn)
(let ((cache (make-hash-table :test #'equal)))
#'(lambda (&rest args)
(multiple-value-bind (val win) (gethash args cache)
(if win
val
(setf (gethash args cache)
(apply fn args)))))))
(defun collatz-serie (n)
(cond ((= n 1) (list 1))
((evenp n) (cons n (funcall collatz-serie-m (/ n 2))))
(t (cons n (funcall collatz-serie-m (+ (* 3 n) 1))))))
(defun collatz-serie-len (n)
(length (collatz-serie n)))
(setq collatz-serie-m (memoize #'collatz-serie))
(defun gen-series-pairs (n)
(loop for i from 1 to n collect
(list (collatz-serie-len i) i)))
(defun euler-14 (&key (n 1000000))
(car (sort (gen-series-pairs n) #'(lambda (x y) (> (car x) (car y))))))
(time (print (euler-14)))
Thanks a lot, and forgive the probable errors, I am just beginning with Lisp.
Br
UPDATE:
i want to share the final code that i wrote. using custom external hash table for memoization and improving the final loop.
(defvar *cache* (make-hash-table :test #'equal))
(defun collatz (n)
(if (evenp n) (/ n 2) (+ (* 3 n) 1)))
(defun collatz-serie (n)
(cond ((= n 1) (list 1))
((evenp n) (cons n (collatz-serie (/ n 2))))
(t (cons n (collatz-serie (+ (* 3 n) 1))))))
(defun collatz-serie-new (n)
(labels ((helper (n len)
(multiple-value-bind (val stored?) (gethash n *cache*)
(if stored?
val
(setf (gethash n *cache*) (cond ((= n 1) len)
((evenp n) (+ len (helper (/ n 2) len)))
(t (+ len (helper (+ (* 3 n) 1) len)))))))))
(helper n 1)))
;; learning how to loop
(defun euler-14 (&key (n 1000000))
(loop with max = 0 and pos = 0
for i from n downto 1
when (> (collatz-serie-new i) max)
do (setf max (collatz-serie-new i)) and do (setf pos i)
finally (return (list max pos))))
It is bad style to setq an unknown name. It is assumed that you mean to create a new global special variable, then set it, but this should be made explicit by introducing these bindings first. You do this at the top level by using defvar (or defparameter or defconstant) instead, and in lexical blocks by using let, do, multiple-value-bind or similar constructs.
Related
I'm having trouble finding my error.
This keeps returning nil:
(even-greater-n 5 '(1 2 3 4 5 6 7))
(defun even-greater-n (n L)
(cond ((null L) nil)
((and (> (car L) n) (evenp n)) (car L))
(t (even-greater-n n (cdr L)))))
Your error
You are passing to evenp n
instead of (car L).
Iteration
This is relatively easy to implement using
loop:
(defun even-greater (n l)
(loop for k in l
when (and (< n k)
(evenp k))
return k))
(even-greater 5 '(1 2 3 4 5 6 7 8))
==> 6
Recursion
If you are required to use recursion, you can do it too:
(defun even-greater (n l)
(cond ((endp l) nil)
((and (< n (first l))
(evenp (first l)))
(first l))
(t (even-greater n (rest l)))))
(even-greater 3 '(1 2 3 4 5 6 7 8))
==> 4
Library
And, of course, Lisp has a very powerful library, including
find-if:
(defun even-greater (n l)
(find-if (lambda (k)
(and (< n k)
(evenp k)))
l))
(even-greater 2 '(1 2 3 4 5 6 7 8))
==> 4
You must look for (car L) is even or not.
Using find-if and a single, open-coded lambda function:
(defun even-greater (n list)
(find-if (lambda (item) (and (> item n) (evenp item))) list))
Using functional combinators:
;; Combine multiple functions with AND:
;; Returns a function of one-argument which
;; passes that argument to the functions in the list,
;; one by one. If any function returns nil, it stops
;; and returns nil. Otherwise it returns the value
;; returned by the last function:
(defun andf (&rest functions)
(lambda (arg)
(let (res)
(dolist (f functions res)
(unless (setf res (funcall f arg))
(return))))))
;; Returns a one-argument function which tests
;; whether its argument is greater than quant.
(defun greater (quant)
(lambda (arg) (> arg quant)))
;; "find it, if it is greater than n, and even"
(defun even-greater (n list)
(find-if (andf (greater n) #'evenp) list))
This is Trying code
(defun f (a n)
(if (zerop n)
1
(* a (f a (- n 1)))))
(f 3) should return 27, (f 4) should return 256
I tried using two variables, but it be against the rules.
Is it possible to use only one variable using recursive?
Thanks for any ideas
I don't know CL, but I do know Clojure and other languages that use recursion.
In cases where a recursive function has 1 parameter acting as an accumulator, but is only set on the first call, the typical way around this is to wrap f in another function. There are 2 (basically the same) ways of doing this:
(defun g (a n)
(if (zerop n)
1
(* a (g a (- n 1)))))
(defun f (n)
; I'm assuming you want the initial value of "a" to be 1
(g 1 n))
Or, more succinctly:
(defun f (n)
(let (g (fn (n)
(if (zerop n)
1
(* a (g a (- n 1))))))))
; Instead of f being recursive, f calls g, which is recursive
(g 1 n))
Excuse any syntax errors.
Using an additional variable to count down would be the sane choice, but you don't need to change the contract of just one numeric argument input just for this. You can make a helper to do that:
(defun exptnn (n)
"Get the (expt n n)"
(check-type n integer)
(labels ((helper (acc count)
(if (zerop count)
acc
(helper (* acc n) (1- count)))))
(if (< n 0)
(/ 1 (helper 1 (- n)))
(helper 1 n))))
Now to solve with without any helpers just with one argument is possible since there is a solution doing that already, but I must say that is like programming in Brainf*ck without the joy!
CL-USER 15 > (defun f (n)
(labels ((g (m)
(if (zerop m)
1
(* n (g (1- m))))))
(g n)))
F
CL-USER 16 > (f 0)
1
CL-USER 17 > (f 1)
1
CL-USER 18 > (f 2)
4
CL-USER 19 > (f 3)
27
CL-USER 20 > (f 4)
256
CL-USER 21 > (loop for i below 10 collect (f i))
(1 1 4 27 256 3125 46656 823543 16777216 387420489)
This is a solution where no functions with more than one parameter are used (except for =, +, *, logand, ash; note also that logand and ash always take a constant as second parameter so they can be implemented as unary functions too).
The idea is to "hide" the two parameters needed for the obvious recursive approach in a single integer using odd/even bits.
(defun pair (n)
(if (= n 0)
0
(+ (* 3 (logand n 1))
(ash (pair (ash n -1)) 2))))
(defun pair-first (p)
(if (= p 0)
0
(+ (logand p 1)
(ash (pair-first (ash p -2)) 1))))
(defun pair-second (p)
(pair-first (ash p -1)))
(defun subsec (p)
(if (= 2 (logand p 2))
(- p 2)
(+ (logand p 1) 2 (ash (subsec (ash p -2)) 2))))
(defun pairpow (p)
(if (= (pair-second p) 1)
(pair-first p)
(* (pair-first p)
(pairpow (subsec p)))))
(defun f (n)
(pairpow (pair n)))
No reasonable real use, of course; but a funny exercise indeed.
Yes, this is possible:
(defun f (n)
(cond
((numberp n)
(f (cons n n)))
((zerop (car n))
1)
(t
(* (cdr n)
(f (cons (1- (car n))
(cdr n)))))))
The trick is that you can store any data structure (including a pair of numbers) in a single variable.
Alternatively, you can use helpers from the standard library:
(defun f (n)
(apply #'*
(loop repeat n collect n)))
But that doesn't use recursion. Or simply:
(defun f (n)
(expt n n))
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))
I've a question, how to return a list without the nth element of a given list? E.g., given list: (1 2 3 2 4 6), and given n = 4, in this case the return list should be (1 2 3 4 6).
A simple recursive solution:
(defun remove-nth (n list)
(declare
(type (integer 0) n)
(type list list))
(if (or (zerop n) (null list))
(cdr list)
(cons (car list) (remove-nth (1- n) (cdr list)))))
This will share the common tail, except in the case where the list has n or more elements, in which case it returns a new list with the same elements as the provided one.
Using remove-if:
(defun foo (n list)
(remove-if (constantly t) list :start (1- n) :count 1))
butlast/nthcdr solution (corrected):
(defun foo (n list)
(append (butlast list (1+ (- (length list) n))) (nthcdr n list)))
Or, maybe more readable:
(defun foo (n list)
(append (subseq list 0 (1- n)) (nthcdr n list)))
Using loop:
(defun foo (n list)
(loop for elt in list
for i from 1
unless (= i n) collect elt))
Here's an interesting approach. It replaces the nth element of a list with a new symbol and then removes that symbol from the list. I haven't considered how (in)efficient it is though!
(defun remove-nth (n list)
(remove (setf (nth n list) (gensym)) list))
(loop :for i :in '(1 2 3 2 4 6) ; the list
:for idx :from 0
:unless (= 3 idx) :collect i) ; except idx=3
;; => (1 2 3 4 6)
loop macro can be very useful and effective in terms of generated code by lisp compiler and macro expander.
Test run and apply macroexpand above code snippet.
A slightly more general function:
(defun remove-by-position (pred lst)
(labels ((walk-list (pred lst idx)
(if (null lst)
lst
(if (funcall pred idx)
(walk-list pred (cdr lst) (1+ idx))
(cons (car lst) (walk-list pred (cdr lst) (1+ idx)))))))
(walk-list pred lst 1)))
Which we use to implement desired remove-nth:
(defun remove-nth (n list)
(remove-by-position (lambda (i) (= i n)) list))
And the invocation:
(remove-nth 4 '(1 2 3 2 4 6))
Edit: Applied remarks from Samuel's comment.
A destructive version, the original list will be modified (except when n < 1),
(defun remove-nth (n lst)
(if (< n 1) (cdr lst)
(let* ((p (nthcdr (1- n) lst))
(right (cddr p)))
(when (consp p)
(setcdr p nil))
(nconc lst right))))
That's elisp but I think those are standard lispy functions.
For all you haskellers out there, there is no need to twist your brains :)
(defun take (n l)
(subseq l 0 (min n (length l))))
(defun drop (n l)
(subseq l n))
(defun remove-nth (n l)
(append (take (- n 1) l)
(drop n l)))
My horrible elisp solution:
(defun without-nth (list n)
(defun accum-if (list accum n)
(if (not list)
accum
(accum-if (cdr list) (if (eq n 0) accum (cons (car list) accum))
(- n 1))))
(reverse (accum-if list '() n)))
(without-nth '(1 2 3) 1)
Should be easily portable to Common Lisp.
A much simpler solution will be as follows.
(defun remove-nth (n lst)
(append (subseq lst 0 (- n 1)) (subseq lst n (length lst)))
)
(defun merge-matrix (matrix-1 matrix-2)
(if (not (or (eql (matrix-rows matrix-1) (matrix-rows matrix-2)) (null matrix-1) (null matrix-2))) (error "Invalid dimensions."))
(cond
((null matrix-1) (copy-tree matrix-2))
((null matrix-2) (copy-tree matrix-1))
(t (let ((result (copy-tree matrix-1)))
(dotimes (i (matrix-rows matrix-1))
(setf (nth i result) (nconc (nth i result) (nth i matrix-2))))
result))))
(merge-matrix '((3 1) (1 3)) '((4 2) (1 1)))
*** - EVAL: variable NULL has no value
I receive an error like that how I can fix the problem, thanks
The OP's code works for me. However I felt motivated to improve it and
I implemented the same idea (but a bit more powerful).
The semantics are the same as Matlab's vertcat.
The function appends all arguments into one big matrix.
Note that due to the declarations my code should be super efficient.
(deftype mat ()
"Non-square matrices. Last index is columns, i.e. row-major order."
`(simple-array single-float 2))
(defun are-all-elements-typep (type ls)
(reduce #'(lambda (b x) (and b (typep x type)))
ls))
(defun are-all-matrix-heights-equalp (ls)
(let ((first-height (array-dimension (first ls) 0)))
(reduce #'(lambda (b x) (and b
(= first-height
(array-dimension x 0))))
ls)))
(defun vertcat (&rest rest)
(declare (type cons rest))
(unless (are-all-elements-typep 'mat rest)
(break "At least one of the arguments isn't a matrix."))
(unless (are-all-matrix-heights-equalp rest)
(break "All Matrices must have the same number of rows."))
(let* ((height (array-dimension (first rest) 0))
(widths (mapcar #'(lambda (mat) (array-dimension mat 1)) rest))
(result (make-array (list height
(reduce #'+ widths))
:element-type 'single-float))
(current-width 0))
(dotimes (m (length rest))
(let ((e (elt rest m)))
(destructuring-bind (y x) (array-dimensions e)
(dotimes (j y)
(dotimes (i x)
(setf (aref result j (+ current-width i))
(aref e j i))))
(incf current-width (elt widths m)))))
(the mat result)))
#+nil
(let ((a (make-array '(2 3)
:initial-contents '((1s0 2s0 3s0)
(2s0 4s0 5s0))
:element-type 'single-float))
(b (make-array '(2 2)
:initial-contents '((6s0 7s0)
(9s0 8s0))
:element-type 'single-float)))
(vertcat a b a))
;=> #2A ((1.0 2.0 3.0 6.0 7.0 1.0 2.0 3.0) (2.0 4.0 5.0 9.0 8.0 2.0 4.0 5.0))
The error message you're getting suggests that lisp is trying to treat one of your calls to null as a variable. I was able to replicate this behavior by defining matrix-rows like Frank Shearar did and deleting the parentheses around the ((null matrix-1) (copy-tree matrix-2)) s-expression, for example. I'd suggest you check your parentheses, either manually or using something like SLIME, which gave me a warning when I tried to compile the function.