#lang racket
(define-namespace-anchor anc)

(define ns (namespace-anchor->namespace anc))

(define (char->symbol c) (string->symbol (string c)))

(define (nvector . vars) (apply list vars))

(define (interval low high) (cons low high))

(define (inrange range) (+ (car range) (random (- (cdr range) (car range)))))

(define (particle pos velocity) (cons pos velocity))

(define (newparticle ranges) (particle (map (lambda (range) (inrange range)) ranges) (map (lambda (range) (* .1 (inrange range))) ranges)))

(define (newcandidate ranges) (candidate (map (lambda (range) (inrange range)) ranges) (map (lambda (range) (* .1 (inrange range))) ranges) #f))

(define maximise #t) (define minimise #f)

(define (candidate pos velocity best) (cons (particle pos velocity) best))

(define (index l n) (if (zero? n) (car l) (index (cdr l) (- n 1))))

(define (newpopulation populationsize ranges) (map (lambda (x) (newcandidate ranges)) (range populationsize)))

(define (iteratecandidate c globalextreme) (let ((localextreme (cdr candidate))) (candidate globalextreme)))

(define (applyparticle p f) (apply f (car p)))

(define (ratecandidate c f) (applyparticle (car c) f))

(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) )))

(define (stepcandidatepos p v) (if (null? p) '() (cons (+ (car v) (car p)) (stepcandidatepos (cdr p) (cdr v)))))

(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)))))

(define (stepcandidate c ge) (candidate (stepcandidatepos (caar c) (cdar c)) (stepcandidatevelocity (caar c) (cdar c) (cdr ge) (cddr c)) (cdr c)))

(define (movepop pop globalextreme) (map (lambda (a) (stepcandidate a globalextreme)) pop))

(define (iteratepopulation candidates f globalextreme direction n)
  (if (= 0 n) candidates
(let ((fitnesses (map (lambda (x) ((lambda (y) (candidate (caar x) (cdar x) (cons y (caar x)))) (ratecandidate x f))) candidates)))
(let ((GE (best fitnesses globalextreme direction)))
  (iteratepopulation (movepop fitnesses globalextreme) f GE direction (- n 1))))))

(define (varnames n) (map (lambda (x) (char->symbol (integer->char (+ 97 x)))) (range n)))

(define (controlnames n) (map (lambda (x) (string->symbol (string-append "c" (format "~v" x)))) (range n)))

(define mypop
(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) )

(define-syntax-rule (funcify inps val)
   `(lambda ,inps ,val))

(define-syntax-rule (difference a b) `(abs (- ,a ,b)))

(define-syntax-rule (a=b a b varcount) (funcify (varnames varcount) (difference a b)))

(define-syntax-rule (quickPSO f vars direction)
  (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))

(define (listdifference a b) (if (null? a) 0 (+ (abs (- (car a) (car b))) (listdifference (cdr a) (cdr b)))))

(define (IOmatch trainingset f)
(let ((inputvars (if (list? (caar trainingset)) (length (caar trainingset)) 1))
      (outputvars (if (list? (cdar trainingset)) (length (cdar trainingset)) 1)))
 (quickPSO  (funcify (varnames 8) `(listdifference (map (lambda ,(controlnames inputvars) f) ',(map car trainingset)) ',(map cdr trainingset))) 8 minimise)
  ))

(define (randleaf psovars controls)
    (if (zero? (random 3))

                                        (string->symbol (string-append "c" (format "~v" (random controls))))
                                        (char->symbol (integer->char (+ 97 (random psovars))))))
(define (randunary) (index '(sin exp cos) (random 3)))

(define (randbinary) (index '(+ - *) (random 3)))

(define (randfunc depth psovars controls) (if (zero? depth)
                                               (randleaf psovars controls)
                                               (if (zero? (random 4))
                                                   (randleaf psovars controls)
                                                   (if (zero? (random 2))
                                                       `(,(randunary) ,(randfunc (- depth 1) psovars controls))
                                                       `(,(randbinary) ,(randfunc (- depth 1) psovars controls) ,(randfunc (- depth 1) psovars controls))))))
(define (functionpool size depth args) (if (zero? size) '() (cons (randfunc depth 8 args) (functionpool (- size 1) depth args))))

(define (iofunc trainingset f)
  (let ((input (map car trainingset))
        (output (map cdr trainingset)))

    (cons (funcify (varnames 8) `(listdifference  ',output (map (lambda (c0) ,f)  ',input))) f)))

(define (1stgenio trainingset)
  (let ((start (functionpool 10 4 1)))
(map (lambda (x) (let ((iof (iofunc trainingset x))) (list iof (quickPSO (car iof) 8 minimise)))) start)
 ))

(define ts '((0 . 1)
    (1 . 2)
    (2 . 4)
    (3 . 8)
    (4 . 16)
    (5 . 32)
    (6 . 64)))

(define 1stg (1stgenio ts))

(define (formatted x) (caar x))

(define (score x) (caadr x))

(define (bestcandidate x) (cdadr x))

(define (unformatted x) (cdar x))

(define (sortbyfitness genepop direction)
  (sort genepop (if direction <= >=) #:key score))

(define (biasselect l) (index l (* (expt (/ (random 1000) 1000) 2) (length l))))

(define (iterategeneration population direction)
  (let ((sortedpop (sortbyfitness population direction)))
    (map  (range (length population)))
    ))