unit Life;
{build up a neural network based on a chromozome}
{evaluate its fitness - how well it approximates the base function}
{an application object, which employs units of general neural network,
and general genetic algorithm and adapts them for our specific problem}
Interface
uses NeurNet, GenAlg, BaseFunc, Plot, Constant, Color;
type
  tNeurNetPopulation = object( tPopulation )
    c_NeurNet: t_NeuralNetwork;
      {this object will be used to evaluate chromozome fitness}
    c_BaseFunction: t_BaseFunction;
      {this object will store base function, which we'll want to approximate}
    {}
    function Fitness( p_Chromozome: t_Chromozome ): Real; virtual;
    {}
    procedure Build( p_Chromozome: t_Chromozome );
      {sets up weights and thresholds in a given neural network}
    function Evaluate: Real;
      {evaluates neural network
      takes input from c_BaseFunction
      returns output given by c_NeuralNetwork}
    function DecodeWeight( var p_Position: Pointer ): Real;
      {p_Position is a pointer into a chromozme
      function returns weight value encoded in chromozome at given position
      plus moves pointer over decoded section}
    function DecodeThreshold( var p_Position: Pointer ): Real;
      {p_Position is a pointer into a chromozme
      function returns threshold value encoded in chromozome at given position
      plus moves pointer over decoded section}
    function WeightCodeSize: Integer;
      {size of a chromozome section which encodes a weight}
    function ThresholdCodeSize: Integer;
      {size of a chromozome section which encodes a threshold}
    function ChromozomeLength: LongInt;
      {counts length of a chromozome necessary to represent assigned neural network}
    procedure ShowProgress; virtual;
    procedure Save( psFile: String );
      {psFile is filename without extension}
    procedure Load( psFile: String );
    {}
    procedure DisplayChromozome( pPlot: tPlot; p_Chromozome: t_Chromozome );
    procedure DisplayBaseFunction( pPlot: tPlot );
    {}
    procedure AssignNet( p_NeuralNetwork: t_NeuralNetwork );
    procedure AssignBaseFunction( p_BaseFunction: t_BaseFunction );
    end;


Implementation
procedure tNeurNetPopulation.Build( p_Chromozome: t_Chromozome );
var nPosition: LongInt;
  i, j, k: Integer;
  _r: ^Real;
  p: Pointer;
begin
  nPosition := 1;
  with c_NeurNet^ do
    for i := 2 to LayerCount do
      begin
      for j := 1 to NeuronCount(i) do
        begin
        for k := 1 to NeuronCount(i-1) do
          begin
          p_Chromozome^.SetPointer( p, nPosition );
          cWeights[ i-1, k, j ] := DecodeWeight( p );
          nPosition := nPosition + WeightCodeSize;
          end;
        p_Chromozome^.SetPointer( p, nPosition );
        _r := p;
        cThresholds[ i, j ] := DecodeThreshold( p );
        nPosition := nPosition + ThresholdCodeSize;
        end;
      end;
end;
function tNeurNetPopulation.ChromozomeLength: LongInt;
var i, j: Integer;
  nConnectionsCount: LongInt;
  nNeuronsCount: LongInt;
begin
  with c_NeurNet^ do
    begin
    nConnectionsCount := 0;
    nNeuronsCount := 0;
    for i := 1 to LayerCount do
      begin
      nNeuronsCount := nNeuronsCount + NeuronCount(i);
      end;
    for i := 2 to LayerCount do
      begin
      nConnectionsCount := nConnectionsCount + NeuronCount(i-1)*NeuronCount(i);
      end;
    ChromozomeLength := nConnectionsCount*WeightCodeSize
      + (nNeuronsCount-NeuronCount(1))*ThresholdCodeSize;
    end;
end;
function tNeurNetPopulation.Fitness( p_Chromozome: t_Chromozome ): Real;
var n: Word;
  i: Word;
  j: Integer;
  nFitness: Real;
  nDifference: Real;
  sum1, sum2, avg1, avg2: Real;
  Result: array[0..255] of Real;
  correl, disper1, disper2: Real;
begin
  Build( p_Chromozome );
  sum1 := 0;
  sum2 := 0;
  n := 1;
  for i := 1 to c_BaseFunction^.cInputWidth do
    n := n shl 1;
  for i := 0 to n-1 do
    begin
    c_BaseFunction^.Decompress( i );
    Result[i] := Evaluate;
    with c_BaseFunction^ do
      sum1 := sum1 + BoolToReal(cResult[i]);
    sum2 := sum2 + Result[i];
    end;
  avg1 := sum1/n;
  avg2 := sum2/n;
  correl := 0;
  disper1 := 0;
  disper2 := 0;
  for i := 0 to n-1 do
    begin
    with c_BaseFunction^ do
      correl := correl + (BoolToReal(c_BaseFunction^.cResult[i])-avg1)
        *(Result[i]-avg2);
      disper2 := disper2 + abs(Result[i]-avg2)*abs(Result[i]-avg2);
    with c_BaseFunction^ do
      disper1 := disper1 + (BoolToReal(c_BaseFunction^.cResult[i])-avg1)
        *(BoolToReal(c_BaseFunction^.cResult[i])-avg1);
    end;
  if correl < 0 then correl := 0;
  {Fitness := correl+exp(disper*2)-1;}
  {Fitness := correl+disper2/4;     }
  Fitness := sqrt(correl);
  {Fitness := sqrt(correl+disper2/4);}
  {Fitness := correl;}
  {Fitness := correl/n/Sqrt(disper1*disper2);}
  {Fitness := correl+exp(disper*2)-1;}
end;
procedure tNeurNetPopulation.AssignNet( p_NeuralNetwork: t_NeuralNetwork );
begin
  c_NeurNet := p_NeuralNetwork;
end;
procedure tNeurNetPopulation.AssignBaseFunction( p_BaseFunction: t_BaseFunction );
begin
  c_BaseFunction := p_BaseFunction;
end;
function tNeurNetPopulation.DecodeWeight( var p_Position: Pointer ): Real;
var _b: ^Byte;
begin
  _b := p_Position;
  DecodeWeight := _b^/256;
  inc( _b );
  p_Position := _b;
end;
function tNeurNetPopulation.DecodeThreshold( var p_Position: Pointer ): Real;
var _b: ^Byte;
  a: Real;
begin
  _b := p_Position;
{  a := _b^/256*c_BaseFunction^.cInputWidth/2;
  DecodeThreshold := a - c_BaseFunction^.cInputWidth/4;}
  a := _b^/256*c_BaseFunction^.cInputWidth;
  DecodeThreshold := -7/6*a+1/6*a;
  inc( _b );
  p_Position := _b;
end;
function tNeurNetPopulation.WeightCodeSize: Integer;
begin
  WeightCodeSize := 1;
end;
function tNeurNetPopulation.ThresholdCodeSize: Integer;
begin
  ThresholdCodeSize := 1;
end;
function tNeurNetPopulation.Evaluate: Real;
var j: Integer;
begin
  for j := 1 to c_NeurNet^.NeuronCount(1) do
    c_NeurNet^.SetActivity( 1, j, c_BaseFunction^.cData[j] );
  c_NeurNet^.ProcessNetwork;
  Evaluate := c_NeurNet^.Activity(c_NeurNet^.LayerCount,1);
end;
procedure tNeurNetPopulation.Save( psFile: String );
var _a: t_Chromozome;
begin
  c_BaseFunction^.Save( psFile+'.fnc' );
  c_Statistics^.Save( psFile+'.sta' );
  _a := c_Statistics^.c_BestMember;
  _a^.Save( psFile+'.chr' );
end;
procedure tNeurNetPopulation.Load( psFile: String );
var _a: t_Chromozome;
begin
  c_BaseFunction^.Load( psFile+'.fnc' );
  c_Statistics^.Load( psFile+'.sta' );
  c_Statistics^.c_BestMember := nil;
  new( _a );
  _a^.Load( psFile+'.chr' );
  _a^.Release( c_Statistics^.c_BestMember );
  _a^.Store( c_Statistics^.c_BestMember );
  dispose( _a );
end;
procedure tNeurNetPopulation.ShowProgress;
var c1, c2, c3: tColor;
  Plot: tPlot;
  n, i: Integer;
begin
  with c_Statistics^ do
    if (cnAnimateDelay > 0) and (cGenerationCount mod cnAnimateDelay = 0) then
      begin
      ColorPool.GetColor( 'graph text', c3 );
      MaxFitnessPlot;
      n := 1;
      for i := 0 to c_BaseFunction^.cInputWidth-1 do
        n := n shl 1;
      Plot.SetRegion( 0, n-1, 0, 1 );
      Plot.SetWindow( 3, 10, 65, 24 );
      Plot.Axis( c3 );
      c_Statistics^.ShowColorLegend( Plot, 1, 'base function' );
      c_Statistics^.ShowColorLegend( Plot, 2, 'neural network' );
      DisplayBaseFunction( Plot );
      DisplayChromozome( Plot, c_Statistics^.c_BestMember );
      end;
end;
procedure tNeurNetPopulation.DisplayChromozome( pPlot: tPlot; p_Chromozome: t_Chromozome );
var old, new: Real;
  n, i: Integer;
  Col: tColor;
begin
  ColorPool.GetColor( 'neural network', Col );
  Build( p_Chromozome );
  with c_BaseFunction^ do
    begin
    Decompress( 0 );
    old := Self.Evaluate;
    n := 1;
    for i := 1 to cInputWidth do
      n := n shl 1;
    for i := 1 to n-1 do
      begin
      Decompress( i );
      new := Self.Evaluate;
      pPlot.Line( i-1, old, i, new, Col );
      old := new;
      end;
    end;
end;
procedure tNeurNetPopulation.DisplayBaseFunction( pPlot: tPlot );
var old, new: Real;
  n, i: Integer;
  Col: tColor;
begin
  ColorPool.GetColor( 'base function', Col );
  c_BaseFunction^.Decompress( 0 );
  with c_BaseFunction^ do
    old := BoolToReal( Evaluate );
  for i := 1 to 15 do
    begin
    c_BaseFunction^.Decompress( i );
    with c_BaseFunction^ do
      new := BoolToReal( Evaluate );
    pPlot.Line( i-1, old, i, new, Col );
    old := new;
    end;
end;

begin
end.