home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / AddOns / Components / TEECHART / Delphi1_And_Delphi2 / EXAMPLES / OTHER / NEURAL / NEUDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-24  |  7.4 KB  |  267 lines
  1. {**********************************************}
  2. {   TeeChart                                   }
  3. {   Neural Net Example                         }
  4. {   Copyright (c) 1995-1996 by David Berneda   }
  5. {**********************************************}
  6. unit Neudemo;
  7.  
  8. interface
  9.  
  10. uses
  11.   Wintypes,WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  12.   StdCtrls, Buttons, ExtCtrls, Teengine, Chart,Neural, Series, Curvfitt,USurfac,
  13.   TeeProcs;
  14.  
  15. type
  16.   TNeuralExample = class(TForm)
  17.     ErrorLine: TFastLineSeries;
  18.     Panel1: TPanel;
  19.     BitBtn1: TBitBtn;
  20.     BitBtn2: TBitBtn;
  21.     LearnedLine: TFastLineSeries;
  22.     Panel2: TPanel;
  23.     Chart1: TChart;
  24.     Chart2: TChart;
  25.     Panel3: TPanel;
  26.     Chart3: TChart;
  27.     Chart4: TChart;
  28.     TargetLine: TFastLineSeries;
  29.     BetaLine: TFastLineSeries;
  30.     BitBtn5: TBitBtn;
  31.     CBShowCurves: TCheckBox;
  32. {    CurveFittingSeries1: TCurveFittingSeries;
  33.     CurveFittingSeries2: TCurveFittingSeries;}
  34.     Label1: TLabel;
  35.     Panel4: TPanel;
  36.     Label2: TLabel;
  37.     Label3: TLabel;
  38.     BitBtn3: TBitBtn;
  39.     BitBtn4: TBitBtn;
  40.     CBFlicker: TCheckBox;
  41.     BitBtn6: TBitBtn;
  42.     OpenDialog1: TOpenDialog;
  43.     CurveFittingSeries1: TLineSeries;
  44.     TeeFunction1: TCurveFittingFunction;
  45.     CurveFittingSeries2: TLineSeries;
  46.     TeeFunction2: TCurveFittingFunction;
  47.     procedure FormCreate(Sender: TObject);
  48.     procedure FormDestroy(Sender: TObject);
  49.     procedure BitBtn1Click(Sender: TObject);
  50.     procedure BitBtn2Click(Sender: TObject);
  51.     procedure BitBtn4Click(Sender: TObject);
  52.     procedure BitBtn5Click(Sender: TObject);
  53.     procedure CBShowCurvesClick(Sender: TObject);
  54.     procedure Chart1DblClick(Sender: TObject);
  55.     procedure CBFlickerClick(Sender: TObject);
  56.     procedure BitBtn6Click(Sender: TObject);
  57.   private
  58.     { Private declarations }
  59.   public
  60.     { Public declarations }
  61.     Neural:TNeuralNet;
  62.     Surface:TSurfaceWeights;
  63.     procedure OnNeuralIteration(Sender:TNeuralNet; Var Action:TNeuralNetAction);
  64.     procedure CreateSurface(Sender: TObject);
  65.     procedure LoadNetwork(Const NetworkName:String);
  66.   end;
  67.  
  68. var
  69.   NeuralExample: TNeuralExample;
  70.  
  71. implementation
  72.  
  73. {$R *.DFM}
  74. Uses EditChar,FLineEdi,CustEdit,UExplain;
  75.  
  76. { This event is used to re-draw all charts while running the neural net }
  77. procedure TNeuralExample.OnNeuralIteration(Sender:TNeuralNet; Var Action:TNeuralNetAction);
  78. var t:Longint;
  79. Begin
  80.  if (Sender.IterationCount mod 50)=0 then
  81.  Begin
  82.    ErrorLine.AddY(100.0*Sender.Output.FinalErr/Sender.Input.Size,'',clTeeColor);
  83.    BetaLine.AddY(Neural.Beta,'',clTeeColor);
  84.    LearnedLine.Clear;
  85.    for t:=1 to Neural.Input.NumSamples do
  86.        LearnedLine.AddY(Neural.CalcGuessedOutput(t),'',clTeeColor);
  87.    LearnedLine.RefreshSeries;
  88.    {$B-}
  89.    if (Surface<>nil) and (Surface.Visible) then CreateSurface(Self);
  90.    Application.ProcessMessages;
  91.  end;
  92. End;
  93.  
  94. procedure TNeuralExample.FormCreate(Sender: TObject);
  95. begin
  96.   { warning if video don't supports true or high color }
  97.   if not Chart1.IsScreenHighColor then
  98.      ShowMessage('This demo looks much better with'+#13+
  99.                  '16k colors or greater.');
  100.   TeeEraseBack:=False;       { <-- to prevent flicker in Win95 + Plus ! }
  101.   TeeDefaultCapacity:=2000;  { <-- to speed things when adding points }
  102.   Neural:=nil;               { <-- set the neural network object to nil }
  103.  
  104.   { activate the charts background "gradient" if video mode of 16k colors }
  105.   Chart1.Gradient.Visible:=Chart1.IsScreenHighColor;
  106.   Chart4.Gradient.Visible:=Chart4.IsScreenHighColor;
  107.  
  108.   { Load sample values from disk }
  109.   LoadNetwork('DEMO.NET');
  110. end;
  111.  
  112. procedure TNeuralExample.LoadNetwork(Const NetworkName:String);
  113. var t,tt:Longint;
  114.     tmpSeries:TFastLineSeries;
  115. begin
  116.   if Neural<>nil then Neural.Free;
  117.  
  118.   Neural:=TNeuralNet.Create(Self);
  119.   Neural.OnIteration:=OnNeuralIteration;
  120.   try
  121.     Neural.ReadDataFile(NetworkName);
  122.   except
  123.     on E:Exception do
  124.     begin
  125.       ShowMessage(NetworkName+ ' can not be found.'+#13+
  126.                                'Please check working directory.'+#13+
  127.                                'Error:'+E.Message);
  128.     end;
  129.   end;
  130.  
  131.  
  132.   With Chart3 do
  133.   While SeriesCount>0 do Series[0].Free;
  134.  
  135.   for t:=1 to Neural.Input.Size do
  136.   begin
  137.     tmpSeries:=TFastLineSeries.Create(Self);
  138.     tmpSeries.Title:='Input #'+IntToStr(t);
  139.     tmpSeries.XValues.DateTime:=False;
  140.     tmpSeries.ParentChart:=Chart3;
  141.     With Neural.Input do
  142.     for tt:=1 to NumSamples do
  143.         tmpSeries.AddY( Samples.Sample[tt,t],'',clTeeColor );
  144.   end;
  145.  
  146.   ErrorLine.Clear;
  147.   BetaLine.Clear;
  148.   LearnedLine.Clear;
  149.   CurveFittingSeries1.Clear;
  150.   CurveFittingSeries2.Clear;
  151.   TargetLine.Clear;
  152.   for t:=1 to Neural.Input.NumSamples do
  153.       TargetLine.AddY( Neural.Output.Samples.GetData(t,1),'',clTeeColor);
  154. end;
  155.  
  156. procedure TNeuralExample.FormDestroy(Sender: TObject);
  157. begin
  158.   if Neural<>nil then Neural.Free;
  159. end;
  160.  
  161. procedure TNeuralExample.BitBtn1Click(Sender: TObject);
  162. begin
  163.   ErrorLine.Clear;
  164.   BetaLine.Clear;
  165.   LearnedLine.Clear;
  166.  
  167.   BitBtn1.Enabled:=False;
  168.   BitBtn2.Enabled:=True;
  169.   BitBtn3.Enabled:=False;
  170.   BitBtn6.Enabled:=False;
  171.   BitBtn2.SetFocus;
  172.   if Neural<>nil then Neural.StartLearning;
  173. end;
  174.  
  175. procedure TNeuralExample.BitBtn2Click(Sender: TObject);
  176. begin
  177.   if Neural<>nil then Neural.Learned:=True;
  178.   BitBtn1.Enabled:=True;
  179.   BitBtn2.Enabled:=False;
  180.   BitBtn3.Enabled:=True;
  181.   BitBtn6.Enabled:=True;
  182.   BitBtn1.SetFocus;
  183. end;
  184.  
  185. procedure TNeuralExample.CreateSurface(Sender: TObject);
  186. var x,z:Longint;
  187. begin
  188.   if Neural<>nil then
  189.   if Surface<>nil then
  190.   With Surface.SurfaceSeries1 do
  191.   begin
  192.     Clear;
  193.     NumXValues:=Neural.Medium.Size;
  194.     NumZValues:=Neural.Input.Size;
  195.     for x:=1 to NumXValues do
  196.         for z:=1 to NumZValues do
  197.             AddXYZ(  x,
  198.                      Neural.Medium.Weights.Weight[x,z],
  199.                      z,
  200.                      '',
  201.                      clTeeColor);
  202.  
  203.   end;
  204. end;
  205.  
  206. procedure TNeuralExample.BitBtn4Click(Sender: TObject);
  207. begin
  208.   if Surface=nil then
  209.   begin
  210.     Surface:=TSurfaceWeights.Create(Self);
  211.     CreateSurface(Self);
  212.   end;
  213.   Surface.Show;
  214. end;
  215.  
  216. procedure TNeuralExample.BitBtn5Click(Sender: TObject);
  217. begin
  218.   With TExplain.Create(Self) do
  219.   try
  220.     ShowModal;
  221.   finally
  222.     Free;
  223.   end;
  224. end;
  225.  
  226. procedure TNeuralExample.CBShowCurvesClick(Sender: TObject);
  227. begin
  228.   if CBShowCurves.Checked then
  229.   begin
  230.     CurveFittingSeries1.Active:=True;
  231.     CurveFittingSeries2.Active:=True;
  232.     CurveFittingSeries1.DataSource:=LearnedLine;
  233.     CurveFittingSeries2.DataSource:=TargetLine;
  234.   end
  235.   else
  236.   begin
  237.     CurveFittingSeries1.DataSource:=nil;
  238.     CurveFittingSeries2.DataSource:=nil;
  239.     CurveFittingSeries1.Active:=False;
  240.     CurveFittingSeries2.Active:=False;
  241.   end;
  242. end;
  243.  
  244. procedure TNeuralExample.Chart1DblClick(Sender: TObject);
  245. begin
  246.   EditChart(Self,Sender as TChart);
  247.   { WARNING:  Turn off "Break On Exception" option to not
  248.     stop the application when double clicking charts }
  249.   Abort; { <-- very important !!! }
  250. end;
  251.  
  252. procedure TNeuralExample.CBFlickerClick(Sender: TObject);
  253. begin
  254.   Chart1.BufferedDisplay:=not CBFlicker.Checked;
  255.   Chart2.BufferedDisplay:=not CBFlicker.Checked;
  256.   Chart3.BufferedDisplay:=not CBFlicker.Checked;
  257.   Chart4.BufferedDisplay:=not CBFlicker.Checked;
  258. end;
  259.  
  260. procedure TNeuralExample.BitBtn6Click(Sender: TObject);
  261. begin
  262.   if OpenDialog1.Execute then
  263.      LoadNetwork(OpenDialog1.FileName);
  264. end;
  265.  
  266. end.
  267.