pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
0b891471b9ce34dce3d37772ecee29b51f3e3459
lazarus-ccr/applications/lazstats/source/forms/analysis/comparisons/bnestaunit.pas
wp_xxyyzz 481f65a802 LazStats: Simplify enabled arrows in some forms. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7361 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-04-07 17:02:02 +00:00

593 lines
16 KiB
ObjectPascal
Raw Blame History

unit BNestAUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls,
MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals;
type
{ TBNestedAForm }
TBNestedAForm = class(TForm)
ACodes: TEdit;
AInBtn: TBitBtn;
AOutBtn: TBitBtn;
BCodes: TEdit;
Bevel1: TBevel;
BInBtn: TBitBtn;
BOutBtn: TBitBtn;
Memo1: TLabel;
RandomBChk: TCheckBox;
DepInBtn: TBitBtn;
ComputeBtn: TButton;
DepOutBtn: TBitBtn;
DepEdit: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
OptionsBox: TRadioGroup;
ResetBtn: TButton;
CloseBtn: TButton;
VarList: TListBox;
procedure AInBtnClick(Sender: TObject);
procedure AOutBtnClick(Sender: TObject);
procedure BInBtnClick(Sender: TObject);
procedure BOutBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure DepInBtnClick(Sender: TObject);
procedure DepOutBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
private
{ private declarations }
FAutoSized: Boolean;
SS, SumSqr, CellMeans, CellSDs : DblDyneMat;
CellCount : IntDyneMat;
ASS, BSS, ASumSqr, BSumSqr, AMeans, BMeans, ASDs : DblDyneVec;
ACount, BCount : IntDyneVec;
MinA, MinB, MaxA, MaxB, NoALevels, NoBLevels, ACol, BCol, YCol : integer;
DepVar, FactorA, FactorB : string;
SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double;
TotN, dfA, dfBwA, dfwcell, dftotal : integer;
function GetVars: Boolean;
procedure GetMemory;
procedure GetSums;
procedure ShowMeans(AReport: TStrings);
procedure GetResults;
procedure ShowResults(AReport: TStrings);
procedure ReleaseMemory;
procedure TwoWayPlot;
procedure UpdateBtnStates;
public
{ public declarations }
end;
var
BNestedAForm: TBNestedAForm;
implementation
uses
Math, Utils;
{ TBNestedAForm }
procedure TBNestedAForm.ResetBtnClick(Sender: TObject);
var
i: integer;
begin
VarList.Items.Clear;
ACodes.Text := '';
BCodes.Text := '';
DepEdit.Text := '';
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TBNestedAForm.AInBtnClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (ACodes.Text = '') then
begin
ACodes.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TBNestedAForm.AOutBtnClick(Sender: TObject);
begin
if ACodes.Text <> '' then
begin
VarList.Items.Add(ACodes.Text);
ACodes.Text := '';
end;
UpdateBtnStates;
end;
procedure TBNestedAForm.BInBtnClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (BCodes.Text = '') then
begin
BCodes.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TBNestedAForm.BOutBtnClick(Sender: TObject);
begin
if BCodes.Text <> '' then
begin
VarList.Items.Add(BCodes.Text);
BCodes.Text := '';
end;
UpdateBtnStates;
end;
procedure TBNestedAForm.ComputeBtnClick(Sender: TObject);
var
lReport: TStrings;
begin
lReport := TStringList.Create;
try
if GetVars then
begin
GetMemory;
GetSums;
ShowMeans(lReport);
GetResults;
ShowResults(lReport);
DisplayReport(lReport);
TwoWayPlot;
ReleaseMemory;
end;
finally
lReport.Free;
end;
end;
procedure TBNestedAForm.DepInBtnClick(Sender: TObject);
var
index: integer;
begin
index := VarList.ItemIndex;
if (index > -1) and (DepEdit.Text = '') then
begin
DepEdit.Text := VarList.Items[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end;
procedure TBNestedAForm.DepOutBtnClick(Sender: TObject);
begin
if DepEdit.Text <> '' then
begin
VarList.Items.Add(DepEdit.Text);
DepEdit.Text := '';
end;
UpdateBtnStates;
end;
procedure TBNestedAForm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
VarList.Constraints.MinHeight := DepOutBtn.Top + DepOutBtn.Height - VarList.Top;
Constraints.MinHeight := Height;
Constraints.MinWidth := Width;
FAutoSized := true;
end;
procedure TBNestedAForm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if GraphFrm = nil then
Application.CreateForm(TGraphFrm, GraphFrm);
end;
function TBNestedAForm.GetVars: Boolean;
var
i, group : integer;
strvalue, cellstring : string;
begin
Result := false;
DepVar := DepEdit.Text;
FactorA := ACodes.Text;
FactorB := BCodes.Text;
ACol := 0;
BCol := 0;
YCol := 0;
MinA := 1000;
MaxA := -1000;
MinB := 1000;
MaxB := -1000;
for i := 1 to NoVariables do
begin
strvalue := Trim(OS3MainFrm.DataGrid.Cells[i,0]);
if FactorA = strvalue then ACol := i;
if FactorB = strvalue then BCol := i;
if DepVar = strvalue then YCol := i;
end;
if (ACol = 0) or (BCol = 0) or (YCol = 0) then
begin
MessageDlg('Select a variable for each entry box.', mtError, [mbOK], 0);
exit;
end;
// get number of levels for Factors
for i := 1 to NoCases do
begin
cellstring := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]);
group := round(StrToFloat(cellstring));
if (group > MaxA) then MaxA := group;
if (group < MinA) then MinA := group;
cellstring := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]);
group := round(StrToFLoat(cellstring));
if (group > MaxB) then MaxB := group;
if (group < MinB) then MinB := group;
end;
NoALevels := MaxA - MinA + 1;
NoBLevels := MaxB - MinB + 1;
Result := true;
end;
procedure TBNestedAForm.GetMemory;
begin
SetLength(SS,NoBLevels,NoALevels);
SetLength(SumSqr,NoBLevels,NoALevels);
SetLength(CellCount,NoBLevels,NoALevels);
SetLength(CellMeans,NoBLevels,NoALevels);
SetLength(CellSDs,NoBLevels,NoALevels);
SetLength(ASS,NoALevels);
SetLength(BSS,NoBLevels);
SetLength(ASumSqr,NoALevels);
SetLength(BSumSqr,NoBLevels);
SetLength(AMeans,NoALevels);
SetLength(BMeans,NoBLevels);
SetLength(ACount,NoALevels);
SetLength(BCount,NoBLevels);
SetLength(ASDs,NoALevels);
end;
procedure TBNestedAForm.GetSums;
VAR
Aindex, Bindex, i, j : integer;
YValue : double;
strvalue : string;
begin
// initialize memory
for i := 0 to NoBLevels-1 do
begin
for j := 0 to NoALevels-1 do
begin
SS[i,j] := 0.0;
SumSqr[i,j] := 0.0;
CellCount[i,j] := 0;
end;
end;
for i := 0 to NoALevels-1 do
begin
ACount[i] := 0;
AMeans[i] := 0.0;
ASS[i] := 0.0;
ASumSqr[i] := 0.0;
end;
for j := 0 to NoBLevels-1 do
begin
BCount[i] := 0;
BMeans[i] := 0.0;
BSS[i] := 0.0;
BSumSqr[i] := 0.0;
end;
// Accumulate sums and sums of squared values
for i := 1 to NoCases do
begin
strvalue := Trim(OS3MainFrm.DataGrid.Cells[ACol,i]);
Aindex := round(StrToFloat(strvalue));
strvalue := Trim(OS3MainFrm.DataGrid.Cells[BCol,i]);
Bindex := round(StrToFloat(strvalue));
strvalue := Trim(OS3MainFrm.DataGrid.Cells[YCol,i]);
YValue := StrToFloat(strvalue);
Aindex := Aindex - MinA;
Bindex := Bindex - MinB;
SS[Bindex,Aindex] := SS[Bindex,Aindex] + YValue * YValue;
SumSqr[Bindex,Aindex] := SumSqr[Bindex,Aindex] + YValue;
CellCount[Bindex,Aindex] := CellCount[Bindex,Aindex] + 1;
ACount[Aindex] := ACount[Aindex] + 1;
BCount[Bindex] := BCount[Bindex] + 1;
ASS[Aindex] := ASS[Aindex] + YValue * YValue;
BSS[Bindex] := BSS[Bindex] + YValue * YValue;
ASumSqr[Aindex] := ASumSqr[Aindex] + YValue;
BSumSqr[Bindex] := BSumSqr[Bindex] + YValue;
SSTot := SSTot + YValue * YValue;
SumSqrTot := SumSqrTot + YValue;
TotN := TotN + 1;
end;
//get cell means and marginal means, SDs plus square of sums
for i := 0 to NoBlevels-1 do
begin
for j := 0 to NoALevels-1 do
begin
if CellCount[i,j] > 0 then
begin
CellMeans[i,j] := SumSqr[i,j] / CellCount[i,j];
SumSqr[i,j] := SumSqr[i,j] * SumSqr[i,j];
CellSDs[i,j] := SS[i,j] - (SumSqr[i,j] / CellCount[i,j]);
CellSDs[i,j] := CellSDs[i,j] / (CellCount[i,j] - 1);
CellSDs[i,j] := Sqrt(CellSDs[i,j]);
end;
end;
end;
for i := 0 to NoBLevels-1 do
begin
BMeans[i] := BSumSqr[i] / BCount[i];
BSumSqr[i] := BSumSqr[i] * BSumSqr[i];
end;
for i := 0 to NoALevels-1 do
begin
AMeans[i] := ASumSqr[i] / ACount[i];
ASumSqr[i] := ASumSqr[i] * ASumSqr[i];
ASDs[i] := ASS[i] - (ASumSqr[i] / ACount[i]);
ASDs[i] := ASDs[i] / (ACount[i] - 1);
ASDs[i] := Sqrt(ASDs[i]);
end;
TotMean := SumSqrTot / TotN;
SumSqrTot := SumSqrTot * SumSqrTot;
end;
procedure TBNestedAForm.ShowMeans(AReport: TStrings);
var
i, j: integer;
begin
AReport.Add('NESTED ANOVA by Bill Miller');
AReport.Add('');
AReport.Add('File Analyzed: %s', [OS3MainFrm.FileNameEdit.Text]);
AReport.Add('');
AReport.Add('CELL MEANS');
AReport.Add('A LEVEL BLEVEL MEAN STD.DEV.');
for i := 0 to NoALevels-1 do
for j := 0 to NoBLevels-1 do
if CellCount[j,i] > 0 then
AReport.Add('%5d %5d %10.3f %10.3f', [i+MinA, j+MinB, CellMeans[j,i], CellSDs[j,i]]);
AReport.Add('');
AReport.Add('A MARGIN MEANS');
AReport.Add('A LEVEL MEAN STD.DEV.');
for i := 0 to NoALevels-1 do
AReport.Add('%5d %10.3f %10.3f', [i+MinA, AMeans[i], ASDs[i]]);
AReport.Add('');
AReport.Add('GRAND MEAN: %0.3f', [TotMean]);
AReport.Add('');
AReport.Add('');
end;
procedure TBNestedAForm.GetResults;
VAR
temp, constant : double;
NoBLevelsInA, BLevCount, i, j, celln : integer;
begin
celln := 0;
for i := 0 to NoALevels-1 do
begin
for j := 0 to NoBLevels-1 do
begin
if CellCount[j,i] > celln then celln := CellCount[j,i];
end;
end;
// assume all cells have same n size
// get no. of levels in A
BLevCount := 0;
for i := 0 to NoALevels-1 do
begin
NoBLevelsInA := 0;
for j := 0 to NoBLevels-1 do
begin
if CellCount[j,i] > 0 then NoBLevelsInA := NoBLevelsInA + 1;
end;
if NoBLevelsInA > BLevCount then BLevCount := NoBLevelsInA;
end;
dfA := NoALevels - 1;
dfBwA := NoALevels * (BLevCount - 1);
dfwcell := NoALevels * BLevCount * (celln - 1);
dftotal := TotN - 1;
constant := SumSqrTot / TotN;
SSTot := SSTot - constant;
MSTot := SSTot / dftotal;
SSA := 0.0;
for i := 0 to NoALevels-1 do SSA := SSA + (ASumSqr[i] / ACount[i]);
temp := SSA;
SSA := SSA - constant;
MSA := SSA / dfA;
SSB := 0.0;
for i := 0 to NoALevels - 1 do
begin
for j := 0 to NoBLevels-1 do
begin
if CellCount[j,i] > 0 then SSB := SSB + (SumSqr[j,i] / CellCount[j,i]);
end;
end;
SSB := SSB - temp;
MSB := SSB / dfBwA;
SSW := SSTot - SSA - SSB;
MSW := SSW / dfwcell;
(*
OutputFrm.RichEdit.Clear;
strvalue := format('SSA = %10.3f MSA = %10.3f SSB = %10.3f MSB = %10.3f',
[SSA,MSA,SSB,MSB]);
OutputFrm.RichEdit.Lines.Add(strvalue);
strvalue := format('SSW = %10.3f MSW = %10.3f',[SSW,MSW]);
OutputFrm.RichEdit.Lines.Add(strvalue);
OutputFrm.ShowModal;
*)
end;
procedure TBNestedAForm.ShowResults(AReport: TStrings);
var
F, PF: double;
begin
AReport.Add('ANOVA TABLE');
AReport.Add('SOURCE D.F. SS MS F PROB.');
if RandomBChk.Checked then
begin
F := MSA / MSB;
PF := probf(F, dfA, dfBwA);
end else
begin
F := MSA / MSW;
PF := probf(F, dfA, dfwcell);
end;
AReport.Add('A %4d %10.3f%10.3f%10.3f%10.3f', [dfA, SSA, MSA, F, PF]);
F := MSB / MSW;
PF := probf(F,dfBwA,dfwcell);
AReport.Add('B(W) %4d %10.3f%10.3f%10.3f%10.3f', [dfBwA, SSB, MSB, F, PF]);
AReport.Add('w.cells %4d %10.3f%10.3f', [dfwcell, SSW, MSW]);
AReport.Add('Total %4d %10.3f', [dftotal, SSTot]);
end;
procedure TBNestedAForm.ReleaseMemory;
begin
ASDs := nil;
BCount := nil;
ACount := nil;
BMeans := nil;
AMeans := nil;
BSumSqr := nil;
ASumSqr := nil;
BSS := nil;
ASS := nil;
CellSDs := nil;
CellMeans := nil;
CellCount := nil;
SumSqr := nil;
SS := nil;
end;
procedure TBNestedAForm.TwoWayPlot;
VAR
plottype, i: integer;
maxmean: double;
XValue : DblDyneVec;
begin
case OptionsBox.ItemIndex of
0: plotType := 9;
1: plotType := 10;
2: plotType := 1;
3: plotType := 2;
else raise Exception.Create('Plot type not supported.');
end;
GraphFrm.SetLabels[1] := 'FACTOR A';
maxmean := -1000.0;
SetLength(XValue,NoALevels+NoBLevels);
SetLength(GraphFrm.Xpoints,1,NoALevels);
SetLength(GraphFrm.Ypoints,1,NoALevels);
for i := 1 to NoALevels do
begin
GraphFrm.Ypoints[0,i-1] := AMeans[i-1];
if AMeans[i-1] > maxmean then maxmean := AMeans[i-1];
XValue[i-1] := MinA + i -1;
GraphFrm.Xpoints[0,i-1] := XValue[i-1];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := NoALevels;
GraphFrm.Heading := FactorA;
GraphFrm.XTitle := FactorA + ' Group Codes';
GraphFrm.YTitle := 'Mean';
GraphFrm.barwideprop := 0.5;
GraphFrm.AutoScaled := false;
GraphFrm.miny := 0.0;
GraphFrm.maxy := maxmean;
GraphFrm.GraphType := plottype;
GraphFrm.BackColor := clCream;
GraphFrm.WallColor := clDkGray;
GraphFrm.FloorColor := clLtGray;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
// Factor B next
maxmean := 0.0;
GraphFrm.SetLabels[1] := 'FACTOR B';
SetLength(GraphFrm.Xpoints,1,NoBLevels);
SetLength(GraphFrm.Ypoints,1,NoBLevels);
for i := 1 to NoBLevels do
begin
GraphFrm.Ypoints[0,i-1] := BMeans[i-1];
if BMeans[i-1] > maxmean then maxmean := BMeans[i-1];
XValue[i-1] := MinB + i - 1;
GraphFrm.Xpoints[0,i-1] := XValue[i-1];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := NoBLevels;
GraphFrm.Heading := 'FACTOR B';
GraphFrm.XTitle := FactorB + ' Group Codes';
GraphFrm.YTitle := 'Mean';
GraphFrm.barwideprop := 0.5;
GraphFrm.AutoScaled := false;
GraphFrm.miny := 0.0;
GraphFrm.maxy := maxmean;
GraphFrm.GraphType := plottype;
GraphFrm.BackColor := clCream;
GraphFrm.WallColor := clDkGray;
GraphFrm.FloorColor := clLtGray;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
XValue := nil;
end;
procedure TBNestedAForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TBNestedAForm.UpdateBtnStates;
var
lSelected: Boolean;
begin
lSelected := AnySelected(VarList);
AInBtn.Enabled := lSelected and (ACodes.Text = '');
BInBtn.Enabled := lSelected and (BCodes.Text = '');
DepInBtn.Enabled := lSelected and (DepEdit.Text = '');
AOutBtn.Enabled := (ACodes.Text <> '');
BOutBtn.Enabled := (BCodes.Text <> '');
DepOutBtn.Enabled := (DepEdit.Text <> '');
end;
initialization
{$I bnestaunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink