Help with GA, and critique my Lisp (please ;-))

From: William Bland (news456_at_abstractnonsense.com)
Date: 09/27/04 

Date: Mon, 27 Sep 2004 16:25:38 GMT

Hi all,
        going on the theory that you have to not mind looking like an idiot if
you want to learn anything worth knowing...

I wanted to try something a little more advanced than the toy problems
I've been solving in Lisp. Actually this one's still a toy, but I can't
get it to work! I have to (shamefully) admit that I thought I understood
Genetic Algorithms because I've read a lot about how other people have
used them, but I now realise I know next to nothing. This is the first
time I've tried to implement one myself and, embarrassingly the fitness
(both max and average) seems to trend downwards! It never gets close to
solving the problem (simply finding a polynomial that passes through a
given set of points in the plane). I'd be very interested to hear from
any GA gurus who might be able to see what I'm doing wrong.

I'm also interested to hear what warts I might have in my Lisp code, as
this is one of the largest chunks of CL code I've written so far. I
probably still write CL with a bit of a Scheme accent (hopefully my Java
accent doesn't show too much though!). Oh, I know using ERROR to end the
program is *unspeakably* ugly - any thoughts on the Right Way to do it?

Thanks very much for any comments.

;;;; ga.lisp Try to find a polynomial to fit a set of points
;;;; There is an easy exact solution - I wanted to see if a
;;;; GA could find it.

(defun evaluate-poly (p x) ; (7 3 3.14) represents 7 + 3x + 3.14x^2
  (labels ((looper (p acc power)
              (if p
                  (looper (rest p) (+ acc (* (first p) (expt x power)))
                     (1+ power))
                  acc)))
    (looper p 0 0)))

(defun fitness (p points) ; points is a list of points (z1 z2 ...)
  (let ((dist 0))
    (dolist (pt points dist)
      (incf dist (abs (- (imagpart pt) (evaluate-poly p (realpart pt))))))
    (if (= dist 0)
        (error "Found solution")
        (/ 1 dist))))

(defun make-random-poly ()
  (let ((ret nil))
    (dotimes (i (random 10) ret)
      (push (- (random 10.0) (random 10.0)) ret))))

(defun make-random-point ()
  (complex (- (random 10.0) (random 10.0))
           (- (random 10.0) (random 10.0))))

(defun mate-polys (p q)
  (cond ((or (null p) (null q))
         (append p q))
        ((> (random 100) 95)
         (mate-polys p (make-random-poly)))
        ((> (random 100) 95)
         (mate-polys (make-random-poly) q))
        (t
         (let ((split (random (min (length p) (length q)))))
           (append (subseq p 0 split)
                   (subseq q split))))))

(defun random-element (lst)
  (nth (random (length lst)) lst))

(defun main ()
  (let ((population nil)
        (points nil))
    (dotimes (i 5) (push (make-random-point) points))
    (dotimes (i 10000) (push (make-random-poly) population))
    (loop
       (let* ((new-population nil)
              (fitnesses (mapcar (lambda (p) (fitness p points)) population))
              (sum-fitnesss (apply #'+ fitnesses))
              (weighted-population nil))
         (format t "Current best: ~A, average: ~A~%"
                 (apply #'max fitnesses) (/ sum-fitnesss (length population)))
         (force-output)
         (dolist (p population)
           (dotimes (i (/ (fitness p points) sum-fitnesss))
             (push p weighted-population)))
         (dotimes (i (length population))
           (push (mate-polys (random-element weighted-population)
                             (random-element weighted-population))
                 new-population))
         (setf population new-population)))))

;;;; End of file

Thanks again,
                Bill. 

-- 
Dr. William Bland.
It would not be too unfair to any language to refer to Java as a
stripped down Lisp or Smalltalk with a C syntax.   (Ken Anderson).

Relevant Pages

  • Re: conciseness is power
    ... > (defun find-anagrams (path) ... > (anagram-list anagrams))) ... the Perl code seems more concise. ... The Common Lisp language doesn't have this operator. ...
    (comp.lang.lisp)
  • Re: Looking for bored Lisper with GUI chops.
    ... > Common Lisp and I have this other project I'm trying to finish at the ... > Groovy gets some wins, in this app anyway, from having access to Java ... using Lispworks and Foil, my successor to jfli. ... (defun find-child (node name) ...
    (comp.lang.lisp)
  • Re: Naive question about lisp web applications
    ... I learned lisp almost 20 years ago, ... You just need to know a few HTML. ... (defun formular-page () ... (defun argument (name query) ...
    (comp.lang.lisp)
  • Re: Lisp in C.
    ... Why not write the whole thing in Lisp? ... Assumes only quote, atom, eq, cons, car, cdr, cond. ... (defun null. ... (cond ((null. ...
    (comp.lang.lisp)
  • Re: How to create local state for functions?
    ... bound to the variable new-node. ... In Lisp, DEFUN is a macro which creates the lambda closure internally ... The DEFVAR construct ensures once-only initialization. ...
    (comp.lang.lisp)