Here is an implementation of a neuroevolution algorithm. Neuroevolution is using genetic algorithms to evolve neural networks. This implementation also uses enforced subpopulations to evolve the networks at the neuron level. I also have a simpler GA implementation if you need the GA without the stuff I had to add to get it to work with the neural networks.
I'm interested in getting the code reviewed, because I think I've relied too much on the imperative features of f#. So I want to get some feedback on portions of the code that you think could be rewritten on a functional manner.
You'll also notice that I maintain the populations in an array and do replacement in place. One of the reasons for me doing this was because I was concerned for efficiency, having to copy the population many times. So what's the way to go in this scenario, array or lists?
The neural network:
#light
open System
open System.IO
open System.Collections.Generic
//---------------------------
// global random number gen
let random = new System.Random()
let randInt x y = random.Next(x, y+1)
let randBit() = random.Next(2)
let randF() = random.NextDouble()
let randWeight(wMin, wMax) = (random.NextDouble() * (wMax + abs_float(wMin))) + wMin
let setLast (var: array<'a>) b = var.[var.Length-1] <- b
type NeuralNetwork = class
val mutable inputNodes: int
val mutable hiddenNodes: int
val mutable outputNodes: int
val mutable network: float array array
val mutable wi: float array array;
val mutable wo: float array array;
val inputLayer: int
val hiddenLayer: int
val outputLayer: int
val bias: float
val mutable bestScore: float
val mutable bestWi: float array array
val mutable bestWo: float array array
val mutable sigmoid: float -> float
val wMax: float
val wMin: float
//-----------------------------------------//
new (_inputNodes, _hiddenNodes, _outputNodes) as this =
{
inputNodes = _inputNodes; hiddenNodes = _hiddenNodes; outputNodes = _outputNodes;
network = [| |]; wi = [| |]; wo = [| |];
inputLayer = 0; hiddenLayer = 1; outputLayer = 2;
bias = -1.;
bestScore = 10000.;
bestWi = [| |]; bestWo = [| |];
sigmoid = tanh;
wMax = 1.; wMin = -1.;
}
then
this.init()
//-----------------------------------------//
new (_inputNodes, _hiddenNodes, _outputNodes, _args: Dictionary<string,string>) as this =
{
// +1 done in GA init
inputNodes = _inputNodes; hiddenNodes = _hiddenNodes; outputNodes = _outputNodes;
network = [| |]; wi = [| |]; wo = [| |];
inputLayer = 0; hiddenLayer = 1; outputLayer = 2;
bias = float_of_string(_args.Item "bias");
bestScore = 100.;
bestWi = [| |]; bestWo = [| |];
sigmoid =
if _args.Item "sigmoid" = "log" then
fun var ->
if var > 45. then
1.
elif var < -45. then
0.
else
1./(1. + exp (-var))
else
tanh
wMax = float_of_string(_args.Item "wMax"); wMin = float_of_string(_args.Item "wMin");
}
then
this.init()
//-----------------------------------------//
/// Do all declarations we couldn't do on the constructor
member this.init() =
this.network <- Array.init 3 (fun i ->
match i with
| 0 -> Array.create this.inputNodes 0.
| 1 -> Array.create this.hiddenNodes 0.
| 2 -> Array.create this.outputNodes 0.
| _ -> Array.create this.outputNodes 0. )
this.wi <- Array.init this.inputNodes (fun x ->
Array.init this.hiddenNodes (fun x -> randWeight(this.wMin, this.wMax)))
this.wo <- Array.init this.hiddenNodes (fun x ->
Array.init this.outputNodes (fun x -> randWeight(this.wMin, this.wMax)))
this.bestWi <- Array.init this.inputNodes (fun x ->
Array.init this.hiddenNodes (fun x -> randWeight(this.wMin, this.wMax)))
this.bestWo <- Array.init this.hiddenNodes (fun x ->
Array.init this.outputNodes (fun x -> randWeight(this.wMin, this.wMax)))
//-----------------------------------------//
member this.setSigmoid(newSigmoid) =
this.sigmoid <- newSigmoid
//-----------------------------------------//
/// Feedforward propagation
/// args: array containing a single case
member this.feedforward (input: float array) =
// set input activations
Array.iteri (fun j x -> if j < (this.inputNodes-1) then this.network.[this.inputLayer].[j] <- input.[j]) this.network.[this.inputLayer]
setLast this.network.[this.inputLayer] this.bias
// from input to hidden
for j=0 to this.network.[this.hiddenLayer].Length-1 do
let sum = ref 0.
for i=0 to this.network.[this.inputLayer].Length-1 do
sum := !sum + this.network.[this.inputLayer].[i] * this.wi.[i].[j]
this.network.[this.hiddenLayer].[j] <- this.sigmoid !sum
setLast this.network.[this.hiddenLayer] this.bias
// from hidden to output
for j=0 to this.network.[this.outputLayer].Length-1 do
let sum = ref 0.
for i=0 to this.network.[this.hiddenLayer].Length-1 do
sum := !sum + this.network.[this.hiddenLayer].[i] * this.wo.[i].[j]
done
this.network.[this.outputLayer].[j] <- this.sigmoid !sum
//-----------------------------------------//
member this.Output = this.network.[this.outputLayer].[0] // quick fix for now
//-----------------------------------------//
/// Do a run of the neural network on a set of test cases
/// args: training_data_set bool_flag_print_test_run
member this.testNet trainData printFlag =
let net, wi, wo = this.network, this.wi, this.wo
let getLast (var: float array) = var.[var.Length-1]
let classify = ref 0
let error = ref 0.
trainData |> Array.iter (fun x ->
this.feedforward x
let output = this.Output
if printFlag then
printf "%f -> %f\n" (getLast x) output
if (getLast x) = 1. && output < 0.55 then
incr classify
elif (getLast x) = 0. && output > 0.45 then
incr classify
error := !error + (x.[x.Length-1]-output) * (x.[x.Length-1]-output) )
printf "Error: %f, Wrong class: %d\n" !error !classify
if !error < this.bestScore then
(
this.bestScore <- !error
// copy best wi
this.bestWi |> Array.iteri (fun i row ->
row |> Array.iteri (fun j _ -> row.[j] <- wi.[i].[j]) )
// copy best wo
this.bestWo |> Array.iteri (fun i row ->
row |> Array.iteri (fun j _ -> row.[j] <- wo.[i].[j]) )
printf "Better network found\n"
)
else
()
!error
end
The genetic algorithm:
#light
open System
open System.IO
open System.Collections.Generic
open Nn
//---------------------------
// global random number gen
let random = new System.Random()
let randInt x y = random.Next(x, y+1)
let randBit() = random.Next(2)
let randF() = random.NextDouble()
let randWeight(wMin, wMax) = (random.NextDouble() * (wMax + abs_float(wMin))) + wMin
//-----------------------------------//
let getTrainingData filename =
let allLines = File.ReadAllLines(filename)
let train = Array.init allLines.Length (fun i ->
allLines.[i].Split([| ' ' |], System.StringSplitOptions.RemoveEmptyEntries)
|> Array.map (fun x -> float_of_string(x)))
train
//-----------------------------------//
/// Shuffle training data
/// args: 2d array where each row contains a single training example with desired target at the very end
let randomShuffle data =
let swap arr a b =
let temp = arr.[a]
arr.[a] <- arr.[b]
arr.[b] <- temp
data |> Array.iteri (fun i _ -> swap data i (randInt 0 (data.Length-1)))
//-----------------------------------//
type individual = { mutable fitness:float; chromosome:float array }
let fitnessComparer =
{
new IComparer<individual>
with Compare(s1, s2) =
s1.fitness.CompareTo(s2.fitness)
}
let ints var = int_of_string(var)
let floats var = float_of_string(var)
//-----------------------------------//
type NEGeneticAlgorithm = class
val mutable xoRate: float
val mutable mutRate: float
val mutable numSubPops: int
val mutable subPopSize: int
val mutable chromLen: int
val mutable maxGens: int
val mutable tourSize: int
val mutable permutations: int
val train: float array array
val mutable pop: individual array array;
val mutable NN: NeuralNetwork
val args: Dictionary<string,string>
new(_args:Dictionary<string,string>) as this =
{
xoRate = 0.70; mutRate = 0.01; numSubPops = 10;
subPopSize = 10; chromLen = 10; maxGens = 10;
tourSize = 2; permutations = 3; pop= [| |];
NN = new NeuralNetwork(0,0,0);
args = _args;
train = getTrainingData (_args.Item "train");
}
then
this.createPop()
//-----------------------------------------//
/// Create the population, do all the declarations not possible in the constructor
member this.createPop() =
let args = this.args
this.xoRate <- floats(args.Item "xoRate");
this.mutRate <- floats(args.Item "mutRate");
let hiddenNodes = ints(args.Item "hiddenNodes") + 1
let outputNodes = ints(args.Item "outputNodes")
let inputNodes = (this.train.[0].Length - outputNodes) + 1
this.numSubPops <- hiddenNodes
this.subPopSize <- ints(this.args.Item "subPopSize");
this.maxGens <- ints(this.args.Item "maxGens");
this.tourSize <- ints(this.args.Item "tourSize");
this.permutations <- ints(this.args.Item "permutations");
this.chromLen <- inputNodes + outputNodes
this.pop <- Array.init this.numSubPops (fun i ->
Array.init this.subPopSize (fun j ->
let chrom = Array.init this.chromLen (fun k -> randWeight(this.NN.wMin, this.NN.wMax))
{ fitness=0.; chromosome=chrom } ))
randomShuffle this.train
this.NN <- new NeuralNetwork(inputNodes, hiddenNodes, outputNodes, args);
//-----------------------------------------//
/// Mutate chromosome by adding a random float
member this.mutate(chrom) =
let permute weight = if randF() < 0.5 then weight + randF() else weight - randF()
Array.map (fun w -> if randF() < this.mutRate then permute w else w) chrom
//-----------------------------------------//
/// Crossover two individuals
/// args: individual1 individual2
member this.crossover (p1:individual) (p2:individual) =
let xoPoint = randInt 1 (p1.chromosome.Length-2)
let c1, c2 = p1.chromosome |> Array.copy , p2.chromosome |> Array.copy
for i=0 to p1.chromosome.Length-1 do
if i >= xoPoint then
c1.[i] <- p2.chromosome.[i]
c2.[i] <- p1.chromosome.[i]
let c1, c2 = this.mutate c1, this.mutate c2
{fitness = 0.; chromosome=c1},
{fitness = 0.; chromosome=c2}
//-----------------------------------------//
/// Pick 2 parents from a subpopulation using tournament selection of size n
member this.pickParents (subpop: individual array) =
let tour() =
let player = List.init this.tourSize (fun x -> subpop.[randInt 0 (subpop.Length-1)])
let winner = List.fold_left (fun acc x -> if acc.fitness < x.fitness then acc else x) (List.hd player) player
winner
tour(), tour()
//-----------------------------------------//
/// Evaluate the current population
/// Construct a network by taking a node from each subpopulation
/// Assign the score of the network as the fitness of each node
member this.evalPop() =
let swap arr a b =
let temp = arr.[a]
arr.[a] <- arr.[b]
arr.[b] <- temp
let pop = this.pop
let shuffleSubPop subPop =
subPop |> Array.iteri (fun i _ -> swap subPop i (randInt 0 (subPop.Length-1)))
let inputNodes = this.NN.inputNodes
for i in {0 .. this.permutations-1} do
pop |> Array.iter shuffleSubPop
// for every individual in a subpopulation
for j in {0 .. pop.[0].Length-1} do
// for every subpopulation
for k in {0 .. pop.Length-1} do
let chrom = pop.[k].[j].chromosome
this.NN.wi |> Array.iteri (fun index x -> x.[k] <- chrom.[index])
this.NN.wo.[k] |> Array.iteri (fun index _ -> this.NN.wo.[k].[index] <- chrom.[index+inputNodes])
let score = this.NN.testNet this.train false
// for every node (from each subpop) used to construct the NN
// give its fitness
for k in {0 .. pop.Length-1} do
pop.[k].[j].fitness <- pop.[k].[j].fitness + score
let perm = float_of_int(this.permutations)
pop |> Array.iter (fun x ->
x |> Array.iteri (fun i y -> x.[i].fitness <- y.fitness/perm) )
//-----------------------------------------//
/// Create next population from offspring
member this.nextGen() =
let pop = this.pop
// for every subpop
pop |> Array.iter (fun subpop -> Array.Sort(subpop, fitnessComparer))
for i=0 to pop.Length-1 do
// for every ind in subpop
// leave first 4 individuals (top 4) in pop
for j in {4 .. 2 .. pop.[i].Length-1} do
let p1, p2 = this.pickParents pop.[i]
let c1, c2 = this.crossover p1 p2
pop.[i].[j] <- c1
pop.[i].[j+1] <- c2
//-----------------------------------------//
/// Test the currently best saved network
member this.testBest() =
let pop = this.pop
// copy best wi back
this.NN.wi |> Array.iteri (fun i row ->
row |> Array.iteri (fun j _ -> row.[j] <- this.NN.bestWi.[i].[j]) )
// copy best wo back
this.NN.wo |> Array.iteri (fun i row ->
row |> Array.iteri (fun j _ -> row.[j] <- this.NN.bestWo.[i].[j]) )
let score = this.NN.testNet this.train true
printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n"
printf "Best saved network score: %f\n" score
//-----------------------------------------//
/// Test the currently best saved network
member this.testHoldout holdout =
let pop = this.pop
// copy best wi back
this.NN.wi |> Array.iteri (fun i row ->
row |> Array.iteri (fun j _ -> row.[j] <- this.NN.bestWi.[i].[j]) )
// copy best wo back
this.NN.wo |> Array.iteri (fun i row ->
row |> Array.iteri (fun j _ -> row.[j] <- this.NN.bestWo.[i].[j]) )
let score = this.NN.testNet holdout true
printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n"
printf "Testing on holdout set: %f\n" score
end
The program driver:
#light
open System
open System.IO
open System.Collections.Generic
open Nn
open Ga
//-----------------------------------//
let parseArgs filename =
let args = new Dictionary<string,string>()
using (File.OpenText(filename))
(fun f ->
while not f.EndOfStream do
let (line:string) = f.ReadLine()
if line.[0] <> '#' then
let data = line.Split([| ' '; '=' |], System.StringSplitOptions.RemoveEmptyEntries)
args.Add(data.[0],data.[1])
)
args
//-----------------------------------//
let runNE() =
let args = parseArgs "config"
let myga = new NEGeneticAlgorithm(args)
let maxGens = int_of_string(args.Item "maxGens")
let holdout = getTrainingData("mytrain1.dat")
for i=0 to maxGens-1 do
printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\nGen %d\n" i
myga.evalPop()
myga.nextGen()
if (i % 50) = 0 then myga.testHoldout holdout
myga.testBest()
myga.testHoldout holdout
runNE()