LazStats: Some more refactoring in RMatUnits. Misc fixes and clean-up in other units.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7868 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-11-14 12:43:20 +00:00
parent e4817b7729
commit 03cc1dfcc0
10 changed files with 149 additions and 425 deletions

View File

@ -397,7 +397,7 @@
<Unit36> <Unit36>
<Filename Value="forms\analysis\correlation\rmatunit.pas"/> <Filename Value="forms\analysis\correlation\rmatunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="RMatFrm"/> <ComponentName Value="RMatForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="RMatUnit"/> <UnitName Value="RMatUnit"/>

View File

@ -1,7 +1,7 @@
inherited ABCNestedForm: TABCNestedForm inherited ABCNestedForm: TABCNestedForm
Left = 441 Left = 383
Height = 481 Height = 481
Top = 202 Top = 191
Width = 843 Width = 843
Caption = 'Three-Factor Nested ANOVA' Caption = 'Three-Factor Nested ANOVA'
ClientHeight = 481 ClientHeight = 481

View File

@ -7,20 +7,14 @@
unit ABCNestedUnit; unit ABCNestedUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{.$DEFINE SHOW_OLD_PLOTS}
interface interface
uses uses
Classes, SysUtils, FileUtil, TAStyles, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, TAStyles, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, ComCtrls, LCLVersion, StdCtrls, Buttons, ExtCtrls, ComCtrls, LCLVersion,
TACustomSeries, TACustomSeries,
{$IFDEF SHOW_OLD_PLOTS}
GraphLib,
{$ENDIF}
MainUnit, Globals, ReportFrameUnit, BasicStatsReportAndChartFormUnit; MainUnit, Globals, ReportFrameUnit, BasicStatsReportAndChartFormUnit;
type type
@ -74,12 +68,11 @@ type
ACCount, ABCount : IntDyneMat; ACCount, ABCount : IntDyneMat;
CellSDs, SS, SumSqr, CellMeans : DblDyneCube; CellSDs, SS, SumSqr, CellMeans : DblDyneCube;
MinA, MaxA, NoALevels: Integer; MinA, MaxA, NoALevels: Integer;
MinB, MaxB, NoBLevels: Integer; //ACol, BCol, CCol, YCol : integer; MinB, MaxB, NoBLevels: Integer;
MinC, MaxC, NoCLevels: integer; MinC, MaxC, NoCLevels: integer;
SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double; SSTot, SumSqrTot, TotMean, MSTot, SSA, MSA, SSB, MSB, SSW, MSW : double;
SSC, MSC, SSAC, MSAC, SSBwAC, SSAB, MSBwAC : double; SSC, MSC, SSAC, MSAC, SSBwAC, SSAB, MSBwAC : double;
TotN, dfA, dfBwA, dfwcell, dftotal, dfC, dfAC, dfBwAC : integer; TotN, dfA, dfBwA, dfwcell, dftotal, dfC, dfAC, dfBwAC : integer;
// ColNoSelected: IntDyneVec;
AMeans, BMeans, CMeans: DblDyneVec; AMeans, BMeans, CMeans: DblDyneVec;
ABMeans, ACMeans: DblDyneMat; ABMeans, ACMeans: DblDyneMat;
@ -92,9 +85,6 @@ type
procedure ShowResults; procedure ShowResults;
procedure ReleaseMemory; procedure ReleaseMemory;
procedure TwoWayPlot; procedure TwoWayPlot;
{$IFDEF SHOW_OLD_PLOTS}
procedure OldTwoWayPlot;
{$ENDIF}
private private
FMeansReportFrame: TReportFrame; FMeansReportFrame: TReportFrame;
@ -147,11 +137,6 @@ begin
AddComboboxToToolbar(FChartFrame.ChartToolbar, 'Plots:', FChartCombobox); AddComboboxToToolbar(FChartFrame.ChartToolbar, 'Plots:', FChartCombobox);
FChartCombobox.OnSelect := @SelectPlot; FChartCombobox.OnSelect := @SelectPlot;
{$IFDEF SHOW_OLD_PLOTS}
if GraphFrm = nil then
Application.CreateForm(TGraphFrm, GraphFrm);
{$ENDIF}
PageControl.ActivePageIndex := 0; PageControl.ActivePageIndex := 0;
end; end;
@ -182,6 +167,7 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TABCNestedForm.AOutBtnClick(Sender: TObject); procedure TABCNestedForm.AOutBtnClick(Sender: TObject);
begin begin
if FactorAEdit.Text <> '' then if FactorAEdit.Text <> '' then
@ -192,6 +178,7 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TABCNestedForm.BInBtnClick(Sender: TObject); procedure TABCNestedForm.BInBtnClick(Sender: TObject);
var var
index: integer; index: integer;
@ -205,6 +192,7 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TABCNestedForm.BOutBtnClick(Sender: TObject); procedure TABCNestedForm.BOutBtnClick(Sender: TObject);
begin begin
if FactorBEdit.Text <> '' then if FactorBEdit.Text <> '' then
@ -256,9 +244,6 @@ begin
GetResults; GetResults;
ShowResults; ShowResults;
TwoWayPlot; TwoWayPlot;
{$IFDEF SHOW_OLD_PLOTS}
OldTwoWayPlot;
{$ENDIF}
ReleaseMemory; ReleaseMemory;
end; end;
end; end;
@ -657,8 +642,9 @@ begin
end; end;
end; end;
end; end;
// assume all cells have same n size
// get no. of levels in A // Assume all cells have same n size
// Get number of levels in A
BLevCount := 0; BLevCount := 0;
for i := 0 to NoALevels-1 do for i := 0 to NoALevels-1 do
begin begin
@ -681,7 +667,7 @@ begin
SSTot := SSTot - constant; SSTot := SSTot - constant;
MSTot := SSTot / dftotal; MSTot := SSTot / dftotal;
// get A Effects // Get A Effects
SSA := 0.0; SSA := 0.0;
for i := 0 to NoALevels-1 do SSA := SSA + (ASumSqr[i] / ACount[i]); for i := 0 to NoALevels-1 do SSA := SSA + (ASumSqr[i] / ACount[i]);
temp := SSA; temp := SSA;
@ -695,7 +681,7 @@ begin
SSC := SSC - constant; SSC := SSC - constant;
MSC := SSC / dfC; MSC := SSC / dfC;
// get B within A // Get B within A
SSB := 0.0; SSB := 0.0;
for i := 0 to NoALevels - 1 do for i := 0 to NoALevels - 1 do
begin begin
@ -708,7 +694,7 @@ begin
SSB := SSB - temp; SSB := SSB - temp;
MSB := SSB / dfBwA; MSB := SSB / dfBwA;
// get AC interaction // Get AC interaction
SSAC := 0.0; SSAC := 0.0;
for i := 0 to NoALevels-1 do for i := 0 to NoALevels-1 do
begin begin
@ -792,7 +778,6 @@ end;
procedure TABCNestedForm.ReleaseMemory; procedure TABCNestedForm.ReleaseMemory;
begin begin
// ColNoSelected := nil;
ABSDs := nil; ABSDs := nil;
ABCount := nil; ABCount := nil;
// ABMeans := nil; // ABMeans := nil;
@ -921,30 +906,6 @@ begin
end; end;
end; end;
end; end;
(*
GetDataIndices(ix, iy,iz);
if (ix = 1) and (iy = 2) then
begin
FSeries.ListSource.YCount := NF2Cells;
for i := 0 to NF1Cells-1 do
begin
idx := FSeries.AddXY(minF1 + i, NaN, IntToStr(minF1 + i));
item := FSeries.Source.Item[idx];
for j := 0 to NF2Cells-1 do
item^.SetY(j, wsum[i,j,iz] / ncnt[i,j,iz]);
end;
FChartFrame.SetTitle(Format('Factor "%s" x Factor "%s"' + LineEnding + '"%s" = %d', [
Factor1Edit.Text, Factor2Edit.Text, Factor3Edit.Text, MinF3 + iz]));
FChartFrame.SetXTitle(Factor1Edit.Text + ' codes');
for j := 0 to NF2Cells-1 do
with TChartStyle(FStyles.styles.Add) do
begin
Brush.Color := DATA_COLORS[j mod Length(DATA_COLORS)];
UseBrush := True;
Text := Format('%s = %s', [Factor2Edit.Text, IntToStr(MinF2 + j)]);
end;
end
else *)
if (FSeries is TBarSeries) then if (FSeries is TBarSeries) then
begin begin
@ -994,216 +955,6 @@ begin
end; end;
{$IFDEF SHOW_OLD_PLOTS}
procedure TABCNestedForm.OldTwoWayPlot;
var
plottype, i, j, k : integer;
maxmean, XBar : double;
title, setstring : string;
XValue : DblDyneVec = nil;
begin
case OptionsGroup.ItemIndex of
0: plottype := 9;
1: plottype := 10;
2: plottype := 1;
3: plottype := 2;
end;
// Factor A first
maxmean := -1000.0;
SetLength(XValue,NoALevels);
setstring := 'FACTOR A';
GraphFrm.SetLabels[1] := setstring;
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 := FactorAEdit.Text;
title := FactorAEdit.Text + ' Group Codes';
GraphFrm.XTitle := title;
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;
// Factor B next
SetLength(XValue,NoBLevels);
setstring := 'FACTOR B';
GraphFrm.SetLabels[1] := setstring;
maxmean := -1000.0;
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';
title := FactorBEdit.Text + ' Group Codes';
GraphFrm.XTitle := title;
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;
// Factor C next
SetLength(XValue,NoCLevels);
setstring := 'FACTOR C';
GraphFrm.SetLabels[1] := setstring;
maxmean := -1000.0;
SetLength(GraphFrm.Xpoints,1,NoCLevels);
SetLength(GraphFrm.Ypoints,1,NoCLevels);
for i := 0 to NoCLevels-1 do
begin
GraphFrm.Ypoints[0,i] := CMeans[i];
if CMeans[i] > maxmean then maxmean := CMeans[i];
XValue[i] := MinC + i - 1;
GraphFrm.Xpoints[0,i] := XValue[i];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := NoCLevels;
GraphFrm.Heading := 'FACTOR C';
title := FactorBEdit.Text + ' Group Codes';
GraphFrm.XTitle := title;
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;
// Factor A x B interaction within each slice next
SetLength(XValue,NoALevels + NoBLevels);
SetLength(GraphFrm.Ypoints,NoALevels,NoBLevels);
SetLength(GraphFrm.Xpoints,1,NoBLevels);
for k := 0 to NoCLevels-1 do
begin
maxmean := -1000.0;
for i := 0 to NoALevels-1 do
begin
setstring := 'FACTOR A ' + IntToStr(i+1);
GraphFrm.SetLabels[i+1] := setstring;
for j := 0 to NoBLevels-1 do
begin
if ABCount[i,j] > 0 then
begin
if ABMeans[i,j] > maxmean then maxmean := ABMeans[i,j];
GraphFrm.Ypoints[i,j] := ABMeans[i,j];
end;
end;
end;
for j := 0 to NoBLevels-1 do
begin
XValue[j] := MinB + j - 1;
GraphFrm.Xpoints[0,j] := XValue[j];
end;
GraphFrm.nosets := NoALevels;
GraphFrm.nbars := NoBLevels;
GraphFrm.Heading := 'FACTOR A x Factor B within C' + IntToStr(k+1);
title := FactorBEdit.Text + ' Group Codes';
GraphFrm.XTitle := title;
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;
end;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
XValue := nil;
//Factor A x C Interaction within each column next
setLength(XValue,NoALevels+NoCLevels);
SetLength(GraphFrm.Xpoints,1,NoCLevels);
SetLength(GraphFrm.Ypoints,NoALevels,NoCLevels);
for j := 0 to NoBLevels-1 do
begin
maxmean := 0.0;
for i := 0 to NoALevels-1 do
begin
setstring := 'Factor A ' + IntToStr(i+1);
GraphFrm.SetLabels[i+1] := setstring;
for k := 0 to NoCLevels-1 do
begin
XBar := ACMeans[i,k];
if XBar > maxmean then maxmean := XBar;
GraphFrm.Ypoints[i,k] := XBar;
end;
end;
for k := 0 to NoCLevels-1 do
begin
XValue[k] := MinC + k - 1;
GraphFrm.Xpoints[0,k] := XValue[k];
end;
GraphFrm.nosets := NoALevels;
GraphFrm.nbars := NoCLevels;
GraphFrm.Heading := 'FACTOR A x Factor C within B ' + IntToStr(j+1);
title := FactorCEdit.Text + ' Group Codes';
GraphFrm.XTitle := title;
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;
end;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
XValue := nil;
end;
{$ENDIF}
procedure TABCNestedForm.UpdateBtnStates; procedure TABCNestedForm.UpdateBtnStates;
begin begin
inherited; inherited;

View File

@ -316,15 +316,14 @@ inherited BNestedAForm: TBNestedAForm
Left = 336 Left = 336
Height = 416 Height = 416
Width = 200 Width = 200
TabIndex = 2
inherited ReportPage: TTabSheet inherited ReportPage: TTabSheet
Caption = 'ANOVA Results' Caption = 'ANOVA Results'
end end
object MeansPage: TTabSheet[1] inherited ChartPage: TTabSheet
Caption = 'Means'
end
inherited ChartPage: TTabSheet[2]
Caption = 'Plots' Caption = 'Plots'
end end
object MeansPage: TTabSheet[2]
Caption = 'Means'
end
end end
end end

View File

@ -444,55 +444,6 @@ begin
end; end;
(*
var
i, group : integer;
strvalue, cellstring : string;
begin
Result := false;
DepVar := DepEdit.Text;
FactorA := ACodesEdit.Text;
FactorB := BCodesEdit.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
ErrorMsg('Select a variable for each entry box.');
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.ShowMeans; procedure TBNestedAForm.ShowMeans;
var var
lReport: TStrings; lReport: TStrings;

View File

@ -1,7 +1,7 @@
inherited RMatFrm: TRMatFrm inherited RMatForm: TRMatForm
Left = 1133 Left = 690
Height = 345 Height = 345
Top = 254 Top = 205
Width = 840 Width = 840
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/ProductMoment.htm' HelpKeyword = 'html/ProductMoment.htm'
@ -232,13 +232,13 @@ inherited RMatFrm: TRMatFrm
Height = 329 Height = 329
Top = 8 Top = 8
Width = 518 Width = 518
ActivePage = PairwisePage ActivePage = CrossProdPage
Align = alClient Align = alClient
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
TabIndex = 4 TabIndex = 0
TabOrder = 2 TabOrder = 2
object CrossProdPage: TTabSheet object CrossProdPage: TTabSheet
Caption = 'Cross-Products' Caption = 'Cross-Products'

View File

@ -15,9 +15,9 @@ uses
type type
{ TRMatFrm } { TRMatForm }
TRMatFrm = class(TBasicStatsReportForm) TRMatForm = class(TBasicStatsReportForm)
SaveMatrixChk: TCheckBox; SaveMatrixChk: TCheckBox;
InBtn: TBitBtn; InBtn: TBitBtn;
OutBtn: TBitBtn; OutBtn: TBitBtn;
@ -80,6 +80,7 @@ type
procedure Compute; override; procedure Compute; override;
procedure SelectVisiblePage; procedure SelectVisiblePage;
procedure UpdateBtnStates; override; procedure UpdateBtnStates; override;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
@ -87,7 +88,7 @@ type
end; end;
var var
RMatFrm: TRMatFrm; RMatForm: TRMatForm;
implementation implementation
@ -95,15 +96,18 @@ implementation
uses uses
Math, Math,
Utils, MathUnit; Utils, MathUnit, GridProcs;
{ TRMatFrm } { TRMatForm }
constructor TRMatFrm.Create(AOwner: TComponent); constructor TRMatForm.Create(AOwner: TComponent);
begin begin
inherited; inherited;
InitToolbar(FReportFrame.ReportToolbar, tpTop);
FReportFrame.ClearBorderSpacings;
FCrossProdReportFrame := FReportFrame; // already created by ancestor FCrossProdReportFrame := FReportFrame; // already created by ancestor
FCrossProdReportFrame.Parent := CrossProdPage; FCrossProdReportFrame.Parent := CrossProdPage;
FCrossProdReportFrame.Align := alClient; FCrossProdReportFrame.Align := alClient;
@ -129,7 +133,7 @@ begin
end; end;
procedure TRMatFrm.AdjustConstraints; procedure TRMatForm.AdjustConstraints;
begin begin
inherited; inherited;
ParamsPanel.Constraints.MinWidth := Max( ParamsPanel.Constraints.MinWidth := Max(
@ -143,7 +147,7 @@ end;
procedure TRMatFrm.AllBtnClick(Sender: TObject); procedure TRMatForm.AllBtnClick(Sender: TObject);
var var
index: Integer; index: Integer;
begin begin
@ -154,10 +158,9 @@ begin
end; end;
procedure TRMatFrm.Compute; procedure TRMatForm.Compute;
var var
i, j: integer; i: integer;
cellstring: string;
NoVars: integer; NoVars: integer;
ColNoSelected: IntDyneVec = nil; ColNoSelected: IntDyneVec = nil;
Matrix: DblDyneMat = nil; Matrix: DblDyneMat = nil;
@ -169,12 +172,6 @@ var
nGood: Integer = 0; nGood: Integer = 0;
begin begin
NoVars := SelList.Items.Count; NoVars := SelList.Items.Count;
if NoVars = 0 then
begin
MessageDlg('No variable(s) selected.', mtError, [mbOK], 0);
exit;
end;
SetLength(ColNoSelected, NoVars+1); SetLength(ColNoSelected, NoVars+1);
SetLength(Matrix, NoVars+1, NoVars+1); // 1 more for possible augmentation SetLength(Matrix, NoVars+1, NoVars+1); // 1 more for possible augmentation
SetLength(Means, NoVars+1); SetLength(Means, NoVars+1);
@ -183,19 +180,12 @@ begin
SetLength(RowLabels, NoVars+1); SetLength(RowLabels, NoVars+1);
SetLength(ColLabels, NoVars+1); SetLength(ColLabels, NoVars+1);
// identify the included variable locations and their labels // Identify the included variable locations and their labels
for i := 1 to NoVars do for i := 0 to NoVars-1 do
begin begin
cellstring := SelList.Items.Strings[i-1]; RowLabels[i] := SelList.Items[i];
for j := 1 to NoVariables do ColLabels[i] := RowLabels[i];
begin ColNoSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, RowLabels[i]);
if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
begin
ColNoSelected[i-1] := j;
RowLabels[i-1] := cellstring;
ColLabels[i-1] := cellstring;
end;
end;
end; end;
if AugmentChk.Checked then if AugmentChk.Checked then
begin begin
@ -255,14 +245,13 @@ begin
end; end;
procedure TRMatFrm.CrossProducts(ANumVars, ANumCases: Integer; procedure TRMatForm.CrossProducts(ANumVars, ANumCases: Integer;
const AMatrix: DblDyneMat; Augmented: Boolean; const AMatrix: DblDyneMat; Augmented: Boolean;
const ARowLabels, AColLabels: StrDyneVec); const ARowLabels, AColLabels: StrDyneVec);
var var
lReport: TStrings; lReport: TStrings;
title: String; title: String;
begin begin
// GridXProd(ANumVars, AColNoSelected, AMatrix, Augmented, nGood);
title := 'Cross-Products Matrix'; title := 'Cross-Products Matrix';
if Augmented then if Augmented then
inc(ANumVars); inc(ANumVars);
@ -277,7 +266,7 @@ begin
end; end;
procedure TRMatFrm.InterCorrelations(ANumVars: Integer; const AColNoSelected: IntDyneVec; procedure TRMatForm.InterCorrelations(ANumVars: Integer; const AColNoSelected: IntDyneVec;
const AMatrix: DblDyneMat; const AMeans, AVars, AStdDevs: DblDyneVec; const AMatrix: DblDyneMat; const AMeans, AVars, AStdDevs: DblDyneVec;
const ARowLabels, AColLabels: StrDyneVec); const ARowLabels, AColLabels: StrDyneVec);
var var
@ -287,7 +276,7 @@ var
hasError: Boolean = false; hasError: Boolean = false;
i, j: Integer; i, j: Integer;
testMat: DblDyneMat = nil; testMat: DblDyneMat = nil;
t, probR, N: double; t, probR: double;
begin begin
title := 'Product-Moment Correlations Matrix'; title := 'Product-Moment Correlations Matrix';
Correlations(ANumVars, AColNoSelected, AMatrix, AMeans, AVars, AStdDevs, hasError, nGood); Correlations(ANumVars, AColNoSelected, AMatrix, AMeans, AVars, AStdDevs, hasError, nGood);
@ -302,17 +291,22 @@ begin
lReport.Add('One or more correlations could not be computed due to zero variance of a variable.'); lReport.Add('One or more correlations could not be computed due to zero variance of a variable.');
end; end;
N := Ngood; if nGood <= 2 then
begin
lReport.Add('');
lReport.Add('Not enough cases to calculate t-test values.');
end else
begin
SetLength(testMat, ANumVars, ANumVars); SetLength(testMat, ANumVars, ANumVars);
for i := 1 to ANumVars do for i := 0 to ANumVars-1 do
begin begin
for j := i+1 to ANumVars do for j := i+1 to ANumVars-1 do
begin begin
t := AMatrix[i-1, j-1] * (sqrt((N-2.0) / (1.0 - (AMatrix[i-1, j-1] * AMatrix[i-1, j-1])))); t := AMatrix[i, j] * sqrt((nGood - 2) / (1.0 - sqr(AMatrix[i, j])));
testMat[i-1,j-1] := t; testMat[i, j] := t;
probR := ProbT(t, N - 2); probR := ProbT(t, nGood - 2);
testMat[j-1, i-1] := probR; testMat[j, i] := probR;
testMat[i-1, i-1] := 0.0; testMat[i, i] := 0.0;
end; end;
end; end;
@ -321,6 +315,7 @@ begin
title := 't-test values (upper) and probabilities of t (lower)'; title := 't-test values (upper) and probabilities of t (lower)';
MatPrint(testMat, ANumVars, ANumVars, title, ARowLabels, AColLabels, nGood, lReport); MatPrint(testMat, ANumVars, ANumVars, title, ARowLabels, AColLabels, nGood, lReport);
end;
FInterCorrReportFrame.DisplayReport(lReport); FInterCorrReportFrame.DisplayReport(lReport);
@ -330,7 +325,7 @@ begin
end; end;
procedure TRMatFrm.InBtnClick(Sender: TObject); procedure TRMatForm.InBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -348,7 +343,8 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TRMatFrm.OutBtnClick(Sender: TObject);
procedure TRMatForm.OutBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -367,7 +363,7 @@ begin
end; end;
procedure TRMatFrm.PairsCalc(NoVars: integer; const ColNoSelected: IntDyneVec; procedure TRMatForm.PairsCalc(NoVars: integer; const ColNoSelected: IntDyneVec;
const Matrix: DblDyneMat; const ColLabels: StrDyneVec); const Matrix: DblDyneMat; const ColLabels: StrDyneVec);
var var
lReport: TStrings; lReport: TStrings;
@ -401,8 +397,8 @@ begin
for k := 1 to NoCases do for k := 1 to NoCases do
begin begin
if not ValidValue(k,XCol) then continue; if not ValidValue(OS3MainFrm.DataGrid, k, XCol) then continue;
if not ValidValue(k,YCol) then continue; if not ValidValue(OS3MainFrm.DataGrid, k, YCol) then continue;
X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol, k]); X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol, k]);
Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol, k]); Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol, k]);
pmcorr := pmcorr + (X * Y); pmcorr := pmcorr + (X * Y);
@ -410,25 +406,25 @@ begin
YMean := YMean + Y; YMean := YMean + Y;
XVar := XVar + (X * X); XVar := XVar + (X * X);
YVar := YVar + (Y * Y); YVar := YVar + (Y * Y);
Npairs := NPairs + 1; NPairs := NPairs + 1;
end; end;
if CrossProdChk.Checked then if CrossProdChk.Checked then
lReport.Add('CrossProducts[%d,%d]: %6.4f, N cases: %d', [i, j, pmcorr, Npairs]); lReport.Add('CrossProducts[%d,%d]: %6.4f, N cases: %d', [i, j, pmcorr, NPairs]);
pmcorr := pmcorr - (XMean * YMean) / Npairs; pmcorr := pmcorr - (XMean * YMean) / NPairs;
pmcorr := pmcorr / (Npairs - 1); pmcorr := pmcorr / (Npairs - 1);
if VarCovarChk.Checked then if VarCovarChk.Checked then
lReport.Add('Covariance[%d,%d]: %6.4f, N cases: %d', [i, j, pmcorr, Npairs]); lReport.Add('Covariance[%d,%d]: %6.4f, N cases: %d', [i, j, pmcorr, NPairs]);
XVar := XVar - (XMean * XMean) / Npairs; XVar := XVar - (XMean * XMean) / NPairs;
XVar := XVar / (Npairs - 1); XVar := XVar / (NPairs - 1);
XSD := sqrt(XVar); XSD := sqrt(XVar);
YVar := YVar - (YMean * YMean) / Npairs; YVar := YVar - (YMean * YMean) / Npairs;
YVar := YVar / (Npairs - 1); YVar := YVar / (NPairs - 1);
YSD := sqrt(YVar); YSD := sqrt(YVar);
XMean := XMean / Npairs; XMean := XMean / NPairs;
YMean := YMean / Npairs; YMean := YMean / NPairs;
pmcorr := pmcorr / (XSD * YSD); pmcorr := pmcorr / (XSD * YSD);
Matrix[i-1,j-1] := pmcorr; Matrix[i-1,j-1] := pmcorr;
Matrix[j-1,i-1] := pmcorr; Matrix[j-1,i-1] := pmcorr;
@ -444,8 +440,8 @@ begin
// z := 0.5 * ln( (1.0 + pmcorr)/(1.0 - pmcorr) ); // z := 0.5 * ln( (1.0 + pmcorr)/(1.0 - pmcorr) );
// z := z / sqrt(1.0/N); // z := z / sqrt(1.0/N);
// rprob := probz(z); // rprob := probz(z);
lReport.Add('r[%d, %d]: %6.4f, N cases: %d', [i, j, pmcorr, Npairs]); lReport.Add('r[%d, %d]: %6.4f, N cases: %d', [i, j, pmcorr, NPairs]);
lReport.Add('t value with d.f. %d: %8.4f with Probability > t %6.4f', [Npairs - 2, z, rprob]); lReport.Add('t value with d.f. %d: %8.4f with Probability > t %6.4f', [NPairs - 2, z, rprob]);
tMatrix[i-1,j-1] := z; tMatrix[i-1,j-1] := z;
tMatrix[j-1,i-1] := z; tMatrix[j-1,i-1] := z;
@ -496,13 +492,13 @@ begin
if j <> i then if j <> i then
strout := strout + Format(' %3d ', [NMatrix[i-1,j-1]]) strout := strout + Format(' %3d ', [NMatrix[i-1,j-1]])
else begin else begin
Npairs := 0; NPairs := 0;
for k := 1 to NoCases do for k := 1 to NoCases do
begin begin
if ValidValue(k,ColNoSelected[j-1]) then if ValidValue(OS3MainFrm.DataGrid, k, ColNoSelected[j-1]) then
Npairs := Npairs + 1; NPairs := NPairs + 1;
end; end;
strout := strout + Format(' %3d ', [Npairs]); strout := strout + Format(' %3d ', [NPairs]);
end; end;
end; end;
@ -542,7 +538,7 @@ begin
end; end;
procedure TRMatFrm.Reset; procedure TRMatForm.Reset;
var var
i: integer; i: integer;
begin begin
@ -582,7 +578,7 @@ begin
end; end;
procedure TRMatFrm.SelectVisiblePage; procedure TRMatForm.SelectVisiblePage;
var var
i: Integer; i: Integer;
begin begin
@ -598,7 +594,7 @@ begin
end; end;
procedure TRMatFrm.SelListDblClick(Sender: TObject); procedure TRMatForm.SelListDblClick(Sender: TObject);
var var
index: Integer; index: Integer;
begin begin
@ -612,13 +608,13 @@ begin
end; end;
procedure TRMatFrm.SelListSelectionChange(Sender: TObject; User: boolean); procedure TRMatForm.SelListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TRMatFrm.Stats(ANumVars, ANumCases: Integer; const AMeans, AVars, AStdDevs: DblDyneVec; procedure TRMatForm.Stats(ANumVars, ANumCases: Integer; const AMeans, AVars, AStdDevs: DblDyneVec;
const AColLabels: StrDyneVec); const AColLabels: StrDyneVec);
var var
lReport: TStrings; lReport: TStrings;
@ -628,23 +624,25 @@ begin
if MeansChk.Checked then if MeansChk.Checked then
DynVectorPrint(AMeans, ANumVars, 'Means', AColLabels, ANumCases, lReport); DynVectorPrint(AMeans, ANumVars, 'Means', AColLabels, ANumCases, lReport);
if MeansChk.Checked and (VarsChk.Checked or StdDevsChk.Checked) then if VarsChk.Checked then
begin
if MeansChk.Checked then
begin begin
lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(DIVIDER_SMALL_AUTO);
lReport.Add(''); lReport.Add('');
end; end;
if VarsChk.Checked then
DynVectorPrint(AVars, ANumVars, 'Variances', AColLabels, ANumCases, lReport); DynVectorPrint(AVars, ANumVars, 'Variances', AColLabels, ANumCases, lReport);
if (MeansChk.Checked or VarsChk.Checked) and StdDevsChk.Checked then
begin
lReport.Add(DIVIDER_SMALL_AUTO);
lReport.Add('');
end; end;
if StdDevsChk.Checked then if StdDevsChk.Checked then
begin
if (MeansChk.Checked or VarsChk.Checked) then
begin
lReport.Add(DIVIDER_SMALL_AUTO);
lReport.Add('');
end;
DynVectorPrint(AStdDevs, ANumVars, 'Standard Deviations', AColLabels, ANumCases, lReport); DynVectorPrint(AStdDevs, ANumVars, 'Standard Deviations', AColLabels, ANumCases, lReport);
end;
FStatsReportFrame.DisplayReport(lReport); FStatsReportFrame.DisplayReport(lReport);
finally finally
@ -653,7 +651,7 @@ begin
end; end;
procedure TRMatFrm.UpdateBtnStates; procedure TRMatForm.UpdateBtnStates;
begin begin
inherited; inherited;
@ -672,7 +670,22 @@ begin
end; end;
procedure TRMatFrm.VarCovar(ANumVars: Integer; const AColNoSelected: IntDyneVec; function TRMatForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
begin
Result := false;
if SelList.Items.Count = 0 then
begin
AMsg := 'No variable(s) selected.';
AControl := SelList;
exit;
end;
Result := true;
end;
procedure TRMatForm.VarCovar(ANumVars: Integer; const AColNoSelected: IntDyneVec;
const AMatrix: DblDyneMat; const AMeans, AVars, AStdDevs: DblDyneVec; const AMatrix: DblDyneMat; const AMeans, AVars, AStdDevs: DblDyneVec;
const ARowLabels, AColLabels: StrDyneVec); const ARowLabels, AColLabels: StrDyneVec);
var var
@ -699,7 +712,7 @@ begin
end; end;
procedure TRMatFrm.VarListDblClick(Sender: TObject); procedure TRMatForm.VarListDblClick(Sender: TObject);
var var
index: Integer; index: Integer;
begin begin
@ -712,7 +725,8 @@ begin
end; end;
end; end;
procedure TRMatFrm.VarListSelectionChange(Sender: TObject; User: boolean);
procedure TRMatForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;

View File

@ -183,7 +183,7 @@ end;
procedure TSensForm.Compute; procedure TSensForm.Compute;
var var
NoSelected, count, half, q, tp, low, hi, col: integer; NoSelected, count, half, q, tp, low, hi: integer;
Values: DblDyneMat = nil; Values: DblDyneMat = nil;
Slopes: DblDyneMat = nil; Slopes: DblDyneMat = nil;
AvgSlopes: DblDyneMat = nil; AvgSlopes: DblDyneMat = nil;
@ -268,15 +268,10 @@ begin
lReport.Add(''); lReport.Add('');
lReport.Add(DIVIDER_SMALL_AUTO); lReport.Add(DIVIDER_SMALL_AUTO);
lReport.Add(''); lReport.Add('');
if j < noselected then if j < noSelected then
begin lReport.Add('RESULTS FOR %s', [lTitle])
col := Selected[j]; else
lReport.Add('RESULTS FOR %s', [lTitle]);
end else
begin
col := 0;
lReport.Add('RESULTS FOR AVERAGED VALUES'); lReport.Add('RESULTS FOR AVERAGED VALUES');
end;
lReport.Add(''); lReport.Add('');
if (NoSelected > 1) and StandardizeChk.Checked then if (NoSelected > 1) and StandardizeChk.Checked then

View File

@ -721,9 +721,9 @@ end;
// Menu "Correlation" > "Product-Moment" // Menu "Correlation" > "Product-Moment"
procedure TOS3MainFrm.mnuAnalysisCorrel_ProductMomentClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisCorrel_ProductMomentClick(Sender: TObject);
begin begin
if RMatFrm = nil then if RMatForm = nil then
Application.CreateForm(TRMatFrm, RMatFrm); Application.CreateForm(TRMatForm, RMatForm);
RMatFrm.ShowModal; RMatForm.Show;
end; end;
// Menu "Correlation" > "Partial, Semipartial" // Menu "Correlation" > "Partial, Semipartial"

View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Dialogs, Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, StdCtrls, Dialogs,
PrintersDlgs, MainDM; PrintersDlgs, MainDM, Utils;
type type
@ -34,6 +34,7 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Clear; virtual; procedure Clear; virtual;
procedure ClearBorderSpacings;
procedure DisplayReport(AReport: TStrings; Add: Boolean = false); virtual; procedure DisplayReport(AReport: TStrings; Add: Boolean = false); virtual;
procedure UpdateBtnStates; virtual; procedure UpdateBtnStates; virtual;
@ -73,6 +74,19 @@ begin
end; end;
procedure TReportFrame.ClearBorderSpacings;
begin
with BorderSpacing do
begin
Left := 0;
Top := 0;
Right := 0;
Bottom := 0;
Around := 0;
end;
end;
procedure TReportFrame.DisplayReport(AReport: TStrings; Add: Boolean = false); procedure TReportFrame.DisplayReport(AReport: TStrings; Add: Boolean = false);
var var
maxLen: Integer; maxLen: Integer;