pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/breakdownunit.pas
wp_xxyyzz deadd25261 LazStats: Repeating to add original source (having connectivity problems) 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7880 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:01:57 +00:00

560 lines
17 KiB
ObjectPascal
Raw Blame History

unit BreakDownUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, MainUnit, Globals, functionsLib, OutPutUnit,
DataProcs, contexthelpunit;
type
{ TBreakDownFrm }
TBreakDownFrm = class(TForm)
HelpBtn: TButton;
InBtn: TBitBtn;
OutBtn: TBitBtn;
SelVarInBtn: TBitBtn;
SelVarOutBtn: TBitBtn;
ResetBtn: TButton;
CancelBtn: TButton;
OKBtn: TButton;
CheckGroup1: TCheckGroup;
DepVar: TEdit;
AvailLabel: TLabel;
AnalLabel: TLabel;
SelLabel: TLabel;
ListBox1: TListBox;
VarList: TListBox;
procedure CancelBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure InBtnClick(Sender: TObject);
procedure OKBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure SelVarInBtnClick(Sender: TObject);
procedure SelVarOutBtnClick(Sender: TObject);
private
{ private declarations }
{ Private declarations }
Minimum, Maximum, levels, displace, subscript : IntDyneVec;
Freq : IntDyneVec;
Selected : IntDyneVec;
mean, variance, Stddev, SS : DblDyneVec;
index, NoSelected, ListSize, Dependentvar, X, length_array : integer;
ptr1, ptr2, sum, grandsum : integer;
xsumtotal, xsqrtotal, grandsumx, grandsumx2, value, SD : double;
SST, SSW, SSB, MSW, MSB, F, FProb, DF1, DF2 : double;
cellstring : string;
outline : string;
valstr : string;
dataread : boolean;
function Index_Pos(VAR X1 : IntDyneVec;
VAR displace1 : IntDyneVec;
ListSize1 : integer;
Sender: TObject) : integer;
public
{ public declarations }
end;
var
BreakDownFrm: TBreakDownFrm;
implementation
{ TBreakDownFrm }
procedure TBreakDownFrm.ResetBtnClick(Sender: TObject);
var
i : integer;
begin
VarList.Clear;
ListBox1.Clear;
DepVar.Text := '';
InBtn.Visible := true;
OutBtn.Visible := false;
SelVarInBtn.Visible := true;
SelVarOutBtn.Visible := false;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TBreakDownFrm.SelVarInBtnClick(Sender: TObject);
var
index1 : integer;
begin
index1 := VarList.ItemIndex;
DepVar.Text := VarList.Items.Strings[index1];
SelVarInBtn.Visible := false;
SelVarOutBtn.Visible := true;
end;
procedure TBreakDownFrm.SelVarOutBtnClick(Sender: TObject);
begin
VarList.Items.Add(DepVar.Text);
SelVarOutBtn.Visible := false;
SelVarInBtn.Visible := true;
end;
procedure TBreakDownFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TBreakDownFrm.HelpBtnClick(Sender: TObject);
begin
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TBreakDownFrm.CancelBtnClick(Sender: TObject);
begin
BreakDownFrm.Hide;
end;
procedure TBreakDownFrm.InBtnClick(Sender: TObject);
var
index1, i : integer;
begin
index1 := VarList.Items.Count;
i := 0;
while i < index1 do
begin
if (VarList.Selected[i]) then
begin
ListBox1.Items.Add(VarList.Items.Strings[i]);
VarList.Items.Delete(i);
index1 := index1 - 1;
i := 0;
end
else i := i + 1;
end;
OutBtn.Visible := true;
if VarList.Items.Count = 0 then InBtn.Visible := false;
end;
procedure TBreakDownFrm.OKBtnClick(Sender: TObject);
label Label1, Label3, Label4, NextStep, FirstOne, SecondOne, ThirdOne, LastStep;
var
i, j : integer;
tempval : string;
begin
// Identify columns of variables to analyze and the dependent var.
NoSelected := ListBox1.Items.Count;
// Get column no. of dependent variable
cellstring := DepVar.Text;
for i := 1 to NoVariables do
if cellstring = OS3MainFrm.DataGrid.Cells[i,0] then dependentvar := i;
// Allocate heap
SetLength(Minimum,NoVariables);
SetLength(Maximum,NoVariables);
SetLength(levels,NoVariables);
SetLength(displace,NoVariables);
SetLength(subscript,NoVariables);
SetLength(Selected,NoVariables);
// Get selected variables
for i := 1 to NoSelected do
begin
cellstring := ListBox1.Items.Strings[i-1];
for j := 1 to NoVariables do
if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then Selected[i-1] := j;
end;
Selected[NoSelected] := dependentvar;
ListSize := NoSelected;
// Get maximum and minimum levels in each variable
for i := 1 to ListSize do
begin
index := Selected[i-1];
Minimum[i-1] := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index,1]));
Maximum[i-1] := Minimum[i-1];
for j := 1 to NoCases do
begin
if GoodRecord(j,NoSelected,Selected) then
begin
X := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index,j]));
if X < Minimum[i-1] then Minimum[i-1] := X;
if X > Maximum[i-1] then Maximum[i-1] := X;
end;
end;
end;
// Calculate number of levels for each variable
for i := 1 to ListSize do
levels[i-1] := Maximum[i-1] - Minimum[i-1] + 1;
displace[ListSize-1] := 1;
if ListSize > 1 then
begin
for i := ListSize-1 downto 1 do
displace[i-1] := levels[i] * displace[i];
end;
// Now, tabulate
length_array := 1;
for i := 1 to ListSize do length_array := Length_array * levels[i-1];
// initialize values
SetLength(Freq,length_array+1);
SetLength(mean,length_array+1);
SetLength(variance,length_array+1);
SetLength(Stddev,length_array+1);
SetLength(SS,length_array+1);
for i := 0 to length_array do
begin
Freq[i] := 0;
mean[i] := 0.0;
variance[i] := 0.0;
Stddev[i] := 0.0;
SS[i] := 0.0;
end;
// tabulate
for i := 1 to NoCases do
begin
dataread := false;
if GoodRecord(i,NoSelected,Selected) then
begin
for j := 1 to ListSize do
begin
index := Selected[j-1];
X := round(StrToFLoat(OS3MainFrm.DataGrid.Cells[index,i]));
X := X - Minimum[j-1] + 1;
subscript[j-1] := X;
dataread := true;
end;
end;
if dataread then
begin
j := Index_Pos(subscript,displace,ListSize, self);
Freq[j] := Freq[j] + 1;
index := dependentvar;
tempval := Trim(OS3MainFrm.DataGrid.Cells[index,i]);
if tempval <> '' then
begin
value := StrToFloat(tempval);
mean[j] := mean[j] + value;
variance[j] := variance[j] + (value * value);
end;
end;
end;
// setup the output
OutPutFrm.RichEdit.Clear;
// OutPutFrm.RichEdit.ParaGraph.Alignment := taLeftJustify;
OutPutFrm.RichEdit.Lines.Add('BREAKDOWN ANALYSIS PROGRAM');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('VARIABLE SEQUENCE FOR THE BREAKDOWN:');
for i := 1 to ListSize do
begin
index := Selected[i-1];
outline := format('%-10s (Variable %3d) Lowest level = %2d Highest level = %2d',
[OS3MainFrm.DataGrid.Cells[index,0],i, Minimum[i-1], Maximum[i-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
//OutPutFrm.ShowModal;
// Breakdown the data
ptr1 := ListSize - 1;
ptr2 := ListSize;
for i := 1 to ListSize do subscript[i-1] := 1;
sum := 0;
xsumtotal := 0.0;
xsqrtotal := 0.0;
grandsum := 0;
grandsumx := 0.0;
grandsumx2 := 0.0;
Label1:
index := Index_Pos(subscript,displace,ListSize,self);
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Variable levels: ');
for i := 1 to ListSize do
begin
j := Selected[i-1];
outline := format('%-10s level = %3d',
[OS3MainFrm.DataGrid.Cells[j,0],
Minimum[i-1] + subscript[i-1] - 1]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
sum := sum + Freq[index];
xsumtotal := xsumtotal + mean[index];
xsqrtotal := xsqrtotal + variance[index];
OutPutFrm.RichEdit.Lines.Add('Freq. Mean Std. Dev.');
outline := format('%3d',[Freq[index]]);
if Freq[index] > 0 then
begin
valstr := format(' %8.3f ',[mean[index] / Freq[index]]);
outline := outline + valstr;
end
else outline := outline +' ******** ';
if Freq[index] > 1 then
begin
SS[index] := variance[index];
variance[index] := variance[index] - (mean[index] * mean[index] / Freq[index]);
variance[index] := variance[index] / (Freq[index] - 1);
Stddev[index] := sqrt(variance[index]);
valstr := format('%8.3f ',[Stddev[index]]);
outline := outline + valstr;
end
else outline := outline + '********';
OutPutFrm.RichEdit.Lines.Add(outline);
subscript[ptr2-1] := subscript[ptr2-1] + 1;
if subscript[ptr2-1] <= levels[ptr2-1] then goto Label1;
outline := format('Number of observations accross levels = %3d',[sum]);
OutPutFrm.RichEdit.Lines.Add(outline);
if sum > 0 then
begin
outline := format('Mean accross levels = %8.3f',[ xsumtotal / sum]);
OutPutFrm.RichEdit.Lines.Add(outline);
end
else OutPutFrm.RichEdit.Lines.Add('Mean accross levels = ********');
if sum > 1 then
begin
SD := sqrt( (xsqrtotal - (xsumtotal * xsumtotal) / sum) / (sum - 1));
outline := format('Std. Dev. accross levels = %8.3f',[SD]);
OutPutFrm.RichEdit.Lines.Add(outline);
end
else OutPutFrm.RichEdit.Lines.Add('Std. Dev. accross levels = *******');
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
grandsum := grandsum + sum;
grandsumx := grandsumx + xsumtotal;
grandsumx2 := grandsumx2 + xsqrtotal;
sum := 0;
xsumtotal := 0.0;
xsqrtotal := 0.0;
if ptr1 < 1 then goto NextStep;
subscript[ptr1-1] :=subscript[ptr1-1] + 1;
if subscript[ptr1-1] <= levels[ptr1-1] then goto Label4;
Label3:
ptr1 := ptr1 - 1;
if ptr1 < 1 then goto NextStep;
if subscript[ptr1-1] > levels[ptr1-1] then goto Label3;
subscript[ptr1-1] := subscript[ptr1-1] + 1;
if subscript[ptr1-1] > levels[ptr1-1] then goto Label3;
Label4:
for i := ptr1+1 to ListSize do subscript[i-1] := 1;
ptr1 := ListSize - 1;
if ptr1 < 1 then goto NextStep;
goto Label1;
NextStep:
outline := format('Grand number of observations accross all categories = %3d',
[grandsum]);
OutPutFrm.RichEdit.Lines.Add(outline);
if grandsum > 0 then
begin
outline := format('Overall Mean = %8.3f',[grandsumx / grandsum]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
if grandsum > 1 then
begin
SD := sqrt((grandsumx2 - (grandsumx * grandsumx) / grandsum) / (grandsum - 1));
outline := format('Overall standard deviation = %8.3f',[SD]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
// Do ANOVA's if requested
if CheckGroup1.CheckEnabled[0] then
begin
OutPutFrm.RichEdit.Lines.Add('ANALYSES OF VARIANCE SUMMARY TABLES');
OutPutFrm.RichEdit.Lines.Add('');
ptr1 := ListSize - 1;
ptr2 := ListSize;
for i := 1 to ListSize do subscript[i-1] := 1;
SSB := 0.0;
SSW := 0.0;
MSB := 0.0;
MSW := 0.0;
grandsum := 0;
grandsumx := 0.0;
grandsumx2 := 0.0;
DF1 := 0.0;
DF2 := 0.0;
FirstOne:
index := Index_Pos(subscript,displace,ListSize, self);
if Freq[index] > 0 then
begin
OutPutFrm.RichEdit.Lines.Add('Variable levels: ');
for i := 1 to ListSize do
begin
j := Selected[i-1];
outline := format('%-10s level = %3d',
[OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
// build sumsof squares for this set
DF1 := DF1 + 1;
DF2 := DF2 + Freq[index] - 1;
grandsum := grandsum + Freq[index];
grandsumx := grandsumx + mean[index];
grandsumx2 := grandsumx2 + SS[index];
SSW := SSW + SS[index] - (mean[index] * mean[index] / Freq[index]);
end;
subscript[ptr2-1] := subscript[ptr2-1] + 1;
if subscript[ptr2-1] <= levels[ptr2-1] then goto FirstOne;
if ((grandsum > 0.0) and (DF1 > 1) and (DF2 > 1) and (SSW > 0.0)) then
begin
// build and show anova table
SST := grandsumx2 - (grandsumx * grandsumx / grandsum);
SSB := SST - SSW;
DF1 := DF1 - 1.0; // no. of groups - 1
MSB := SSB / DF1;
MSW := SSW / DF2;
F := MSB / MSW;
FProb := probf(DF1,DF2,F);
OutPutFrm.RichEdit.Lines.Add('SOURCE D.F. SS MS F Prob.>F');
outline := format('GROUPS %2.0f %8.2f %8.2f %8.3f %6.4f',
[DF1,SSB,MSB,F,FProb]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('WITHIN %2.0f %8.2f %8.2f',
[DF2,SSW,MSW]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('TOTAL %2d %8.2f',[grandsum-1,SST]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end
else begin
OutPutFrm.RichEdit.Lines.Add('Insufficient data for ANOVA');
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
end;
SSB := 0.0;
SSW := 0.0;
MSB := 0.0;
MSW := 0.0;
grandsum := 0;
grandsumx := 0.0;
grandsumx2 := 0.0;
DF1 := 0.0;
DF2 := 0.0;
if ptr1 < 1 then goto LastStep;
subscript[ptr1-1] := subscript[ptr1-1] + 1;
if subscript[ptr1-1] <= levels[ptr1-1] then goto ThirdOne;
SecondOne:
ptr1 := ptr1 - 1;
if ptr1 < 1 then goto LastStep;
if subscript[ptr1-1] > levels[ptr1-1] then goto SecondOne;
subscript[ptr1-1] := subscript[ptr1-1] + 1;
if subscript[ptr1-1] > levels[ptr1-1] then goto SecondOne;
ThirdOne:
for i := ptr1+1 to ListSize do subscript[i-1] := 1;
ptr1 := ListSize - 1;
if ptr1 < 1 then goto LastStep;
goto FirstOne;
LastStep:
// do anova for all cells
OutPutFrm.RichEdit.Lines.Add('ANOVA FOR ALL CELLS');
OutPutFrm.RichEdit.Lines.Add('');
SST := 0.0;
SSW := 0.0;
DF2 := 0.0;
DF1 := 0.0;
grandsumx := 0.0;
grandsum := 0;
for i := 1 to length_array do
begin
if Freq[i] > 0 then
begin
SST := SST + SS[i];
grandsum := grandsum + Freq[i];
grandsumx := grandsumx + mean[i];
SSW := SSW + (SS[i] - (mean[i] * mean[i] / Freq[i]));
DF1 := DF1 + 1.0;
DF2 := DF2 + (Freq[i] - 1);
end;
end;
if ( (DF1 > 1.0) and (DF2 > 1.0) and (SSW > 0.0)) then
begin
SST := SST - (grandsumx * grandsumx / grandsum);
SSB := SST - SSW;
DF1 := DF1 - 1;
MSB := SSB / DF1;
MSW := SSW / DF2;
F := MSB / MSW;
FProb := probf(DF1, DF2, F);
OutPutFrm.RichEdit.Lines.Add('SOURCE D.F. SS MS F Prob.>F');
outline := format('GROUPS %2.0f %8.2f %8.2f %8.3f %6.4f',
[DF1,SSB,MSB,F,FProb]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('WITHIN %2.0f %8.2f %8.2f',
[DF2,SSW,MSW]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('TOTAL %2d %8.2f',[grandsum-1,SST]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('FINISHED');
OutPutFrm.ShowModal;
end
else
begin
OutPutFrm.RichEdit.Lines.Add('Only 1 group. No ANOVA possible.');
OutPutFrm.ShowModal;
end;
end;
SS := nil;
Stddev := nil;
variance := nil;
mean := nil;
Freq := nil;
selected := nil;
subscript := nil;
displace := nil;
levels := nil;
Maximum := nil;
Minimum := nil;
BreakDownFrm.Hide;
end;
procedure TBreakDownFrm.OutBtnClick(Sender: TObject);
var
index1: integer;
begin
index1 := ListBox1.ItemIndex;
VarList.Items.Add(ListBox1.Items.Strings[index1]);
ListBox1.Items.Delete(index1);
InBtn.Visible := true;
if ListBox1.Items.Count = 0 then OutBtn.Visible := false;
end;
function TBreakDownFrm.Index_Pos(var X1: IntDyneVec; var displace1: IntDyneVec;
ListSize1: integer; Sender: TObject): integer;
var
index1, i : integer;
begin
index1 := X1[ListSize-1];
for i := 1 to ListSize - 1 do
index1 := index1 + ((X1[i-1] - 1) * displace[i-1]);
Result := index1;
end;
initialization
{$I breakdownunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink