Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;; Differential evolution minimization algorithm
- ;;
- ;; f -- minimized function
- ;; feasible? -- predicate for checking feasibility of a vector
- ;; initial-population
- ;; F -- value in v1 + F(v2 - v3). Must be in [0..2]
- ;; CR -- probability of crossing in crossover
- ;; generations -- maximal number of generations
- (define (differential-evolution f feasible? initial-population F CR generations)
- ;; Auxiliary function breed
- ;; Calculates next population
- ;; population -- some population
- (define (breed population)
- ;; Mutate i-th vector in population
- (define (mutate i)
- ;; Generate m unique indices for list of
- ;; length n
- (define (generate-indices n m)
- ;; Generate unique random number with
- ;; given list of forbidden numbers
- (define (random-unique forbidden)
- (let ((value (random-integer n)))
- (if (or (= value i)
- (list-member? forbidden value))
- (random-unique forbidden)
- value)))
- ;; Helper for generating indices
- (define (generate-indices-helper indices j)
- (if (= j m)
- indices
- (generate-indices-helper
- (cons (random-unique indices)
- indices)
- (+ j 1))))
- (generate-indices-helper '() 0))
- ;; Get values from list using
- ;; given list of indices
- (define (list-ref-multi source indices)
- ;; Helper
- (define (list-ref-multi-helper values list-indices)
- (if (null? list-indices)
- (reverse values)
- (list-ref-multi-helper
- (cons (list-ref source (car list-indices))
- values)
- (cdr list-indices))))
- (list-ref-multi-helper '() indices))
- ;; Mutation algorithm itself
- (let* ((mixins (list-ref-multi
- population
- (generate-indices (length population) 3)))
- (v1 (car mixins))
- (v2 (cadr mixins))
- (v3 (caddr mixins)))
- (map + v1 (map (lambda (x) (* x F)) (map - v2 v3)))))
- ;; Crossover with father
- (define (crossover father trial)
- (define (crossover-helper crossed-genes father trial)
- (if (null? father)
- (reverse crossed-genes)
- (crossover-helper (cons (if (< (random-real) CR)
- (car father)
- (car trial))
- crossed-genes)
- (cdr father)
- (cdr trial))))
- (crossover-helper '() father trial))
- ;; Main breeding algorithm
- (define (breed-helper breeded i)
- (if (= i (length population))
- (reverse breeded)
- (let* ((father (list-ref population i))
- (trial (crossover father
- (mutate i)))
- (trial-fitness (f trial))
- (father-fitness (f father))
- (survived (if (and (< trial-fitness father-fitness)
- (feasible? trial))
- trial
- father)))
- (breed-helper (cons survived breeded) (+ i 1)))))
- (breed-helper '() 0))
- ;; Main evolution algorithm
- (define (differential-evolution-helper breeded i)
- (if (= i generations)
- breeded
- (differential-evolution-helper
- (breed breeded)
- (+ i 1))))
- (differential-evolution-helper initial-population 0))
Add Comment
Please, Sign In to add comment