home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / matemat / Vyssi / MATH2.ZIP / exmpl-1 / pas / frmcent.pas < prev    next >
Pascal/Delphi Source File  |  1997-01-06  |  4KB  |  133 lines
  1. unit Frmcent;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, RChart, ExtCtrls, NumLab;
  8.  
  9. {===========================================================
  10.  Please note, that the program FINDCENT uses the units RChart
  11.  and NumLab, which are not supplied with the MATH2 package. If
  12.  you don't have them, you can download them from the following
  13.  WWW site:  http://qspr03.tuwien.ac.at/lo/
  14.  ===========================================================}
  15.  
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     Panel1: TPanel;
  20.     RChart1: TRChart;
  21.     BButExit: TBitBtn;
  22.     BButCreateD: TBitBtn;
  23.     BButCalcCent: TBitBtn;
  24.     NLabProcCnt: TNumLab;
  25.     procedure BButExitClick(Sender: TObject);
  26.     procedure BButCreateDClick(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure BButCalcCentClick(Sender: TObject);
  29.   public
  30.     { Public declarations }
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. uses
  41.   Matrix, math2;
  42.  
  43. const
  44.   NData = 200;                    { number of data points }
  45.   NCenters = 10;                      { number of centers }
  46.  
  47. var
  48.   Data     : TMatrix;                       { data matrix }
  49.   Centers  : TMatrix;                { calculated centers }
  50.  
  51. (*********************************************************)
  52. procedure TForm1.BButExitClick(Sender: TObject);
  53. (*********************************************************)
  54.  
  55. begin
  56. close;
  57. end;
  58.  
  59. (*********************************************************)
  60. procedure TForm1.BButCreateDClick(Sender: TObject);
  61. (*********************************************************)
  62.  
  63. var
  64.   i : integer;
  65.  
  66. begin
  67. RChart1.ClearGraf;
  68. RChart1.DataColor := clBlack;
  69. for i:=1 to NData div 2 do
  70.   begin
  71.   Data.Elem[1,i] := 0.05*RChart1.RangeHiX+0.9*RChart1.RangeHiX*random;
  72.   Data.Elem[2,i] := 0.05*RChart1.RangeHiY+0.9*RChart1.RangeHiY*random;
  73.   RChart1.MarkAt (Data.Elem[1,i],Data.Elem[2,i],7);
  74.   end;
  75. for i:=NData div 2 to NData-20 do
  76.   begin
  77.   Data.Elem[1,i] := 0.15*RChart1.RangeHiX+0.4*RChart1.RangeHiX*random;
  78.   Data.Elem[2,i] := 0.15*RChart1.RangeHiY+0.4*RChart1.RangeHiY*random;
  79.   RChart1.MarkAt (Data.Elem[1,i],Data.Elem[2,i],7);
  80.   end;
  81. for i:=NData-20 to NData do
  82.   begin
  83.   Data.Elem[1,i] := 0.25*RChart1.RangeHiX+0.2*RChart1.RangeHiX*random;
  84.   Data.Elem[2,i] := 0.25*RChart1.RangeHiY+0.2*RChart1.RangeHiY*random;
  85.   RChart1.MarkAt (Data.Elem[1,i],Data.Elem[2,i],7);
  86.   end;
  87. RChart1.SHowGraf;
  88. end;
  89.  
  90. (*********************************************************)
  91. procedure TForm1.FormCreate(Sender: TObject);
  92. (*********************************************************)
  93.  
  94. begin
  95. Data := TMatrix.Create (2,NData);
  96. Data.Fill (0);
  97. Centers := TMatrix.Create (2,NCenters);
  98. Centers.Fill (0);
  99. end;
  100.  
  101. (*********************************************************)
  102. procedure ShowProgress (cnt: longint); far;
  103. (*********************************************************)
  104.  
  105. begin
  106. Form1.NLabProcCnt.Value := 100*(cnt/NData);
  107. end;
  108.  
  109. (*********************************************************)
  110. procedure TForm1.BButCalcCentClick(Sender: TObject);
  111. (*********************************************************)
  112.  
  113. var
  114.   MeanDist : double;
  115.   i        : integer;
  116.  
  117. begin
  118. ProcStat := 0;
  119. MathFeedbackProc := ShowProgress;
  120. NLabProcCnt.LeftText := '... calculating';
  121. NLabProcCnt.RightText := '% done';
  122. NLabProcCnt.Visible := true;
  123. FindCenters (Data, 1, Data.NrOfRows, NCenters, Centers, MeanDist);            { mean distance }
  124. RChart1.DataColor := clRed;
  125. for i:=1 to NCenters do
  126.   RChart1.MarkAt (Centers.Elem[1,i],Centers.Elem[2,i],12);
  127. RChart1.SHowGraf;
  128. MathFeedbackProc := NIL;
  129. NLabProcCnt.Visible := false;
  130. end;
  131.  
  132. end.
  133.