File: problems1.lisp

package info (click to toggle)
cl-rsm-genetic-alg 1.2
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 88 kB
  • ctags: 35
  • sloc: lisp: 571; makefile: 44; sh: 28
file content (86 lines) | stat: -rw-r--r-- 2,763 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          problems1.lisp
;;;; Purpose:       Example Definition Of Genetic Algorithm Problems.
;;;; Author:        R. Scott McIntire
;;;; Date Started:  Aug 2003
;;;;
;;;; $Id: problems1.lisp,v 1.4 2003/09/10 22:19:25 rscottmcintire Exp $
;;;; *************************************************************************


(in-package rsm.genetic-alg)

(eval-when (:compile-toplevel)
  (declaim (optimize (speed 3) (debug 0) (safety 1) (space 0))))


;; Genetic algorithm problem (1).
(defgenetic max-alt-ones
  
  ;; Mutation rate - percentage of mutations which occur during mating.
  :mutation-rate 5
  
  ;; Fitness function - a function: Maximum fitness goes to genes 
  ;; that alternate between ones and zeros.
  ;; NOTE: A gene is a vector from the alphabet listed below.
  :fitness-function #'(lambda (gene) 
                        (let ((sum 10))
                          (let ((last (aref gene 0)))
                            (loop for i from 1 below (length gene) do
                                  (let ((val (aref gene i)))
                                    (unless (= val last)
                                      (incf sum 10))
                                    (setf last val))))
                          sum))
  
  ;; Gene alphabet - a vector.
  :alphabet #(0 1)

  
  ;; Initial gene pool - a list of genes (each gene is a list with
  ;; elements taken from the alphabet.
  :pool '((1 1 1 0 0 0 1 0) 
          (0 0 1 1 0 0 1 1) 
          (0 0 0 0 1 1 1 1)
          (1 1 1 0 0 0 1 0) 
          (0 0 1 1 0 0 1 1) 
          (0 0 1 0 1 1 0 1)
          (1 1 1 0 0 0 1 0) 
          (0 0 0 1 0 0 1 1) 
          (0 1 0 0 1 0 0 1)
          (0 0 0 1 0 1 1 0)))


;; Genetic algorithm problem (2).
(defgenetic max-ones 
  
  ;; Mutation rate - percentage of mutations which occur during mating.
  :mutation-rate 5  
  
  ;; Fitness function - a function: Fitness function favors genes 
  ;; with more ones.
  :fitness-function #'(lambda (gene) 
                        (let ((sum 10))
                          (loop for val across gene sum val)))
  
  ;; Gene alphabet - a vector.
  :alphabet #(0 1)
  
  ;; Initial gene pool - a list of genes (each gene is a list with
  ;; elements taken from the alphabet.)
  :pool '((0 1 0 1 0 1 0 1) 
          (1 0 1 0 1 0 1 0) 
          (1 1 1 0 0 0 1 0) 
          (0 0 1 1 0 0 1 1) 
          (0 0 0 0 1 1 1 1)
          (1 1 1 0 0 0 1 0) 
          (0 0 1 1 0 0 1 1) 
          (0 0 1 0 1 1 1 1)
          (1 1 1 0 0 0 1 0) 
          (0 0 0 1 0 0 1 1) 
          (0 1 0 0 1 0 1 1)
          (0 0 0 1 0 1 1 0)))