4.8k
views1
comment

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

Hi Juan,

Great!

It looks like the emoticon problem hit your source code about halfway down. This is where F# constructs such as ":>" get rendered as emoticons by the server. It's annoying, of course - I think the first way to fix it is by editing the HTML by hand?

regards

don

By dsyme on 8/2/2007 1:59 PM (permalink)

Topic tags

Built with WebSharper

Home

Answers

Events

Courses

Groups and Conferences

Blogs

Jobs

Developers

Topic tags