Guest User

Untitled

a guest
Oct 19th, 2018
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.12 KB | None | 0 0
  1. ;; Differential evolution minimization algorithm
  2. ;;
  3. ;; f -- minimized function
  4. ;; feasible? -- predicate for checking feasibility of a vector
  5. ;; initial-population
  6. ;; F -- value in v1 + F(v2 - v3). Must be in [0..2]
  7. ;; CR -- probability of crossing in crossover
  8. ;; generations -- maximal number of generations
  9. (define (differential-evolution f feasible? initial-population F CR generations)
  10. ;; Auxiliary function breed
  11. ;; Calculates next population
  12. ;; population -- some population
  13. (define (breed population)
  14. ;; Mutate i-th vector in population
  15. (define (mutate i)
  16. ;; Generate m unique indices for list of
  17. ;; length n
  18. (define (generate-indices n m)
  19. ;; Generate unique random number with
  20. ;; given list of forbidden numbers
  21. (define (random-unique forbidden)
  22. (let ((value (random-integer n)))
  23. (if (or (= value i)
  24. (list-member? forbidden value))
  25. (random-unique forbidden)
  26. value)))
  27. ;; Helper for generating indices
  28. (define (generate-indices-helper indices j)
  29. (if (= j m)
  30. indices
  31. (generate-indices-helper
  32. (cons (random-unique indices)
  33. indices)
  34. (+ j 1))))
  35. (generate-indices-helper '() 0))
  36. ;; Get values from list using
  37. ;; given list of indices
  38. (define (list-ref-multi source indices)
  39. ;; Helper
  40. (define (list-ref-multi-helper values list-indices)
  41. (if (null? list-indices)
  42. (reverse values)
  43. (list-ref-multi-helper
  44. (cons (list-ref source (car list-indices))
  45. values)
  46. (cdr list-indices))))
  47. (list-ref-multi-helper '() indices))
  48. ;; Mutation algorithm itself
  49. (let* ((mixins (list-ref-multi
  50. population
  51. (generate-indices (length population) 3)))
  52. (v1 (car mixins))
  53. (v2 (cadr mixins))
  54. (v3 (caddr mixins)))
  55. (map + v1 (map (lambda (x) (* x F)) (map - v2 v3)))))
  56. ;; Crossover with father
  57. (define (crossover father trial)
  58. (define (crossover-helper crossed-genes father trial)
  59. (if (null? father)
  60. (reverse crossed-genes)
  61. (crossover-helper (cons (if (< (random-real) CR)
  62. (car father)
  63. (car trial))
  64. crossed-genes)
  65. (cdr father)
  66. (cdr trial))))
  67. (crossover-helper '() father trial))
  68. ;; Main breeding algorithm
  69. (define (breed-helper breeded i)
  70. (if (= i (length population))
  71. (reverse breeded)
  72. (let* ((father (list-ref population i))
  73. (trial (crossover father
  74. (mutate i)))
  75. (trial-fitness (f trial))
  76. (father-fitness (f father))
  77. (survived (if (and (< trial-fitness father-fitness)
  78. (feasible? trial))
  79. trial
  80. father)))
  81. (breed-helper (cons survived breeded) (+ i 1)))))
  82. (breed-helper '() 0))
  83. ;; Main evolution algorithm
  84. (define (differential-evolution-helper breeded i)
  85. (if (= i generations)
  86. breeded
  87. (differential-evolution-helper
  88. (breed breeded)
  89. (+ i 1))))
  90. (differential-evolution-helper initial-population 0))
Add Comment
Please, Sign In to add comment