The Evolution Of Flibs
July 13, 2012
We’ll follow Dewdney’s decomposition of the program into four auxiliary functions plus a main function. Various parameters control the processing:
sub Set_Parameters{
$score_run = 100;
$target_sequence = "010011";
$periods = length($target_sequence);
$numsyms = 0;
@symbols = split(//g, $target_sequence);
for($i = 0; $i < @symbols; $i++){
if($symbols[$i] > $numsyms){
$numsyms = $symbols[$i];
}
}
$numsyms++;
@e = split(//g, $target_sequence);
$states = 4;
$noflibs = 10;
$BreedingRate = 30;
}
We have four arrays as global variables: Flib is a two-dimensional array which stores each flib’s chromosomes. Score and State store the current score and state of each flib. e holds the 6 symbol sequence entered by the user. The gene pool is generated at random:
sub Generate_Population{
for($i = 0; $i<$noflibs; $i++){
for($x = 1; $x <= (($numsyms * 2) * $states)/2; $x++){
push(@{flib.$i}, int(rand($numsyms)));
push(@{flib.$i}, int(rand($states)));
}
}
}
The first function scores the set of flibs on a sequence of one hundred symbols, generated by repeating the same 6 symbols entered by the user. It works by utilising a nested loop. The outer loop generates 100 symbols, and the inner loop increases the score of each flib if it correctly predicts the next symbol. There is a useful formula which you can use to find the output of a flib, and it’s next state: locus = (4 * Current State) = (2 * Current Symbol). The value of the locus is used to index the array holding the flib’s chromosomes; this gives us the flibs output. The value of the locus + 1 gives us the flib’s next state:
sub Score_Flibs{
for($i = 0; $i < $noflibs; $i++){
$Score[$i] = 0;
$State[$i] = 0;
}
for($Outer = 0; $Outer < $score_run; $Outer++){
$CurrentSymbol = $e[$Outer % $periods];
if(($Outer % $periods) < ($periods - 1)){
$NextSymbol = $e[($Outer % $periods) + 1];
}
else
{
$NextSymbol = $e[0];
}
for($Inner = 0; $Inner < $noflibs; $Inner++){
$locus = (($numsyms * 2) * $State[$Inner]) + (2 * $CurrentSymbol);
if(${flib.$Inner}[$locus] == $NextSymbol){
$Score[$Inner]++;
}
$State[$Inner] = ${flib.$Inner}[$locus+1];
}
}
}
The second function identifies the highest- and lowest-scoring flibs. We start by setting two variables, Top and Bottom. Top is initialized to 0, and Bottom to 100. We loop through the score array, if a score is greater than Top or less than Bottom, Top/Bottom changes its value to that score, and saves the index value. After this, if a new high score has been found, the score along with the chromosome is output.
sub Identify_Flibs{
$Top = 0;
$Bottom = 100;
for($i = 0; $i < $noflibs; $i++){
if($Top < $Score[$i]){
$Top = $Score[$i];
$TopIndex = $i;
}
if($Bottom > $Score[$i]){
$Bottom = $Score[$i];
$BottomIndex = $i;
}
}
if ($Top > $PreviousScore){
print "$loop_counter $Top ";
for($i = 0; $i < @{flib.$TopIndex}; $i+=2){
print ${flib.$TopIndex}[$i];
print chr(${flib.$TopIndex}[$i+1]+65);
}
print "\n";
$PreviousScore = $Top;
}
}
The third function calls a random number generator to decide whether or not to breed (the breeding threshold), and if it decides to breed, calls the random number generator twice more to find the crossover points. We then use three loops, to swap the chromosomes between the crossover points, and replace the lowest scoring flib with the offspring.
sub Breed{
if(int(rand(101)) <= $BreedingRate){
$RandomFlib = int(rand($noflibs));
while($RandomFlib == $TopIndex){
$RandomFlib = int(rand($noflibs));
}
$c1 = int(rand((($numsyms * 2) * $states)));
$c2 = int(rand((($numsyms * 2) * $states)));
while($c1 == $c2){
$c2 = int(rand((($numsyms * 2) * $states)));
}
if($c1 > $c2){
$c2 += $c1;
$c1 = $c2 - $c1;
$c2 -= $c1;
}
for($i = 0; $i < $c1; $i++){
${flib.$BottomIndex}[$i] = ${flib.$RandomFlib}[$i];
}
for($i = $c1; $i <= $c2; $i++){
${flib.$BottomIndex}[$i] = ${flib.$TopIndex}[$i];
}
for($i = ($c2 + 1); $i < (($numsyms * 2) * $states); $i++){
${flib.$BottomIndex}[$i] = ${flib.$RandomFlib}[$i];
}
}
}
The fourth function calls a random number generator twice to choose a flib and gene position, then calls the random number generator once more to decide the new value of the chosen gene. We have to be careful what we change the values to, the states can only be the values 0 through 3, if we changed one of these to a 5, the flib would no longer function correctly.
sub Mutate{
$RandomFlib = int(rand($noflibs));
$RandomLocus = int(rand((($numsyms * 2) * $states)));
if($RandomLocus % 2 == 0){
${flib.$RandomFlib}[$RandomLocus] = int(rand($numsyms));
}
else
{
${flib.$RandomFlib}[$RandomLocus] = int(rand($states));
}
}
The main program runs the simulation until a solution is found.
#!/usr/bin/perl
main();
sub main{
Set_Parameters();
Generate_Population();
$loop_counter = 0;
while($Top < 100){
$loop_counter++;
Score_Flibs();
Identify_Flibs();
Breed();
Mutate();
}
}
Here is a sample run, showing the successive highest-scoring flibs that predict the 010011 input sequence:
> perl flibs.pl
1 65 0D1B1D1D1B0C1C1D
6 66 1D1B1D1D1B0C1C1D
10 81 1D1B1D1D0B0C1C1D
47 84 1C1B0C0B0D0C1A0C
102 98 0D1B1C0B1D0A1A0C
123 100 1D1C1A1A0D0A1A0C
Note that this is different than the sample flib, as there is more than one perfect predictor for this target sequence. There is much you can do to play with the program. Try changing the breeding threshhold, or providing a smaller or larger gene pool, and see what happens. Do more states make it easier to converge to a perfect predictor, or harder? How many different perfect predictors can recognize a particular target sequence?
You can run the program at http://codepad.org/hvU22PCL.
Pages: 1 2
http://pastebin.com/9Ez1xmU4
i have all the necessary functions to create a flib simulation, except the run function itself. note that crossover, perhaps the most important function short of the score, is currently poor.
[…] today’s Programming Praxis exercise, our goal is to implement a genetic algorithm to evolve finite state […]
My Haskell solution (see http://bonsaicode.wordpress.com/2012/07/13/programming-praxis-the-evolution-of-flibs/ for a version with comments):
import Control.Monad import Data.List import System.Random data Args = Args { _symbols :: String, _numSymbols :: Int , _states :: String, _numStates :: Int } runFlib :: Args -> (Char, String) -> Char -> ((Char, String), Char) runFlib (Args smbs nsmbs sts _) (s, m) input = ((s',m), out) where (out:s':_) = drop (2 * (nsmbs * index s sts + index input smbs)) m index x = head . elemIndices x score :: Int -> Args -> String -> String -> Int score run args flib input = length . filter id . zipWith (==) (tail input') . snd . mapAccumL (runFlib args) (head $ _states args,flib) $ init input' where input' = take (run + 1) $ cycle input oneOf :: [a] -> IO a oneOf xs = fmap (xs !!) $ randomRIO (0, length xs - 1) replace :: Int -> a -> [a] -> [a] replace i v xs = take i xs ++ v : drop (i + 1) xs randomFlib :: Args -> IO String randomFlib (Args smbs nsmbs sts nsts) = fmap concat $ replicateM (nsmbs * nsts) (sequence [oneOf smbs, oneOf sts]) crossover :: Args -> String -> String -> IO String crossover (Args _ nsmbs _ nsts) a b = do start <- randomRIO (0, 2 * nsmbs * nsts - 2) end <- randomRIO (start + 1, 2 * nsmbs * nsts - 1) return $ take start a ++ take (end - start) (drop start b) ++ drop end a mutate :: Args -> String -> IO String mutate (Args smbs nsmbs sts nsts) flib = do i <- randomRIO (0, 2 * nsmbs * nsts - 1) c <- oneOf $ if mod i 2 == 0 then smbs else sts return $ replace i c flib evolve :: String -> Int -> Float -> Int -> String -> IO () evolve states popSize breedChance run input = nextGen (0, "") =<< replicateM popSize (randomFlib args) where args = Args (map head symbols) (length symbols) states (length . group $ sort states) where symbols = group $ sort input nextGen (top,_) _ | top == run = return () nextGen best pop = do let scored = sort $ map (\flib -> (score run args flib input, flib)) pop let top = last scored when (fst top > fst best) (print top) breed <- fmap (< breedChance) $ randomRIO (0, 1) mix <- crossover args (snd $ head scored) (snd top) let newPop = (if breed then replace 0 mix else id) (map snd scored) mutIndex <- randomRIO (0, popSize - 1) mutant <- mutate args (newPop !! mutIndex) nextGen (max best top) $ replace mutIndex mutant newPop main :: IO () main = evolve "ABCD" 10 0.3 100 "010011"My Clojure solution where you provide states and input symbols
(defn rand-flib "Generate a random flib based on states and symbols" [states symbols] (apply str (flatten (for [_ states _ symbols] [(rand-nth symbols) (rand-nth states)])))) (defn rand-flib-coll "Generate a random vector population of n flibs" [n states symbols] (vec (for [_ (range n)] (rand-flib states symbols)))) (defn rand-mutate "Mutate a flib's random allele" [flib states symbols] (let [locus (rand-int (count flib)) ref-coll (if (zero? (rem locus 2)) symbols states)] (str (subs flib 0 locus) (rand-nth ref-coll) (subs flib (inc locus))))) (defn rand-breed "Crossover two flibs on a random portion of their adn" [flib flib-hi] (let [n (inc (count flib)) [i1 i2] (sort [(rand-int n) (rand-int n)])] (str (subs flib 0 i1) (subs flib-hi i1 i2) (subs flib i2)))) (defn index-of "Return index of value in collection" [v coll] (first (keep-indexed #(when (= %2 v) %1) coll))) (defn predict "Apply Flib to input to predict output" [flib inputs states symbols] (let [align-st (* 2 (count symbols))] (loop [inputs inputs state (first states) outputs []] (if (nil? inputs) outputs (let [idx-als (* align-st (index-of state states)) align-sy (* 2 (index-of (first inputs) symbols)) o (nth flib (+ idx-als align-sy)) s (nth flib (+ idx-als align-sy 1))] (recur (next inputs) s (conj outputs o))))))) (defn calc-score "Calculate score of flib's output compared to input" [inputs outputs] (int (* 100 (/ (count (filter true? (map = (next inputs) (butlast outputs)))) (dec (count inputs)))))) (defn evolve "Generate Flibs and loop to evaluate flibs predictions and mutate population" [states symbols nflibs bratio nloop inputs] (loop [i 1 flibs (rand-flib-coll nflibs states symbols) score 0] (if (or (> i nloop) (= score 100)) nil (let [fouts (map #(predict % inputs states symbols) flibs) fscr-map (zipmap flibs (map #(calc-score inputs %1) fouts)) fscr-sorted (sort-by second fscr-map) flib-scr-low (first fscr-sorted) flib-scr-hi (last fscr-sorted) idx-low (index-of (first flib-scr-low) flibs) flibs1 (if (>= (rand-int 100) bratio) flibs (assoc flibs idx-low (rand-breed (first flib-scr-hi) (first flib-scr-low)))) idx-rnd (rand-int nflibs) flibs2 (assoc flibs1 idx-rnd (rand-mutate (flibs idx-rnd) states symbols))] (println i flib-scr-hi) (recur (inc i) flibs2 (second flib-scr-hi)))))) (evolve "ABCD" "01" 10 30 100 "010011")[…] Pages: 1 2 […]
A bit behind the times, but here’s my solution in Racket: Flibs
I’ve always loved messing with genetic algorithms and have tried to work out a good general purpose solution to this very problem (evolving FSAs) before. Unfortunately it always comes down to adding new structure and actually making the connections to it. Most of the time, the new structure just doesn’t get used and thus gets optimized away instead. We’ll see if I can’t make another crack at it this weekend.
The version I’ve posted doesn’t exactly match the problem as it uses a different strategy for who and how many new flibs to breed, but it’s pretty close and it does solve the problem:
[…] just appeals to me for some reason. So when I came across a puzzle on on Programming Praxis called The Evolution of Flibs, I just knew that I had to give it a […]