You've already forked lazarus-ccr
045c799d49
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7882 8e941d3f-bd1b-0410-a28a-d453659cc2b4
456 lines
15 KiB
ObjectPascal
456 lines
15 KiB
ObjectPascal
unit FreqUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Buttons, ExtCtrls, Globals, MainUnit, OutPutUnit, FunctionsLib,
|
|
GraphLib, DataProcs;
|
|
|
|
type
|
|
|
|
{ TFreqFrm }
|
|
|
|
TFreqFrm = class(TForm)
|
|
ResetBtn: TButton;
|
|
CancelBtn: TButton;
|
|
OKBtn: TButton;
|
|
NormPltChk: TCheckBox;
|
|
InBtn: TBitBtn;
|
|
OutBtn: TBitBtn;
|
|
AllBtn: TBitBtn;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
ListBox1: TListBox;
|
|
RadioGroup1: TRadioGroup;
|
|
RadioGroup2: TRadioGroup;
|
|
VarList: TListBox;
|
|
procedure AllBtnClick(Sender: TObject);
|
|
procedure CancelBtnClick(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure InBtnClick(Sender: TObject);
|
|
procedure OKBtnClick(Sender: TObject);
|
|
procedure OutBtnClick(Sender: TObject);
|
|
procedure ResetBtnClick(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
FreqFrm: TFreqFrm;
|
|
|
|
implementation
|
|
|
|
{ TFreqFrm }
|
|
uses FreqSpecsUnit;
|
|
|
|
procedure TFreqFrm.ResetBtnClick(Sender: TObject);
|
|
var
|
|
i : integer;
|
|
|
|
begin
|
|
VarList.Clear;
|
|
ListBox1.Clear;
|
|
for i := 1 to NoVariables do
|
|
begin
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
end;
|
|
RadioGroup2.ItemIndex := -1;
|
|
InBtn.Enabled := true;
|
|
OutBtn.Enabled := false;
|
|
RadioGroup1.ItemIndex := -1;
|
|
NormPltChk.Checked := false;
|
|
end;
|
|
|
|
procedure TFreqFrm.CancelBtnClick(Sender: TObject);
|
|
begin
|
|
FreqFrm.Hide;
|
|
end;
|
|
|
|
procedure TFreqFrm.FormShow(Sender: TObject);
|
|
begin
|
|
ResetBtnClick(self);
|
|
end;
|
|
|
|
procedure TFreqFrm.AllBtnClick(Sender: TObject);
|
|
var
|
|
count, index : integer;
|
|
|
|
begin
|
|
count := VarList.Items.Count;
|
|
for index := 0 to count-1 do
|
|
begin
|
|
ListBox1.Items.Add(VarList.Items.Strings[index]);
|
|
end;
|
|
VarList.Clear;
|
|
end;
|
|
|
|
procedure TFreqFrm.InBtnClick(Sender: TObject);
|
|
var
|
|
index, i : integer;
|
|
|
|
begin
|
|
index := VarList.Items.Count;
|
|
i := 0;
|
|
while i < index do
|
|
begin
|
|
if (VarList.Selected[i]) then
|
|
begin
|
|
ListBox1.Items.Add(VarList.Items.Strings[i]);
|
|
VarList.Items.Delete(i);
|
|
index := index - 1;
|
|
i := 0;
|
|
end
|
|
else i := i + 1;
|
|
end;
|
|
OutBtn.Enabled := true;
|
|
end;
|
|
|
|
procedure TFreqFrm.OKBtnClick(Sender: TObject);
|
|
label again, cleanup;
|
|
|
|
var
|
|
i, j, k : integer;
|
|
freq : DblDyneVec;
|
|
pcnt : DblDyneVec;
|
|
cumpcnt : DblDyneVec;
|
|
pcntilerank : DblDyneVec;
|
|
cumfreq : DblDyneVec;
|
|
XValue : DblDyneVec;
|
|
value : double;
|
|
NoVars : integer;
|
|
plottype : integer;
|
|
cellval : string;
|
|
col : integer;
|
|
min, max : double;
|
|
range : double;
|
|
incrsize : double;
|
|
nointervals : double;
|
|
nints : integer;
|
|
outline : string;
|
|
// ColNoSelected : IntDyneVec;
|
|
NoSelected : integer;
|
|
NormDist : boolean;
|
|
Histogram : boolean;
|
|
Sumx, Sumx2, Mean, Variance, StdDev, zlow, zhi : double;
|
|
X, zproplow, zprophi, zfreq : double;
|
|
Ncases : integer;
|
|
|
|
begin
|
|
if RadioGroup2.ItemIndex = 1 then Histogram := true else Histogram := false;
|
|
if NormPltChk.Checked = true then NormDist := true else NormDist := false;
|
|
SetLength(freq,NoCases);
|
|
SetLength(pcnt,NoCases);
|
|
SetLength(cumpcnt,NoCases);
|
|
SetLength(pcntilerank,NoCases);
|
|
SetLength(cumfreq,NoCases);
|
|
SetLength(XValue,NoCases);
|
|
|
|
OutPutFrm.RichEdit.Clear;
|
|
OutPutFrm.RichEdit.Lines.Add('FREQUENCY ANALYSIS BY BILL MILLER');
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
// OutPutFrm.RichEdit.ParaGraph.Alignment := taLeftJustify;
|
|
|
|
{ Analyze each variable }
|
|
NoVars := ListBox1.Items.Count;
|
|
for i := 1 to NoVars do
|
|
begin
|
|
{ get column no. of variable }
|
|
col := 1;
|
|
cellval := ListBox1.Items.Strings[i-1];
|
|
for j := 1 to NoVariables do
|
|
begin
|
|
if OS3MainFrm.DataGrid.Cells[j,0] = cellval then
|
|
begin
|
|
col := j;
|
|
outline := format('Frequency Analysis for %s',[cellval]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
break;
|
|
end;
|
|
end;
|
|
NoSelected := 1;
|
|
|
|
{ get min and max values for variable in col }
|
|
min := 1.0e32;
|
|
max := -1.0e32;
|
|
for j := 1 to NoCases do
|
|
begin
|
|
if Not ValidValue(j,col) then continue;
|
|
value := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]);
|
|
if value > max then max := value;
|
|
if value < min then min := value;
|
|
end;
|
|
range := max - min + 1.0;
|
|
incrsize := 1.0;
|
|
{ if too many increments, set increment size for 15 increments }
|
|
if range > 200.0 then incrsize := range / 15;
|
|
nointervals := range / incrsize;
|
|
nints := round(nointervals);
|
|
{ Get user's approval and / or changes }
|
|
FreqSpecsFrm.VarName.Text := cellval;
|
|
FreqSpecsFrm.Minimum.Text := FloatToStr(min);
|
|
FreqSpecsFrm.Maximum.Text := FloatToStr(max);
|
|
FreqSpecsFrm.range.Text := FloatToStr(range);
|
|
FreqSpecsFrm.IntSize.Text := FloatToStr(incrsize);
|
|
FreqSpecsFrm.NoInts.Text := IntToStr(nints);
|
|
again: FreqSpecsFrm.ShowModal;
|
|
incrsize := StrToFloat(FreqSpecsFrm.IntSize.Text);
|
|
nointervals := StrToFloat(FreqSpecsFrm.NoInts.Text);
|
|
nints := round(nointervals);
|
|
if nints+1 > NoCases then
|
|
begin
|
|
ShowMessage('ERROR! No. of intervals cannot be greater than no. of cases!');
|
|
goto again;
|
|
end;
|
|
if nints > 200 then
|
|
begin
|
|
nints := 200;
|
|
// Application.MessageBox('Max. increments set to 200','Exceeded Maximum!',MB_OK);
|
|
end;
|
|
{Now, get frequency of cases in each interval }
|
|
for j := 1 to nints+1 do freq[j-1] := 0;
|
|
Ncases := 0;
|
|
for j := 1 to NoCases do
|
|
begin
|
|
if Not ValidValue(j,col) then continue;
|
|
Ncases := Ncases + 1;
|
|
value := StrToFloat(OS3MainFrm.DataGrid.Cells[col,j]);
|
|
for k := 1 to nints do
|
|
begin
|
|
if (value >= min + ((k-1) * incrsize)) and
|
|
(value < min + (k * incrsize)) then freq[k-1] := freq[k-1] + 1;
|
|
end;
|
|
end;
|
|
for j := 1 to nints+1 do XValue[j-1] := min + (j-1) * incrsize;
|
|
|
|
{ get cumulative frequencies and percents to midpoints }
|
|
cumfreq[0] := freq[0];
|
|
pcnt[0] := freq[0] / Ncases;
|
|
cumpcnt[0] := cumfreq[0] / Ncases;
|
|
pcntilerank[0] := (freq[0] / 2.0) / Ncases;
|
|
for k := 2 to nints do
|
|
begin
|
|
cumfreq[k-1] := cumfreq[k-2] + freq[k-1];
|
|
pcnt[k-1] := freq[k-1] / Ncases;
|
|
cumpcnt[k-1] := cumfreq[k-1] / Ncases;
|
|
pcntilerank[k-1] := (cumfreq[k-2] + freq[k-1] / 2.0) / Ncases;
|
|
end;
|
|
{ Now, print results }
|
|
OutPutFrm.RichEdit.Lines.Add(' FROM TO FREQ. PCNT CUM.FREQ. CUM.PCNT. %ILE RANK');
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
for k := 1 to nints do
|
|
begin
|
|
outline := format('%8.2f%8.2f%8.0f%8.2f %8.2f %8.2f %8.2f',
|
|
[min+(k-1)*incrsize, // from
|
|
min+k*incrsize, // to
|
|
freq[k-1], // freq
|
|
pcnt[k-1], // pcnt
|
|
cumfreq[k-1], // cum.freq.
|
|
cumpcnt[k-1], // cum.pcnt.
|
|
pcntilerank[k-1]]); // %ile rank
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.ShowModal;
|
|
OutPutFrm.RichEdit.Clear;
|
|
{ Now, plot values as indicated in options list }
|
|
plottype := RadioGroup1.ItemIndex + 1;
|
|
if Histogram = true then GraphFrm.barwideprop := 1.0 else
|
|
GraphFrm.barwideprop := 0.5;
|
|
if NormDist = true then GraphFrm.nosets := 2 else GraphFrm.nosets := 1;
|
|
GraphFrm.nbars := nints+1;
|
|
GraphFrm.Heading := cellval;
|
|
GraphFrm.XTitle := 'Lower Limit Values';
|
|
GraphFrm.YTitle := 'Frequency';
|
|
if NormDist = false then
|
|
SetLength(GraphFrm.Ypoints,1,nints+1)
|
|
else SetLength(GraphFrm.Ypoints,2,nints+1);
|
|
SetLength(GraphFrm.Xpoints,1,nints+1);
|
|
for k := 1 to nints+1 do
|
|
begin
|
|
GraphFrm.Ypoints[0,k-1] := freq[k-1];
|
|
GraphFrm.Xpoints[0,k-1] := XValue[k-1];
|
|
end;
|
|
// Create ND plot if checked
|
|
if NormDist = true then
|
|
begin
|
|
OutPutFrm.RichEdit.Lines.Add('Interval ND Freq.');
|
|
// Only use 3Dvertical plots when normal curve desired
|
|
RadioGroup1.ItemIndex := 3;
|
|
// get mean and standard deviation of xvalues, then height of
|
|
// the normal curve for each Normally distributed corresponding
|
|
// z score
|
|
sumx := 0.0;
|
|
sumx2 := 0.0;
|
|
for k := 1 to nints do
|
|
begin
|
|
sumx := sumx + (XValue[k-1] * freq[k-1]);
|
|
sumx2 := sumx2 + ((XValue[k-1] * XValue[k-1]) * freq[k-1]);
|
|
end;
|
|
Mean := sumx / Ncases;
|
|
Variance := sumx2 - ((sumx * sumx) / Ncases);
|
|
Variance := Variance / (Ncases - 1);
|
|
StdDev := sqrt(Variance);
|
|
for k := 1 to nints+1 do
|
|
begin
|
|
X := XValue[k-1] - (incrsize / 2.0);
|
|
if StdDev > 0.0 then zlow := (X - Mean) / StdDev
|
|
else zlow := 0.0;
|
|
X := XValue[k-1] + (incrsize / 2.0);
|
|
if StdDev > 0.0 then zhi := (X - Mean) / StdDev
|
|
else zhi := 0.0;
|
|
// get cum. prop. for this z and translate to frequency
|
|
zproplow := probz(zlow);
|
|
zprophi := probz(zhi);
|
|
zfreq := NoCases * abs(zprophi - zproplow);
|
|
GraphFrm.Ypoints[1,k-1] := zfreq;
|
|
outline := format(' %2d %6.2f',[k,GraphFrm.Ypoints[1,k-1]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.ShowModal;
|
|
OutPutFrm.RichEdit.Clear;
|
|
end;
|
|
if plottype = 1 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 2d Vertical Bar Chart
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.FloorColor := clLtGray;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 2 then // 3D vertical bars
|
|
begin
|
|
{ enter parameters for 2 dimension bars in graph package }
|
|
GraphFrm.GraphType := plottype; // 3d vertical bars
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.ShowLeftWall := true;
|
|
GraphFrm.ShowRightWall := true;
|
|
GraphFrm.ShowBottomWall := true;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 3 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 2d pie chart
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 4 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 3d pie chart
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowLeftWall := true;
|
|
GraphFrm.ShowRightWall := true;
|
|
GraphFrm.ShowBottomWall := true;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 5 then // 2D Line Graph
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 2d Lines
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 6 then // 3D Line Chart
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 3d Lines
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowLeftWall := true;
|
|
GraphFrm.ShowRightWall := true;
|
|
GraphFrm.ShowBottomWall := true;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 7 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 2D Plot
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 8 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 3D Plot
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowLeftWall := true;
|
|
GraphFrm.ShowRightWall := true;
|
|
GraphFrm.ShowBottomWall := true;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 9 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 2d Horizontal Bar Chart
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.FloorColor := clLtGray;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
if plottype = 10 then
|
|
begin
|
|
GraphFrm.AutoScale := true;
|
|
GraphFrm.GraphType := plottype; // 3d Horizontal Bar Chart
|
|
GraphFrm.BackColor := clYellow;
|
|
GraphFrm.WallColor := clBlack;
|
|
GraphFrm.ShowLeftWall := true;
|
|
GraphFrm.ShowRightWall := true;
|
|
GraphFrm.ShowBottomWall := true;
|
|
GraphFrm.FloorColor := clLtGray;
|
|
GraphFrm.ShowBackWall := true;
|
|
GraphFrm.ShowModal;
|
|
end;
|
|
GraphFrm.Xpoints := nil;
|
|
GraphFrm.Ypoints := nil;
|
|
end; // for novars list
|
|
|
|
cleanup:
|
|
XValue := nil;
|
|
cumfreq := nil;
|
|
pcntilerank := nil;
|
|
cumpcnt := nil;
|
|
pcnt := nil;
|
|
freq := nil;
|
|
FreqFrm.Hide;
|
|
end;
|
|
|
|
procedure TFreqFrm.OutBtnClick(Sender: TObject);
|
|
var
|
|
index: integer;
|
|
|
|
begin
|
|
index := ListBox1.ItemIndex;
|
|
VarList.Items.Add(ListBox1.Items.Strings[index]);
|
|
ListBox1.Items.Delete(index);
|
|
InBtn.Enabled := true;
|
|
if ListBox1.Items.Count = 0 then OutBtn.Enabled := false;
|
|
end;
|
|
|
|
initialization
|
|
{$I frequnit.lrs}
|
|
|
|
end.
|
|
|