| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465 |
- #lang racket
- ;; A simple genetic algorithm
- ;; Computer Exercise #1 from Intro to GA by Mitchell
- ;;
- ;; Uses:
- ;; - fitness-proportionate selection
- ;; - routlette-wheel sampling
- ; The population is stored as a single list of popsize*chromlen elements
- (require math)
- ; population size and individual chromosome length
- (define popsize 100)
- (define chromlen 100)
- ; single-point crossover rate
- (define p-cross 0.7)
- ; bitwise mutation rate
- (define p-mutate 0.001)
- ; Fitness assessment is the number of 1's in the population member
- (define (fitness member)
- (/ (sum member)
- (length member)))
- ; Flip a chromosome to its opposite
- (define (flip-chrom val)
- (if (eq? val 1) 0 1))
- ; mutate
- ; because of the way the population is stored and that mutations happen after
- ; offspring are produced, we can mutate the whole list together
- (define (mutate pop)
- (for/list ([i pop])
- ((λ (chrom)
- (if (<= (random) p-mutate)
- (flip-chrom i)
- i))
- i)))
- ; Initialize a random population.
- (define (initpop)
- (for/list ([i (in-range (* popsize chromlen))])
- (random-integer 0 2)))
- ; check mutation rate
- ; return the number of members that are different between pop1 and pop2
- (define (mcheck pop1 pop2)
- (for/list ([i (length pop1)])
- (if (eq? (list-ref pop1 i) (list-ref pop2 i))
- 0
- 1)))
- ; testing/debugging code below
- (define pop (initpop))
- (define mutated (mutate pop))
- (define (actualmutrate pop mutated)
- (/ (sum (mcheck pop mutated)) (* popsize chromlen)))
- (write-string (string-append (real->decimal-string (actualmutrate pop mutated))
- "\n"))
|