pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
04db6bd5ee10368344ed89eb874aa1f90fda16b0
lazarus-ccr/applications/lazstats/source/forms/analysis/descriptive/breakdownunit.pas
wp_xxyyzz feed93c12b LazStats: Add OnDblClick handlers for listboxes in BreakdownUnit. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7719 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-09-29 10:55:15 +00:00

818 lines
20 KiB
ObjectPascal
Raw Blame History

// Use "twoway.laz" for testing
unit BreakDownUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, ComCtrls,
MainUnit, Globals, FunctionsLib, DataProcs, ContextHelpUnit,
BasicStatsFormUnit, ReportFrameUnit;
type
{ TBreakDownFrm }
TBreakDownFrm = class(TBasicStatsForm)
Bevel1: TBevel;
ComputeBtn: TButton;
HelpBtn: TButton;
InBtn: TBitBtn;
OutBtn: TBitBtn;
PageControl1: TPageControl;
ParamsPanel: TPanel;
SelVarInBtn: TBitBtn;
SelVarOutBtn: TBitBtn;
ResetBtn: TButton;
CloseBtn: TButton;
CheckGroup1: TCheckGroup;
DepVar: TEdit;
AvailLabel: TLabel;
AnalLabel: TLabel;
SelLabel: TLabel;
SelList: TListBox;
ParamsSplitter: TSplitter;
BreakDownPage: TTabSheet;
AnovaPage: TTabSheet;
VarList: TListBox;
procedure CloseBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure InBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure SelListDblClick(Sender: TObject);
procedure SelListSelectionChange(Sender: TObject; User: boolean);
procedure SelVarInBtnClick(Sender: TObject);
procedure SelVarOutBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private
{ private declarations }
FBreakdownReportFrame: TReportFrame;
FANOVAReportFrame: TReportFrame;
FAutoSized: Boolean;
procedure ANOVA(ListSize: Integer; Freq, Selected, Minimum, Subscript,
Levels, Displace: IntDyneVec; Mean, SS: DblDyneVec; AReport: TStrings);
procedure GetLevels(const AMinimum, AMaximum, ALevels, ADisplace: IntDyneVec);
procedure GetMinMax(const AMinimum, AMaximum, ASelected: IntDyneVec);
function Index_Pos(const X, ADisplace: IntDyneVec; AListSize: integer): Integer;
procedure UpdateBtnStates;
public
{ public declarations }
procedure Reset; override;
end;
var
BreakDownFrm: TBreakDownFrm;
implementation
{$R *.lfm}
uses
Math,
Utils, MathUnit;
{ TBreakDownFrm }
procedure TBreakDownFrm.ANOVA(ListSize: Integer; Freq, Selected, Minimum,
Subscript, Levels, Displace: IntDyneVec; Mean, SS: DblDyneVec; AReport: TStrings);
var
i, j: Integer;
ptr1, ptr2: Integer;
MSB, MSW, SSB, SST, SSW: Double;
grandSum: Integer;
grandSumX, grandSumX2: Double;
DF1, DF2: Double;
F, Fprob: Double;
index: Integer;
length_array: Integer;
begin
AnovaPage.Caption := 'Analysis of Variance';
AnovaPage.TabVisible := true;
AReport.Add('ANALYSES OF VARIANCE SUMMARY TABLES');
AReport.Add('');
length_array := Length(Freq) - 1; // freq is set by Setlength(freq, length_array+1);
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;
while true do
begin
index := Index_Pos(Subscript, Displace, ListSize);
if Freq[index] > 0 then
begin
AReport.Add('Variable levels: ');
for i := 1 to ListSize do
begin
j := Selected[i-1];
AReport.Add('%-10s level %d', [
OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1
]);
end;
AReport.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
Continue; // Return to start
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(F, DF1, DF2); // wp: was "probf(DF1,DF2,F)";
AReport.Add('SOURCE D.F. SS MS F Prob.>F');
AReport.Add('-------- ---- -------- -------- -------- --------');
AReport.Add('GROUPS %4.0f %8.2f %8.2f %8.3f %8.4f', [DF1, SSB, MSB, F, FProb]);
AReport.Add('WITHIN %4.0f %8.2f %8.2f', [DF2, SSW, MSW]);
AReport.Add('TOTAL %4d %8.2f', [grandsum-1, SST]);
end else
AReport.Add('Insufficient data for ANOVA');
AReport.Add('');
AReport.Add(DIVIDER_SMALL_AUTO);
AReport.Add('');
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
break;
subscript[ptr1-1] := subscript[ptr1-1] + 1;
if subscript[ptr1-1] > levels[ptr1-1] then
begin
repeat
dec(ptr1);
if ptr1 >= 1 then
begin
if subscript[ptr1-1] > levels[ptr1-1] then
continue;
inc(subscript[ptr1-1]);
if subscript[ptr1-1] <= levels[ptr1-1] then
break;
end;
until ptr1 < 1;
if ptr1 < 1 then
break;
end;
for i := ptr1+1 to ListSize do subscript[i-1] := 1;
ptr1 := ListSize - 1;
if ptr1 < 1 then
break;
end;
// Calculate ANOVA for all cells
AReport.Add('ANOVA FOR ALL CELLS');
AReport.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] - sqr(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 - sqr(grandsumx) / grandsum;
SSB := SST - SSW;
DF1 := DF1 - 1;
MSB := SSB / DF1;
MSW := SSW / DF2;
F := MSB / MSW;
FProb := ProbF(F, DF1, DF2); // wp: was "probf(DF1, DF2, F)"
AReport.Add('SOURCE D.F. SS MS F Prob.>F');
AReport.Add('-------- ---- -------- -------- -------- --------');
AReport.Add('GROUPS %4.0f %8.2f %8.2f %8.3f %8.4f', [DF1, SSB, MSB, F, FProb]);
AReport.Add('WITHIN %4.0f %8.2f %8.2f', [DF2, SSW, MSW]);
AReport.Add('TOTAL %4d %8.2f', [grandsum-1, SST]);
AReport.Add('');
AReport.Add('FINISHED');
end else
begin
AReport.Add('Only 1 group. No ANOVA possible.');
end;
end;
procedure TBreakDownFrm.CloseBtnClick(Sender: TObject);
begin
Close;
end;
procedure TBreakDownFrm.ComputeBtnClick(Sender: TObject);
label
Label1, Label3, Label4, NextStep;
var
index, ListSize, length_array : integer;
ptr1, ptr2, sum, grandsum : integer;
xsumtotal, xsqrtotal, grandsumx, grandsumx2, value, SD : double;
cellstring : string;
outline : string;
valstr : string;
dataread : boolean;
selected : IntDyneVec = nil;
freq: IntDyneVec = nil;
minimum: IntDyneVec = nil;
maximum: IntDyneVec = nil;
levels: IntDyneVec = nil;
displace: IntDyneVec = nil;
subscript: IntDyneVec = nil;
mean: DblDyneVec = nil;
variance: DblDyneVec = nil;
stddev: DblDyneVec = nil;
SS: DblDyneVec = nil;
X: Integer;
i, j: integer;
dependentVar, NoSelected: Integer;
tempval: string;
lReport: TStrings;
begin
// Identify columns of variables to analyze and the dependent var.
NoSelected := SelList.Items.Count;
if NoSelected = 0 then
begin
ErrorMsg('No variables selected.');
exit;
end;
// Get column no. of dependent variable
dependentVar := 0;
cellstring := DepVar.Text;
for i := 1 to NoVariables do
if cellstring = OS3MainFrm.DataGrid.Cells[i,0] then dependentvar := i;
if dependentVar = 0 then
begin
ErrorMsg('Continuous variable is not specified.');
exit;
end;
// Get selected variables
SetLength(selected, NoVariables);
for i := 1 to NoSelected do
begin
cellstring := SelList.Items[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
SetLength(minimum, ListSize);
SetLength(maximum, ListSize);
GetMinMax(minimum, maximum, selected);
// Calculate number of levels for each variable
SetLength(levels, ListSize);
SetLength(displace, ListSize);
GetLevels(minimum, maximum, levels, displace);
// Now, tabulate
length_array := 1;
for i := 0 to ListSize-1 do
length_array := Length_array * levels[i];
// 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
SetLength(subscript, ListSize);
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);
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] + sqr(value);
end;
end;
end;
// setup the output
lReport := TStringList.Create;
try
BreakdownPage.Caption := 'Breakdown Analysis';
lReport.Add('BREAKDOWN ANALYSIS PROGRAM');
lReport.Add('');
lReport.Add('VARIABLE SEQUENCE FOR THE BREAKDOWN:');
for i := 1 to ListSize do
begin
index := Selected[i-1];
lReport.Add('%-10s (Variable %3d) Lowest level: %2d Highest level: %2d', [
OS3MainFrm.DataGrid.Cells[index,0],i, Minimum[i-1], Maximum[i-1]
]);
end;
lReport.Add('');
// 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);
lReport.Add('Variable levels:');
for i := 1 to ListSize do
begin
j := Selected[i-1];
lReport.Add('%-10s level %3d', [
OS3MainFrm.DataGrid.Cells[j,0], Minimum[i-1] + subscript[i-1] - 1
]);
end;
lReport.Add('');
sum := sum + Freq[index];
xsumtotal := xsumtotal + mean[index];
xsqrtotal := xsqrtotal + variance[index];
lReport.Add(' Freq. Mean Std. Dev.');
lReport.Add('-------- -------- ---------');
// xxxxxxx xxxxxxxx xxxxxxxx
outline := Format('%7d', [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 + '********';
lReport.Add(outline);
lReport.Add('');
subscript[ptr2-1] := subscript[ptr2-1] + 1;
if subscript[ptr2-1] <= levels[ptr2-1] then goto Label1;
lReport.Add ('Number of observations across levels: %8d',[sum]);
if sum > 0 then
lReport.Add('Mean across levels: %8.3f',[ xsumtotal / sum])
else
lReport.Add('Mean across levels: ********');
if sum > 1 then
begin
SD := sqrt( (xsqrtotal - (xsumtotal * xsumtotal) / sum) / (sum - 1));
lReport.Add('Std. Dev. across levels: %8.3f', [SD]);
end else
lReport.Add('Std. Dev. across levels: ********');
lReport.Add('');
lReport.Add('===============================================================');
lReport.Add('');
//OutputFrm.ShowModal;
//OutputFrm.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:
lReport.Add ('Grand number of observations across all categories: %8d', [grandsum]);
if grandsum > 0 then
lReport.Add('Overall Mean: %8.3f', [grandsumx / grandsum]);
if grandsum > 1 then
begin
SD := sqrt((grandsumx2 - sqr(grandsumx) / grandsum) / (grandsum - 1));
lReport.Add('Overall Standard Deviation: %8.3f', [SD]);
end;
FBreakdownReportFrame.DisplayReport(lReport);
lReport.Clear;
// Do ANOVA's if requested
if CheckGroup1.Checked[0] then
begin
ANOVA(ListSize, Freq, Selected, Minimum, Subscript, Levels, Displace, Mean, SS, lReport);
// Show ANOVA in pagecontrol
FANovaReportFrame.DisplayReport(lReport);
end;
finally
lReport.Free;
end;
end;
procedure TBreakDownFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
ParamsPanel.Constraints.MinWidth := Max(
4*w + 3*CloseBtn.BorderSpacing.Left,
SelLabel.Width * 2 + InBtn.Width + VarList.BorderSpacing.Right * 2);
ParamsPanel.Constraints.MinHeight := InBtn.Top +
4*InBtn.Height + 3*OutBtn.BorderSpacing.Bottom +
CheckGroup1.BorderSpacing.Top + CheckGroup1.Height + Bevel1.Height +
CloseBtn.BorderSpacing.Top + CloseBtn.Height;
Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 300;
Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + ParamsPanel.BorderSpacing.Left*2;
if Width < Constraints.MinWidth then Width := 1; // enforce constraints
if Height < Constraints.MinHeight then Height := 1;
Position := poDesigned;
FAutoSized := true;
end;
procedure TBreakDownFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
InitForm(self);
FBreakDownReportFrame := TReportFrame.Create(self);
with FBreakdownReportFrame do
begin
Parent := BreakDownPage;
Align := alClient;
end;
FANOVAReportFrame := TReportFrame.Create(ANOVAPage);
with FANOVAReportFrame do
begin
Parent := ANOVAPage;
Align := alClient;
end;
Reset;
end;
procedure TBreakDownFrm.GetLevels(const AMinimum, AMaximum, ALevels, ADisplace: IntDyneVec);
var
i: Integer;
listSize: Integer;
begin
listSize := Length(AMaximum);
for i := 0 to listSize-1 do
ALevels[i] := AMaximum[i] - AMinimum[i] + 1;
ADisplace[listSize-1] := 1;
if listSize > 1 then
for i := listSize-1 downto 1 do
ADisplace[i-1] := ALevels[i] * ADisplace[i];
end;
procedure TBreakDownFrm.GetMinMax(const AMinimum, AMaximum, ASelected: IntDyneVec);
var
i, j, index: Integer;
listSize: Integer;
NoSelected: Integer;
X: Integer;
begin
NoSelected := SelList.Count;
listSize := Length(AMaximum);
for i := 0 to listSize-1 do
begin
index := ASelected[i];
AMinimum[i] := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index, 1]));
AMaximum[i] := AMinimum[i];
for j := 1 to NoCases do
begin
if GoodRecord(j, NoSelected, ASelected) then
begin
X := round(StrToFloat(OS3MainFrm.DataGrid.Cells[index, j]));
if X < AMinimum[i] then AMinimum[i] := X;
if X > AMaximum[i] then AMaximum[i] := X;
end;
end;
end;
end;
procedure TBreakDownFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
procedure TBreakDownFrm.InBtnClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while i < VarList.Items.Count do
begin
if (VarList.Selected[i]) then
begin
SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
i := 0;
end else
inc(i);
end;
UpdateBtnStates;
end;
function TBreakDownFrm.Index_Pos(const X, ADisplace: IntDyneVec;
AListSize: integer): integer;
var
i: integer;
begin
Result := X[AListSize-1];
for i := 1 to AListSize - 1 do
Result := Result + (X[i-1] - 1) * ADisplace[i-1];
end;
procedure TBreakDownFrm.OutBtnClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while i < SelList.Items.Count do
begin
if (SelList.Selected[i]) then
begin
VarList.Items.Add(SelList.Items[i]);
SelList.Items.Delete(i);
i := 0;
end else
inc(i);
end;
UpdateBtnStates;
end;
procedure TBreakDownFrm.Reset;
var
i: integer;
begin
VarList.Clear;
SelList.Clear;
DepVar.Text := '';
InBtn.Enabled := true;
OutBtn.Enabled := false;
SelVarInBtn.Enabled := true;
SelVarOutBtn.Enabled := false;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
FBreakdownReportFrame.Clear;
FAnovaReportFrame.Clear;
BreakdownPage.Caption := 'Report';
AnovaPage.TabVisible := false;
UpdateBtnStates;
end;
procedure TBreakDownFrm.ResetBtnClick(Sender: TObject);
begin
Reset;
end;
procedure TBreakDownFrm.SelListDblClick(Sender: TObject);
var
index: Integer;
begin
index := SelList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(SelList.Items[index]);
SelList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TBreakDownFrm.SelListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TBreakDownFrm.SelVarInBtnClick(Sender: TObject);
var
index : integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (DepVar.Text = '') then
begin
DepVar.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TBreakDownFrm.SelVarOutBtnClick(Sender: TObject);
begin
if DepVar.Text <> '' then
VarList.Items.Add(DepVar.Text);
UpdateBtnStates;
end;
procedure TBreakDownFrm.UpdateBtnStates;
var
lSelected: Boolean;
i: Integer;
begin
lSelected := false;
for i := 0 to VarList.Count-1 do
if VarList.Selected[i] then
begin
lSelected := true;
break;
end;
InBtn.Enabled := lSelected;
lSelected := false;
for i := 0 to SelList.Count-1 do
if SelList.Selected[i] then
begin
lSelected := true;
break;
end;
OutBtn.Enabled := lSelected;
SelVarInBtn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text = '');
SelVarOutBtn.Enabled := (DepVar.Text <> '');
FBreakdownReportFrame.UpdateBtnStates;
FAnovaReportFrame.UpdateBtnStates;
end;
procedure TBreakDownFrm.VarListDblClick(Sender: TObject);
var
index: Integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
SelList.Items.Add(VarList.Items[index]);
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TBreakDownFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
end.
Reference in New Issue View Git Blame Copy Permalink