Generating patterns with genetic algorithms

fit-patterns.rkt

#lang racket
(require 2htdp/image)
(require "../connive/connive.rkt")

(:= rate 5) ; amount to mutate each property per generation
(:= gen-size 30) ; generation size
(:= acceptable-dist 20) ; how close the best of a generation is to ideal to stop evolving

(struct state (a o h r g b) #:transparent)

(:= ideal (state 50 30 10 0 0 0))

(:= (bound lo hi n) (max lo (min hi n)))

(:= (mutate v) 
    (+ v ((if (< 0.5 (random)) - +) (random rate))))

(:= (val lo hi v)
    (bound lo hi (mutate v)))

(:== state-mutate (s)
     ((state a o h r g b)) 
     (state (val 0 360 a) (val 5 200 o) (val 5 200 h)
            (val 0 255 r) (val 0 255 g) (val 0 255 b)))

(:== state-render (s)
     ((state a o h r g b)) 
     (triangle/ass a o h "solid" (color r g b)))

(:= (state-gen gen) ; take best of generation and breed it with all others of generation
    (:= best (gen-fittest gen))
    (map (curry state-breed best) gen))

(:= (gen-random)
    (build-list gen-size (λ (n) (state-random))))

(:= (min-by f ls)
    (:== aux (ls best best-score)
         (null _ _) best
         ((cons x xs) _ _) (lyt (res (f x))
                                (if (< res best-score) 
                                    (aux xs x res)
                                    (aux xs best best-score))))
    (aux ls null +inf.0))

(:== state-breed (s1 s2) ; mutate offspring of two parents
     ((state a o h r g b) (state a2 o2 h2 r2 g2 b2))
     (state-mutate (state (avg a a2 a2) (avg o o2 o2) (avg h h2 h2)
                          (avg r r2 r2) (avg g g2 g2) (avg b b2 b2))))

(:= (gen-fittest gen) 
    (min-by (curry dist ideal) gen))
         
(:== dist (s1 s2) ; dist is defined as closeness of s1 to s2
     ((state a o h r g b) (state a2 o2 h2 r2 g2 b2))
     (+ (abs (- a a2)) (abs (- o o2)) (abs (- h h2))
        (abs (- r r2)) (abs (- g g2)) (abs (- b b2))))
       
(:= avg 
    (λ ls (quotient (apply + ls) (length ls))))

(:= (good-enough? gen)
    (< (apply avg (map (curry dist ideal) gen)) acceptable-dist))

(:= (state-random)
  (state (random 360) (random 50) (random 50)
         (random 255) (random 255) 255))

(:= (evolve gens) ; gens = [[state]]
    (?? (good-enough? (car gens)) 
        (apply above 
               (map (λ (gen) 
                      (apply (curry beside/align "bottom") (map state-render gen))) gens))
        (evolve (cons (state-gen (car gens)) gens))))

(evolve (list (gen-random)))