How to generalize this code for multi variable equations? - lisp

I am a newbie at LISP. I am following Andrew Ng's course for machine learning in Coursera (First week still). I wanted to try doing linear regression in LISP.
I wrote the code for single-variable linear regression. The code seems to work fine. I want to generalize this for multi-variable linear functions. I want to know how to start doing this. I want to end up with something like :
(defun run-linear-regression alpha iterations training-set number-of-variables (...))
which would in turn create a hypothesis generator function with input number of variables, partial derivative functions for these hypotheses, etc.
Following is the code I have so far. I do not need anyone to code this for me, but some guidance on how to go about doing what I want would be appreciated. Also, any general comments on how to improve the code (performance, style, etc) I have so far are also welcome.
(defun make-hypothesis (theta1 theta2)
(lambda (x)
(+ theta1 (* x theta2))))
(defun make-cost-function (hypothesis)
(lambda (training-data)
(let* ((x (car training-data)) (y (cadr training-data))
(val (- (funcall hypothesis x) y)))
(* val val))))
(defun make-J-1 (cost-function)
(lambda (training-set) (float
(/
(reduce #'+ (mapcar cost-function training-set))
(* 2 (length training-set))))))
(defun make-J (theta1 theta2)
(make-J-1 (make-cost-function (make-hypothesis theta1 theta2))))
(defun make-part-deriv-1 (hypothesis)
(lambda (test-set)
(let ((m (length test-set)))
(float (/
(reduce #'+ (mapcar (lambda(elem)(- (funcall hypothesis (car elem)) (cadr elem))) test-set))
m)))))
(defun make-part-deriv-2 (hypothesis)
(lambda (test-set)
(let ((m (length test-set)))
(float (/
(reduce #'+ (mapcar (lambda(elem)(* (- (funcall hypothesis (car elem)) (cadr elem)) (funcall hypothesis (car elem)))) test-set))
m)))))
(defun make-learn-fn (alpha theta1 theta2 make-part-deriv)
(lambda (test-set)
(let* ((hypothesis (make-hypothesis theta1 theta2)) (pdv (funcall make-part-deriv hypothesis)))
(* alpha (funcall pdv test-set)))))
(defun make-learners (alpha)
(list
(lambda (theta1 theta2 test-set) (- theta1 (funcall (make-learn-fn alpha theta1 theta2 #'make-part-deriv-1) test-set)))
(lambda (theta1 theta2 test-set) (- theta2 (funcall (make-learn-fn alpha theta1 theta2 #'make-part-deriv-2) test-set)))))
(defun run-linear-regression (alpha iterations training-set &optional (theta1 0) (theta2 0) (printer nil))
(let ((t1 theta1) (t2 theta2))
(dotimes (i iterations)
(if (not (null printer))
(funcall printer t1 t2))
(let* ((funcs (make-learners alpha))
(nt1 (funcall (car funcs) t1 t2 training-set))
(nt2 (funcall (cadr funcs) t1 t2 training-set)))
(setq t1 nt1)
(setq t2 nt2)))
(list t1 t2)))
in the end, I would call it like this:
(defvar *training-set* '((15 20) (700 6) (23 15) (19 19) (204 15) (60 150) (87 98) (17 35) (523 29)))
(run-linear-regression 0.0001 1000000 *training-set*)

I'm not familiar with the math here, but since no one else has written better answers, here's some general advice.
You should change RUN-LINEAR-REGRESSION to take a list of variables, as well as a list of learner-functions. For example:
(defun run-linear-regression (iterations training-set
variables learners)
(let ((vars variables))
(dotimes (i iterations)
(setf vars (mapcar (lambda (function)
(funcall function vars training-set))
learners)))
vars))
That takes the learners as an argument instead of making them in the function. Your original code makes the learners inside a loop, which didn't seem necessary since MAKE-LEARNERS only takes ALPHA as an argument, and that doesn't ever change, so the resulting learners will always be the same.
We also need to change MAKE-LEARNERS so that the lambda-functions will take a list of variables:
(defun make-learners (alpha)
(list (lambda (variables test-set)
(destructuring-bind (theta1 theta2) variables
(- theta1 (funcall (make-learn-fn alpha theta1 theta2
#'make-part-deriv-1)
test-set))))
(lambda (variables test-set)
(destructuring-bind (theta1 theta2) variables
(- theta2 (funcall (make-learn-fn alpha theta1 theta2
#'make-part-deriv-2)
test-set))))))
That's pretty much the same as what you had, but it uses DESTRUCTURING-BIND to extract THETA1 and THETA2 from the list VARIABLES. Now we can call RUN-LINEAR-REGRESSION like:
(run-linear-regression 1000000 *training-set* '(0 0) (make-learners 0.0001))
;=> (42.93504 2.5061023e-4)
To add more variables, you would write a suitable version of MAKE-LEARNERS. Since I don't know the math, I can't really make an example for that.

Related

Getting a "bad binding form" error in LISP

I have to write a simple program in Lisp that multiplies a polynomial by some factor. In this example, I want to multiply (x + 5) * 5x. The answer should be 5x^2 + 25x.
When I put in ((1 1) (5 0)) (5 1)) I should get (5 2) (25 1). However, I'm getting various errors ranging from undefined operator TERM in (TERM) and bad binding form. I'm a novice at Lisp and trying to return a list as shown above. Below is my short block of code:
(defun get-coef (term)
(car term))
(defun get-power (term)
(cadr term))
(defun make-term (coef power)
(cons coef power))
(defun poly-eval (poly factor)
(if (null poly) 0
(let ((term (car poly))
(let (coef ((* (get-coef(term)) (get-coef(factor)))))
(power ((+ (cadr(term)) (cadr(factor)))))
(make-term (coef power))
(poly-eval (cdr poly) factor))))))
Any help is appreciated!!
Several problems with your code:
You are using (fun (arg1 arg2)) syntax. It should be (fun arg1 arg2). For example, you write (make-term (coef power)) but it should be (make-term coef power).
Your bindings in let are all over the place. The correct syntax is
(let ((v1 e1)
(v2 e2)
(v3 e3))
e0)
i.e. all the bindings are in one list, and each binding is a list of two elements. Note that the expressions that the variables are bound to (e1 etc.) are not wrapped in any extra layers of parentheses.
make-term doesn't use the same representation as get-power. In get-power you use cadr so you need to make sure make-term puts the power in the right position.
Your poly-eval doesn't actually combine (make-term coef power) with the recursive call to (poly-eval (cdr poly) factor), so it gets lost. You should cons the "here"-result to the "there"-result.
Your poly-eval returns 0 instead of the empty list for empty polynomials.
All in all, your code can be fixed as
(defun get-coef (term)
(car term))
(defun get-power (term)
(cadr term))
(defun make-term (coef power)
(list coef power))
(defun poly-eval (poly factor)
(if (null poly) nil
(let ((term (car poly)))
(let
((coef (* (get-coef term) (get-coef factor)))
(power (+ (get-power term) (get-power factor))))
(cons (make-term coef power)
(poly-eval (cdr poly) factor))))))
giving e.g.
(poly-eval '((1 1) (5 0)) '(5 1))
resulting in
((5 2) (25 1))
Your make-term uses CONS but your get-power takes the CADR:
(defun get-power (term) (cadr term))
(defun make-term (coef power) (cons coef power))
You prolly wanted (list coef power).
(cons 'c 'p) returns (c . p), not (c p).
Now your get-power goes for CADR, the CAR of the CDR, but the CDR is 'p.
Your inputs are lists of coeff and power eg (5 1), so it seems the only problem is in your make-term.
Or you can turn around and be consistent with (( 5 . 1)(5 . 0) and then change get power to be (cdr term).
Another way:
(defun mult(term factor)
(list (* (first term) (first factor)) (+ (second term) (second factor))))
(defun polyeval(poly factor)
(cond
((null poly) nil)
(t (cons (mult (first poly) factor) (polyeval (rest poly) factor)))))
Note: first=car, rest=cdr, second=cadr

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.

Lisp style question: memoization (caution: contains the solution for project euler #14)

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.

Merging Two Matrixes... in LISP

(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.

What is wrong with the following Common Lisp macro using gensym?

Learning Common Lisp (using GNU CLISP 2.43) .. so might be a noob mistake. Example is the 'print prime numbers between x and y'
(defun is-prime (n)
(if (< n 2) (return-from is-prime NIL))
(do ((i 2 (1+ i)))
((= i n) T)
(if (= (mod n i) 0)
(return NIL))))
(defun next-prime-after (n)
(do ((i (1+ n) (1+ i)))
((is-prime i) i)))
(defmacro do-primes-v2 ((var start end) &body body)
`(do ((,var (if (is-prime ,start)
,start
(next-prime-after ,start))
(next-prime-after ,var)))
((> ,var ,end))
,#body))
(defmacro do-primes-v3 ((var start end) &body body)
(let ((loop-start (gensym))
(loop-end (gensym)))
`(do ((,loop-start ,start)
(,loop-end ,end)
(,var (if (is-prime ,loop-start)
,loop-start
(next-prime-after ,loop-start))
(next-prime-after ,var)))
((> ,var ,loop-end))
,#body )))
do-primes-v2 works perfectly.
[13]> (do-primes-v2 (p 10 25) (format t "~d " p))
11 13 17 19 23
Next I tried using gensym to avoid naming clashes in macro expansion - do-primes-v3. However I'm stuck with a
*** - EVAL: variable #:G3498 has no value
Tried using macro-expand to see if i could spot the mistake but I can't.
[16]> (macroexpand-1 `(do-primes-v3 (p 10 25) (format t "~d " p)))
(DO
((#:G3502 10) (#:G3503 25)
(P (IF (IS-PRIME #:G3502) #:G3502 (NEXT-PRIME-AFTER #:G3502))
(NEXT-PRIME-AFTER P)))
((> P #:G3503)) (FORMAT T "~d " P)) ;
Use DO* instead of DO.
DO Initializes the bindings in a scope where they are not yet visible. DO* initializes the bindings in a scope where they are visible.
In this particular case var needs to reference the other binding loop-start.
You don't actually need the gensym here for avoiding variable capture, because you do not introduce any variables that would be "local to the macro". When you macroexpand your do-primes-v2, you will see that no variable is introduced that didn't exist outside of the macro.
You do need it for a different thing, though: avoiding multiple evaluation.
If you call the macro like this:
(do-primes-v2 (p (* x 2) (* y 3))
(format "~a~%" p))
it expands to
(do ((p (if (is-prime (* x 2))
(* x 2)
(next-prime-after (* x 2))
(next-prime-after p)))
((> p (* y 3))
(format "~a~%" p))
At best, this is inefficient, because those multiplications are done multiple times. However, if you use a function with side effects as inputs, like setf or incf, this can be a big problem.
Either move the binding of your loop-start and loop-end to an enclosing LET block or use DO*. The reason is that all loop variables in DO are bound "in parallel", so for the first binding, the (expanded) loop-start variable does not yet have a binding.
I know this doesn't really answer your question, but I do think it is relevant. In my experience, the type of macro you are attempting to write is a very common one. One problem I have with the way you have approached the problem is that it doesn't handle another common use case: functional composition.
I don't have the time to highlight some of the difficulties you will probably encounter using your macro, I will however highlight that, had you built your prime iterator geared towards functional composition, your macro turns out to be extremely simple, avoiding your question altogether.
Note: I have slightly modified some of your functions.
(defun is-prime (n)
(cond
((< n 2)
nil)
((= n 2)
t)
((evenp n)
nil)
(t
(do ((i 2 (1+ i)))
((= i n) t)
(when (or (= (mod n i) 0))
(return nil))))))
(defun next-prime (n)
(do ((i n (1+ i)))
((is-prime i) i)))
(defun prime-iterator (start-at)
(let ((current start-at))
(lambda ()
(let ((next-prime (next-prime current)))
(setf current (1+ next-prime))
next-prime))))
(defun map-primes/iterator (fn iterator end)
(do ((i (funcall iterator) (funcall iterator)))
((>= i end) nil)
(funcall fn i)))
(defun map-primes (fn start end)
(let ((iterator (prime-iterator start)))
(map-primes/iterator fn iterator end)))
(defmacro do-primes ((var start end) &body body)
`(map-primes #'(lambda (,var)
,#body)
,start ,end))
I too recommend that you look at Series. The generator pattern is also a very common occurrence in lisp programs. You may also want to look at Alexandria, in particular the function ALEXANDRIA:COMPOSE to see what cool stuff you can do with functional composition.
I suggest avoiding DO/DO* and macros altogether and instead going for Series (an implementation of which can be found on series.sourceforge.net).
If that's too complex then consider just generating a list of primes with recursion or a generator (for on-demand generation).