#lang racket

(define pi 3.141592)

(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 (* 10000 (- (cdr range) (car range)))) 10000)))

(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-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 75 (map (lambda (x) (interval -100 100)) (range vars))) (eval f ns) '(99999 0 0 0 0 0 0 0 0) direction 90) '(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 (ainb? a b) (foldr (lambda (x y) (or (equal? x a) y)) false b))

(define (unary? value) (ainb? value '(sin exp cos)))

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


(define (binary? value) (ainb? value '(+ - *)))
(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 (formatfunctions trainingset population direction)
  (map (lambda (x) (let ((iof (iofunc trainingset x))) (list iof (quickPSO (car iof) 8 direction)))) population))

(define (1stgenio trainingset)
  (let ((start (functionpool 500 20 1)))
(formatfunctions trainingset start minimise)
 ))

(define ts `(
    (1 . 3)
    (2 . 5)
    (3 . 7)
    (4 . 11)
    (5 . 13)
    (6 . 17)
    (7 . 19)
    (8 . 23)
    (9 . 27)
    (10 . 31)
    (11 . 37)))

(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 (AorB a b) (if (zero? (random 2)) a b))

(define (left l n) (if (<= n 0)
                       '()
                       (cons
                        (car l)
                        (left (cdr l) (- n 1)))))

(define (right l n) (if (null? l) '() (if (<= 0 n) (cdr l) (right (cdr l) (- n 1)))))

(define (mapAB+remainder f a b)
  (if (= (length a) (length b)) (map f a b)
  (let ((m (min (length a) (length b))) (abigger (> (length a) (length b))))
    (append (map f (left a m) (left b m)) (if abigger (right a (- (length a) m)) (right b (- (length b) m)))))))

(define (biasselect l) (index l (floor (* (expt (/ (random 1000) 1000) 3) (- (length l) 1)))))

(define (combine a b) (combineinner (unformatted a) (unformatted b)))

(define (combineinner a b)
  (if (or (not (list? a)) (not (list? b)))
      (AorB a b)
      (if (zero? (random 2))
          (if (binary? a)
              (cons (car a) (mapAB+remainder AorB (cdr a) (cdr b)))
              (list (car a) (AorB (cadr a) (cadr b))))
          (if (binary? b)
              (cons (car b) (mapAB+remainder AorB (cdr a) (cdr b)))
              (list (car b) (AorB (cadr a) (cadr b)))))))

(define (iterategeneration trainingset population direction iterations)
  (if (zero? iterations) population
  (let ((sortedpop (sortbyfitness population direction))
        (lp (length population)))
    (begin
      (write (displaybest sortedpop))
      (write "\n\n")
     (iterategeneration trainingset (formatfunctions trainingset (cons (unformatted (car sortedpop)) (map (lambda (x) (combine (biasselect sortedpop) (biasselect sortedpop))) (range (- (length population) 1)))) minimise) minimise (- iterations 1)))
    )))

(define (displaybest pop)
  (car (sortbyfitness pop minimise)))

(iterategeneration ts 1stg minimise 100)

"(define (exportpopulation population foldername)

  )"