View difference between Paste ID: CtQM3pKH and v62TJKmc
SHOW: | | - or go back to the newest paste.
1
#lang racket
2
(define-namespace-anchor anc)
3
(define ns (namespace-anchor->namespace anc))
4
(define (char->symbol c) (string->symbol (string c)))
5
(define (nvector . vars) (apply list vars))
6
(define (interval low high) (cons low high))
7
(define (inrange range) (+ (car range) (random (- (cdr range) (car range)))))
8
(define (particle pos velocity) (cons pos velocity))
9
(define (newparticle ranges) (particle (map (lambda (range) (inrange range)) ranges) (map (lambda (range) (* .1 (inrange range))) ranges)))
10
(define (newcandidate ranges) (candidate (map (lambda (range) (inrange range)) ranges) (map (lambda (range) (* .1 (inrange range))) ranges) #f))
11
(define maximise #t) (define minimise #f)
12
(define (candidate pos velocity best) (cons (particle pos velocity) best))
13
14
15
(define (newpopulation populationsize ranges) (map (lambda (x) (newcandidate ranges)) (range populationsize)))
16
17
(define (iteratecandidate c globalextreme) (let ((localextreme (cdr candidate))) (candidate globalextreme)))
18
(define (applyparticle p f) (apply f (car p)))
19
20
(define (ratecandidate c f) (applyparticle (car c) f))
21
22
(define (best pop currentextreme direction) (if (null? pop) currentextreme (if (< (cadr (car pop)) (car currentextreme)) (best (cdr pop) (cdar pop) direction) (best (cdr pop) currentextreme direction) )))
23
(define (stepcandidatepos p v) (if (null? p) '() (cons (+ (car v) (car p)) (stepcandidatepos (cdr p) (cdr v)))))
24
25
(define (stepcandidatevelocity p v ge le) (if (null? v) '() (cons (+ (* (car v) .9) (* .01 (- (car ge) (car p))) (* .01 (- (car le) (car p)))) (stepcandidatevelocity (cdr p) (cdr v) (cdr ge) (cdr le)))))
26
27
(define (stepcandidate c ge) (candidate (stepcandidatepos (caar c) (cdar c)) (stepcandidatevelocity (caar c) (cdar c) (cdr ge) (cddr c)) (cdr c)))
28
  
29
(define (movepop pop globalextreme) (map (lambda (a) (stepcandidate a globalextreme)) pop))
30
31
(define (iteratepopulation candidates f globalextreme direction n)
32
  (if (= 0 n) candidates
33
(let ((fitnesses (map (lambda (x) ((lambda (y) (candidate (caar x) (cdar x) (cons y (caar x)))) (ratecandidate x f))) candidates)))
34
(let ((GE (best fitnesses globalextreme direction)))
35
  (iteratepopulation (movepop fitnesses globalextreme) f GE direction (- n 1))))))
36
37
(define (varnames n) (map (lambda (x) (char->symbol (integer->char (+ 97 x)))) (range n)))
38
39
(define (controlnames n) (map (lambda (x) (string->symbol (string-append "c" (format "~v" x)))) (range n)))
40
41
(define mypop 
42
(iteratepopulation (newpopulation 30 (list (interval -100 100) (interval -100 100) (interval -100 100))) (lambda (a b c) (abs (- 420 (+ a (* a (- b c)) c (* c a))))) '(99999 0 0 0) minimise 300) )
43
44
(define-syntax-rule (funcify inps val)
45
   `(lambda ,inps ,val))
46
47
(define-syntax-rule (difference a b) `(abs (- ,a ,b)))
48
49
(define-syntax-rule (a=b a b varcount) (funcify (varnames varcount) (difference a b)))
50
51
(define-syntax-rule (quickPSO f vars direction)
52
  (best (iteratepopulation (newpopulation 30 (map (lambda (x) (interval -100 100)) (range vars))) (eval f ns) '(99999 0 0 0 0 0 0 0 0) direction 300) '(99999 0 0 0 0 0 0 0 0) minimise))
53
54
(define (listdifference a b) (if (null? a) 0 (+ (expt (abs (- (car a) (car b))) .5) (listdifference (cdr a) (cdr b)))))
55
56
(define-syntax-rule (IOmatch trainingset f)
57
(let ((inputvars (if (list? (caar trainingset)) (length (caar trainingset)) 1))
58
      (outputvars (if (list? (cdar trainingset)) (length (cdar trainingset)) 1)))
59
 (quickPSO  (funcify (varnames 8) `(listdifference (map (lambda ,(controlnames inputvars) f) ',(map car trainingset)) ',(map cdr trainingset))) 8 minimise)
60
  ))
61
62-
"
62+
(IOmatch
63-
(quickPSO  (a=b '(+ a b) '(+ (* .5 a b) a (* 3 b)) 2) 2 minimise)
63+
  '((0 . 0)
64
    (1 . 1)
65-
"
65+
    (2 . 1)
66
    (3 . 2)
67
    (4 . 3)
68
    (5 . 5)
69
    (6 . 8))
70
 (+ a c0)) 8 minimise)