Particle swarm optimization: Difference between revisions

=={{header|Racket}}==

<lang racket>#lang racket/base

(require racket/list racket/math)

(define (unbox-into-cycle s)

(if (box? s) (in-cycle (in-value (unbox s))) s))

;; Tries to "maximise" function > (so if you want a minimum, set #:> to <, IYSWIM)

(define (PSO f particles iterations hi lo #:ω ω #:φ_p φ_p #:φ_g φ_g #:> (>? >))

(define dimensions (procedure-arity f))

(unless (exact-nonnegative-integer? dimensions)

(raise-argument-error 'PSO "function of fixed arity" 1 f))

(define-values (x v)

(for/lists (x v)

((_ particles))

(for/lists (xi vi)

((d (in-range dimensions))

(h (unbox-into-cycle hi))

(l (unbox-into-cycle lo)))

(define h-l (- h l))

(values (+ l (* (random) h-l)) (+ (- h-l) (* 2 (random) h-l))))))

(define (particle-step x_i v_i p_i g)

(for/lists (x_i+ v_i+)

((x_id (in-list x_i))

(v_id (in-list v_i))

(p_id (in-list p_i))

(g_d (in-list g)))

(define v_id+ (+ (* ω v_id)

(* φ_p (random) (- p_id x_id))

(* φ_g (random) (- g_d x_id))))

(values (+ x_id v_id+) v_id+)))

(define (call-f args) (apply f args))

(define g0 (argmax call-f x))

(define-values (_X _V _P _P. G G.)

(for/fold ; because of g and g., we can't use for/lists

((X x) (V v) (P x) (P. (map call-f x)) (g g0) (g. (apply f g0)))

((_ iterations))

(for/fold

((x+ null) (v+ null) (p+ null) (p.+ null) (g+ g) (g.+ g.))

((x_i (in-list X))

(v_i (in-list V))

(p_i (in-list P))

(p._i (in-list P.)))

(define-values (x_i+ v_i+) (particle-step x_i v_i p_i g+))

(let* ((x._i+ (apply f x_i+))

(new-p_i? (>? x._i+ p._i))

(new-g? (>? x._i+ g.+)))

(values (cons x_i+ x+)

(cons v_i+ v+)

(cons (if new-p_i? x_i+ p_i) p+)

(cons (if new-p_i? x._i+ p._i) p.+)

(if new-g? x_i+ g+)

(if new-g? x._i+ g.+))))))

(values G G.))

(define (McCormick x1 x2)

(+ (sin (+ x1 x2)) (sqr (- x1 x2)) (* -1.5 x1) (* 2.5 x2) 1))

(define (Michalewitz d #:m (m 10))

(define 2m (* 2 m))

(define /pi (/ pi))

(define (f . xx)

(let Σ ((s 0) (i 1) (xx xx))

(if (null? xx)

(- s)

(let ((x (car xx)))

(Σ (+ s (* (sin x) (expt (sin (* i (sqr x) /pi)) 2m))) (+ i 1) (cdr xx))))))

(procedure-reduce-arity f d))

(displayln "McCormick [-1.993] @ (-0.54719, -1.54719)")

(PSO McCormick 1000 100 #(-1.5 -3) #(4 4) #:ω 0 #:φ_p 0.6 #:φ_g 0.3 #:> <)

(displayln "Michalewitz 2d [-1.8013] @ (2.20, 1.57)")

(PSO (Michalewitz 2) 1000 30 (box 0) (box pi) #:ω 0.3 #:φ_p 0.3 #:φ_g 0.3 #:> <)

(displayln "Michalewitz 5d [-4.687658]")

(PSO (Michalewitz 5) 1000 30 (box 0) (box pi) #:ω 0.3 #:φ_p 0.3 #:φ_g 0.3 #:> <)

(displayln "Michalewitz 10d [-9.66015]")

(PSO (Michalewitz 10) 1000 30 (box 0) (box pi) #:ω 0.3 #:φ_p 0.3 #:φ_g 0.3 #:> <)</lang>

{{out}}

Here is a sample run, the particles roll downhill quite nicely for McCormick,

but there's a lot of space to search with the 10-dimensional Michalewitz; so

YMMV with that one!

<pre>McCormick [-1.993] @ (-0.54719, -1.54719)

'(-0.5471975539492846 -1.547197548223612)

-1.9132229549810367

Michalewitz 2d [-1.8013] @ (2.20, 1.57)

'(2.20290527060906 1.5707963523178217)

-1.8013034100975123

Michalewitz 5d [-4.687658]

'(2.188617053067511

1.571283730996248

1.2884975345181757

1.9194689579781514

1.7202092563763838)

-4.680722049442259

Michalewitz 10d [-9.66015]

'(1.359756739301337

2.7216986742916007

1.2823734619604734

1.097509491839529

2.2225042675789752

0.9162856379217913

1.8753760783453128

0.7909979596555162

0.46574677476493

1.8558804696523914)

-6.432092623300999</pre>