I came up with this method about a decade ago, but I didn’t have enough command over the english language to explain what I meant. Any attempts came across as frantic rambling about two unrelated algorithms.
Thankfully now that AI has come further I can get help with explaining myself so while I’ve left in the original post I have included a ChatGPT description since it’s more clear and concise than my own.
I will also include a pastebin copy of the conversation I had with ChatGPT as it might contain extra information if anyone is having trouble understanding this. I’m very proud of it, but I can’t concisely describe it.
This version is in racket. In future I’ll probably rewrite a neater version with only the essential parts, when I do I’ll keep it all within the R5RS specification.
My Original Post
The Genetic Algorithm is in control of coming up with the syntax tree of each candidate, however any number will be replaced with a scalar variable to be determined by the Cartesian position of a corresponding particle. The particle swarm with a particle that crossed the highest/lowest point will be deemed the most fit.
This leads the genetic algorithm that evolves candidate fitness landscapes where there’s a clearly defined gradient from many points towards a competitive local extrema.
Before continuing it”s important to understand the Particle Swarm Optimiser, I’ve written up a post on it in the past, in MIT-scheme, which is strikingly similar to Racket, I’ve also uploaded a slightly more accessible python version, and should be able to dig up a few examples of applications in future, I definitely have some files laying around somewhere.
Sadly my code is filthy, this was just a proof of concept for myself and I didn’t intend to share it, I don’t have time to clean it now but I’m going to attempt to write it up in a more formal structure.
Really I should be saving this as a draft and publishing once it’s clean but I’m just happy I was able to find it, this project means a lot to me, it was a lot to get my head around.
I’ll comment and organise some stuff a bit later.
ChatGPT Summary:
I combine the power of genetic algorithms and particle swarm optimization (PSO) to evolve abstract syntax trees (ASTs) in a homoiconic language like Scheme. The genetic algorithm creates and evolves ASTs, populating them with various operations and numerical values, which serve as potential solutions to the problem at hand.
Once the genetic algorithm generates a population of ASTs, I use particle swarm optimization (PSO) to fine-tune the numerical values within these trees.
By adjusting the mutable values, PSO optimizes the ASTs’ performance according to a predefined fitness function. The fitness function measures how close the evaluated ASTs come to the desired goal or, conversely, how far they are from the “anti-goal” if poor performance is easier to define.
The fitness function guides the optimization process by evaluating how well each AST performs against the desired outcome. PSO continuously adjusts the numerical values in the ASTs to maximize fitness and improve the quality of the candidate solutions generated by the genetic algorithm.
By combining genetic algorithms and PSO in this manner, I achieve a powerful and versatile optimization process that leverages the strengths of both techniques. This approach is particularly effective for solving complex problems that require simultaneous structural and numerical optimization.
Pastebin
Here’s my dialog with ChatGPT where I said more or less what’s written above, but less coherently.
https://pastebin.com/MDxLeFXn
Glossary:
As I said, I have a bit of trouble explaining the code as a whole, so I’ll try to explain what every function does here:
(char->symbol c)
Takes a Character C and converts it into string, then onverts the string into a symbol. This is because in Racket's type system a character won't be implicitly cast into a string where required.
(nvector . vars)
It's basically just the list function, but with a different name to remind people that those numbers are a vector
(interval low high)
Interval is just implemented with the cons function, the (car) left value is the lower limit of the interval, and the right value (cdr) is the higher limit of the interval.
(inrange range)
Takes an interval as an input and returns a floating point number between those two limits.
(particle pos velocity)
A particle is also implemented as a cos function with position of the left and velocity on the right.
(newparticle ranges)
The new particle function takes one range for each axis (as the particle can exist in as many dimensions as needed) A particle will be returned with a random position somewhere in the hypervolume defined by the ranges.
A random velocity will also be given to the particle, at most a tenth of the size of the range.
Maximise is just declared as true, it's only named to make it more legible
Minimise is just declared as false, it's only named to make it more legible
(newcandidate ranges)
Produces a particle swarm candidate from a list of ranges the same as a particle. In In fact the candidate is simply a particle which also keeps track of its best value so far. When initalised the best value is set to false to signifiy that it hasn't tested any positions yet.
(candidate pos velocity best)
The candidate function as explained above.
(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)
))
(provide 1stgenio)
(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)))
(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 (exportsexpression filename exp) (begin
(delete-file filename)
(with-output-to-file filename
(lambda () (write exp)))
)
)
(define (importsexpression filename) (with-input-from-file filename
(lambda ()(string-append "'" (read-string 2048)))))
(define (evalstring s namespace) (with-input-from-string s
(lambda () (eval (read) namespace))))
(exportsexpression "test.txt" '(+ a c0))
(evalstring (importsexpression "test.txt") ns)
(define 1stg (1stgenio ts))
(iterategeneration ts 1stg minimise 10)Code:
And here’s the uncommented code for easy importing into racket. Just read the glossary if you need to know what anything does. I will work on some demos soon, I just don’t have Racket installed at the moment.
#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)
))
(provide 1stgenio)
(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)))
(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 (exportsexpression filename exp) (begin
(delete-file filename)
(with-output-to-file filename
(lambda () (write exp)))
)
)
(define (importsexpression filename) (with-input-from-file filename
(lambda ()(string-append "'" (read-string 2048)))))
(define (evalstring s namespace) (with-input-from-string s
(lambda () (eval (read) namespace))))
(exportsexpression "test.txt" '(+ a c0))
(evalstring (importsexpression "test.txt") ns)
(define 1stg (1stgenio ts))
(iterategeneration ts 1stg minimise 10)
0