// Use file "abranova.laz" for testing. unit ABRANOVAUnit; {$mode objfpc}{$H+} {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LCLVersion, StdCtrls, Buttons, ExtCtrls, ComCtrls, TASources, TAStyles, TASeries, MainUnit, FunctionsLib, Globals, DataProcs, MatrixLib, ReportFrameUnit, BasicStatsReportAndChartFormUnit; type TABRAnovaData = record // Counts NoAGrps, NoBGrps, NInGrp, TotalN: Integer; Acnt, Bcnt, Ccnt: IntDyneVec; // Degrees of freedom DFA, DFB, DFC, DFAB, DFAC, DFBC, DFABC, DFBetween: double; DFerrorBetween, DFWithin, DFerrorWithin: double; // Sums ASums, BSums, CSums, SumPSqr: DblDyneVec; ABSums, ACSums, BCSums: DblDyneMat; ABCSums: DblDyneCube; ABCNcnt: IntDyneCube; GrandTotal: Double; // Sums of squares SSA, SSB, SSC, SSAB, SSAC, SSBC, SSABC: Double; SSBetweenSubjects, SSWithinSubjects: Double; SSerrorBetween, SSerrorWithin: Double; SumXSqr: Double; // Mean standard errors MSA, MSB, MSC, MSAB, MSAC, MSBC, MSABC, MSerrorBetween, MSerrorWithin: Double; // F values FA, FB, FC, FAB, FAC, FBC, FABC: Double; // Probabilities ProbA, ProbB, ProbC, ProbAB, ProbAC, ProbBC, ProbABC: Double; end; { TABRAnovaForm } TABRAnovaForm = class(TBasicStatsReportAndChartForm) AInBtn: TBitBtn; AOutBtn: TBitBtn; BInBtn: TBitBtn; BOutBtn: TBitBtn; ChartStyles: TChartStyles; ThreeDChk: TCheckBox; CInBtn: TBitBtn; COutBtn: TBitBtn; ACodesEdit: TEdit; BCodesEdit: TEdit; ListChartSource_AB: TListChartSource; ListChartSource_AC: TListChartSource; ListChartSource_BC: TListChartSource; MeansPage: TTabSheet; BoxTestsPage: TTabSheet; TestChk: TCheckBox; PlotChk: TCheckBox; OptionsGroup: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; CList: TListBox; VarList: TListBox; procedure ACodesEditChange(Sender: TObject); procedure AInBtnClick(Sender: TObject); procedure AOutBtnClick(Sender: TObject); procedure BInBtnClick(Sender: TObject); procedure BOutBtnClick(Sender: TObject); procedure CInBtnClick(Sender: TObject); procedure CListDblClick(Sender: TObject); procedure CListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure COutBtnClick(Sender: TObject); procedure PlotChkChange(Sender: TObject); procedure ThreeDChkChange(Sender: TObject); procedure VarListDblClick(Sender: TObject); private type TInteraction = (AB, AC, BC); private ColNoSelected: IntDyneVec; ACol, BCol, NoSelected, MinA, MaxA, MinB, MaxB: integer; MaxRows, MaxCols: integer; selected: Integer; FMeansReportFrame: TReportFrame; FBoxTestsReportFrame: TReportFrame; FBtnAB, FBtnAC, FBtnBC: TToolButton; FBarSeries: TBarSeries; procedure InteractionChanged(Sender: TObject); procedure Set3DPlot(AEnable: Boolean); function InitData(out AData: TABRAnovaData): Boolean; procedure GetData(var AData: TABRAnovaData); procedure Calculate(var AData: TABRAnovaData); procedure Summarize(const AData: TABRAnovaData; AReport: TStrings); procedure MeansReport(const AData: TABRAnovaData; AReport: TStrings); procedure BoxTests(const AData: TABRAnovaData; AReport: TStrings); procedure PreparePlot(const AData: TABRAnovaData); procedure PlotMeans(AInteraction: TInteraction); procedure CleanUp(var AData: TABRAnovaData); protected procedure AdjustConstraints; override; procedure Compute; override; procedure UpdateBtnStates; override; function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override; public constructor Create(AOwner: TComponent); override; procedure Reset; override; end; var ABRAnovaForm: TABRAnovaForm; implementation {$R *.lfm} uses Math, TAChartUtils, TALegend, TACustomSource, TACustomSeries, Utils, MathUnit, GridProcs, ChartFrameUnit; { TABRAnovaForm } constructor TABRAnovaForm.Create(AOwner: TComponent); var btn: TToolButton; begin inherited; FMeansReportFrame := TReportFrame.Create(self); FMeansReportFrame.Name := ''; FMeansReportFrame.Parent := MeansPage; FMeansReportFrame.Align := alClient; FMeansReportFrame.BorderSpacing.Left := 0; FMeansReportFrame.BorderSpacing.Top := 0; FMeansReportFrame.BorderSpacing.Bottom := 0; FMeansReportFrame.BorderSpacing.Right := 0; FBoxTestsReportFrame := TReportFrame.Create(self); FBoxTestsReportFrame.Name := ''; FBoxTestsReportFrame.Parent := BoxTestsPage; FBoxTestsReportFrame.Align := alClient; FBoxTestsReportFrame.BorderSpacing.Left := 0; FBoxTestsReportFrame.BorderSpacing.Top := 0; FBoxTestsReportFrame.BorderSpacing.Bottom := 0; FBoxTestsReportFrame.BorderSpacing.Right := 0; FChartFrame.Chart.Margins.Bottom := 0; FChartFrame.Chart.BottomAxis.AxisPen.Visible := true; FChartFrame.Chart.BottomAxis.ZPosition := 1; FChartFrame.Chart.BottomAxis.Grid.Visible := false; FChartFrame.ChartToolbar.ShowCaptions := true; FChartFrame.ChartToolbar.ButtonHeight := 40;; btn := TToolButton.Create(FChartFrame.ChartToolbar); btn.Style := tbsDivider; AddButtonToToolbar(btn, FChartFrame.ChartToolbar); FBtnAB := TToolButton.Create(FChartFrame.ChartToolbar); FBtnAB.Caption := 'AB interaction'; FBtnAB.Down := true; FBtnAB.Style := tbsCheck; FBtnAB.Grouped := true; FBtnAB.OnClick := @InteractionChanged; AddButtonToToolbar(FBtnAB, FChartFrame.ChartToolbar); FBtnAC := TToolButton.Create(FChartFrame.ChartToolbar); FBtnAC.Caption := 'AC interaction'; FBtnAC.Grouped := true; FBtnAC.Style := tbsCheck; FBtnAC.OnClick := @InteractionChanged; AddButtonToToolbar(FBtnAC, FChartFrame.ChartToolbar); FBtnBC := TToolButton.Create(FChartFrame.ChartToolbar); FbtnBC.Caption := 'BC interaction'; FBtnBC.Grouped := true; FBtnBC.Style := tbsCheck; FBtnBC.OnClick := @InteractionChanged; AddButtonToToolbar(FBtnBC, FChartFrame.ChartToolbar); PageControl.ActivePageIndex := 0; end; procedure TABRAnovaForm.AdjustConstraints; begin inherited; ParamsPanel.Constraints.MinWidth := Max( 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left, OptionsGroup.Width ); ParamsPanel.Constraints.MinHeight := COutBtn.Top + COutBtn.Height + OptionsGroup.BorderSpacing.Top + OptionsGroup.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height end; procedure TABRAnovaForm.ACodesEditChange(Sender: TObject); begin UpdateBtnStates; end; procedure TABRAnovaForm.AInBtnClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (ACodesEdit.Text = '') then begin ACodesEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TABRAnovaForm.AOutBtnClick(Sender: TObject); begin if ACodesEdit.Text <> '' then begin VarList.Items.Add(ACodesEdit.Text); ACodesEdit.Text := ''; end; UpdateBtnStates; end; procedure TABRAnovaForm.BInBtnClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (BCodesEdit.Text = '') then begin BCodesEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; UpdateBtnStates; end; procedure TABRAnovaForm.BOutBtnClick(Sender: TObject); begin if BCodesEdit.Text <> '' then begin VarList.Items.Add(BCodesEdit.Text); BCodesEdit.Text := ''; end; UpdateBtnStates; end; procedure TABRAnovaForm.CInBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < VarList.Items.Count do begin if VarList.Selected[i] then begin CList.Items.Add(VarList.Items[i]); VarList.Items.Delete(i); i := 0; end else inc(i); end; UpdateBtnStates; end; procedure TABRAnovaForm.CleanUp(var AData: TABRAnovaData); begin with AData do begin ABCNcnt := nil; ABCSums := nil; Ccnt := nil; Bcnt := nil; Acnt := nil; SumPSqr := nil; //{ BCSums := nil; // needed for plotting ACSums := nil; ABSums := nil; //} CSums := nil; BSums := nil; ASums := nil; ColNoSelected := nil; end; end; procedure TABRAnovaForm.CListDblClick(Sender: TObject); var index: Integer; begin index := CList.ItemIndex; if index > -1 then begin VarList.Items.Add(CList.Items[index]); CList.Items.Delete(index); UpdateBtnStates; end; end; procedure TABRAnovaForm.CListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; procedure TABRAnovaForm.Compute; var lReport: TStrings; interaction: TInteraction; data: TABRAnovaData; begin lReport := TStringList.Create; try if InitData(data) then begin GetData(data); Calculate(data); Summarize(data, lReport); MeansReport(data, lReport); BoxTestsPage.TabVisible := TestChk.Checked; if TestChk.Checked then begin BoxTests(data, lReport); //BoxTestsPage.PageIndex := 2; end; ChartPage.TabVisible := PlotChk.Checked; if PlotChk.Checked then begin PreparePlot(data); if FBtnAB.Down then interaction := AB else if FBtnAC.Down then interaction := AC else if FBtnBC.Down then interaction := BC; PlotMeans(interaction); ChartPage.PageIndex := PageControl.PageCount-1; end; end; finally lReport.Free; CleanUp(data); end; end; procedure TABRAnovaForm.COutBtnClick(Sender: TObject); var i: Integer; begin i := 0; while i < CList.Items.Count do begin if CList.Selected[i] then begin VarList.Items.Add(CList.Items[i]); CList.Items.Delete(i); i := 0; end else inc(i); end; VarList.ItemIndex := -1; CList.ItemIndex := -1; UpdateBtnStates; end; procedure TABRAnovaForm.PlotChkChange(Sender: TObject); begin ThreeDChk.Enabled := PlotChk.Checked; end; function TABRAnovaForm.InitData(out AData: TABRAnovaData): Boolean; var cellStr: string; groupVal: Integer; i, j, k: integer; begin Result := false; SetLength(ColNoSelected, NoVariables); ACol := GetVariableIndex(OS3MainFrm.DataGrid, ACodesEdit.Text); BCol := GetVariableIndex(OS3MainFrm.DataGrid, BCodesEdit.Text); if ((ACol = -1) or (BCol = -1)) then begin // This case should already have been caught, but anyway... ErrorMsg('Select a variable for the A and B Variable Codes.'); exit; end; NoSelected := CList.Items.Count; MinA := MaxInt; MaxA := -MaxInt; MinB := MaxInt; MaxB := -MaxInt; for i := 1 to NoCases do begin if not ValidValue(OS3MainFrm.DataGrid, i, ACol) then continue; cellStr := Trim(OS3MainFrm.DataGrid.Cells[ACol, i]); groupVal := round(StrToFloat(cellstr)); if (groupVal > MaxA) then MaxA := groupVal; if (groupVal < MinA) then MinA := groupVal; cellStr := Trim(OS3MainFrm.DataGrid.Cells[BCol, i]); if not ValidValue(OS3MainFrm.DataGrid, i, BCol) then continue; groupVal := round(StrToFLoat(cellStr)); if (groupVal > MaxB) then MaxB := groupVal; if (groupVal < MinB) then MinB := groupVal; end; with AData do begin NoAGrps := MaxA - MinA + 1; NoBGrps := MaxB - MinB + 1; MaxRows := NoAGrps * NoBGrps; MaxCols := NoSelected; if (NoBGrps > NoSelected) then MaxCols := NoBGrps; if (MaxCols > MaxRows) then MaxRows := MaxCols; // allocate storage for arrays SetLength(ASums, NoAGrps); SetLength(Bsums, NoBGrps); SetLength(Csums, NoCases); SetLength(ABSums, NoAGrps, NoBGrps); SetLength(ACSums, NoAGrps, NoSelected); SetLength(BCSums, NoBGrps, NoSelected); SetLength(SumPSqr, NoCases); SetLength(Acnt, NoAGrps); SetLength(Bcnt, NoBGrps); SetLength(Ccnt, MaxRows); SetLength(ABCSums, NoAGrps, NoBGrps, NoSelected); SetLength(ABCNcnt, NoAGrps, NoBGrps, NoSelected); // initialize arrays for i := 0 to NoAGrps-1 do begin ASums[i] := 0.0; Acnt[i] := 0; for j := 0 to NoBGrps-1 do begin ABSums[i, j] := 0.0; for k := 0 to NoSelected-1 do begin ABCSums[i, j, k] := 0.0; ABCNcnt[i, j, k] := 0; end; end; for j := 0 to NoSelected-1 do begin ACSums[i, j] := 0.0; end; end; for i := 0 to NoBGrps-1 do begin BSums[i] := 0.0; Bcnt[i] := 0; for j := 0 to NoSelected-1 do begin BCSums[i, j] := 0.0; end; end; for i := 0 to NoSelected-1 do begin CSums[i] := 0.0; Ccnt[i] := 0; end; for i := 0 to NoCases-1 do SumPSqr[i] := 0.0; GrandTotal := 0.0; TotalN := 0; SumXSqr := 0.0; end; Result := true; end; procedure TABRAnovaForm.InteractionChanged(Sender: TObject); var interaction: TInteraction; begin if TObject(Sender) is TToolButton then TToolButton(Sender).Down := true; if not PlotChk.Checked then exit; if FBtnAB.Down then interaction := AB else if FBtnAC.Down then interaction := AC else if FBtnBC.Down then interaction := BC; PlotMeans(interaction); UpdateBtnStates; end; procedure TABRAnovaForm.GetData(var AData: TABRAnovaData); var i, j, SubjA, SubjB: integer; X: double; subjTot: Double; begin for i := 0 to NoSelected - 1 do ColNoSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, CList.Items[i]); ColNoSelected[NoSelected] := ACol; ColNoSelected[NoSelected+1] := BCol; // must be over-dimensioned by +2 selected := NoSelected + 2; // read data and store sums with AData do begin for i := 1 to NoCases do begin if not DataProcs.GoodRecord(i,selected,ColNoSelected) then continue; SubjA := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ACol,i]))); SubjA := SubjA - MinA + 1; SubjB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[BCol,i]))); SubjB := SubjB - MinB + 1; SubjTot := 0.0; for j := 0 to NoSelected-1 do begin X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[j], i])); SubjTot := SubjTot + X; SumXSqr := SumXSqr + (X * X); ABCSums[SubjA-1, SubjB-1, j] := ABCSums[SubjA-1, SubjB-1, j] + X; ABCNcnt[SubjA-1, SubjB-1, j] := ABCNcnt[SubjA-1, SubjB-1, j] + 1; Acnt[SubjA-1] := Acnt[SubjA-1] + 1; Bcnt[SubjB-1] := Bcnt[SubjB-1] + 1; Ccnt[j] := Ccnt[j] + 1; TotalN := TotalN + 1; end; SumPSqr[i-1] := SumPSqr[i-1] + (SubjTot * SubjTot); GrandTotal := GrandTotal + SubjTot; NinGrp := ABCNcnt[0,0,0]; end; end; end; procedure TABRAnovaForm.Calculate(var AData: TABRAnovaData); var SumA, SumB, SumC, SumAB, SumAC, SumBC, SumABC : double; Term1, Term2, Term3, Term4, Term5, Term6, Term7, Term8, Term9, Term10 : double; i, j, k, CountA, CountB, CountC: integer; begin with AData do begin Term1 := (GrandTotal * GrandTotal) / TotalN; Term2 := SumXSqr; Term3 := 0.0; countA := 0; for i := 0 to NoAGrps-1 do begin SumA := 0.0; countA := countA + Acnt[i]; for j := 0 to NoBGrps-1 do for k := 0 to NoSelected-1 do SumA := SumA + ABCSums[i, j, k]; ASums[i] := ASums[i] + SumA; Term3 := Term3 + sqr(SumA); end; Term3 := Term3 / (NInGrp * NoBGrps * NoSelected); Term4 := 0; countB := 0; for j := 0 to NoBGrps-1 do begin SumB := 0.0; CountB := CountB + Bcnt[j]; for i := 0 to NoAGrps-1 do for k := 0 to NoSelected-1 do SumB := SumB + ABCSums[i, j, k]; BSums[j] := BSums[j] + SumB; Term4 := Term4 + sqr(SumB); end; Term4 := Term4 / (NInGrp * NoAGrps * NoSelected); Term5 := 0.0; countC := 0; for k := 0 to NoSelected-1 do begin SumC := 0.0; CountC := CountC + Ccnt[k]; for i := 0 to NoAGrps-1 do for j := 0 to NoBGrps-1 do SumC := SumC + ABCSums[i, j, k]; CSums[k] := CSums[k] + SumC; Term5 := Term5 + sqr(SumC); end; Term5 := Term5 / (NInGrp * NoAGrps * NoBGrps); Term6 := 0.0; for i := 0 to NoAGrps-1 do begin for j := 0 to NoBGrps-1 do begin SumAB := 0.0; //CountAB := CountAB + ABcnt^[i,j]; for k := 0 to NoSelected-1 do SumAB := SumAB + ABCSums[i, j, k]; ABSums[i, j] := ABSums[i, j] + SumAB; Term6 := Term6 + sqr(SumAB); end; end; Term6 := Term6 / (NInGrp * NoSelected); Term7 := 0.0; for i := 0 to NoAGrps-1 do begin for k := 0 to NoSelected-1 do begin SumAC := 0.0; for j := 0 to NoBGrps-1 do SumAC := SumAC + ABCSums[i, j, k]; ACSums[i, k] := ACSums[i, k] + SumAC; Term7 := Term7 + sqr(SumAC); end; end; Term7 := Term7 / (NInGrp * NoBGrps); Term8 := 0.0; for j := 0 to NoBGrps-1 do begin for k := 0 to NoSelected-1 do begin SumBC := 0.0; for i := 0 to NoAGrps-1 do SumBC := SumBC + ABCSums[i, j, k]; BCSums[j, k] := BCSums[j, k] + SumBC; Term8 := Term8 + sqr(SumBC); end; end; Term8 := Term8 / (NInGrp * NoAGrps); Term9 := 0.0; for i := 0 to NoAGrps-1 do begin for j := 0 to NoBGrps-1 do begin for k := 0 to NoSelected-1 do begin SumABC := ABCSums[i, j, k]; //CountABC := CountABC + ABCNcnt[i,j,k]; Term9 := Term9 + sqr(SumABC); end; end; end; Term9 := Term9 / NInGrp; Term10 := 0.0; for i := 0 to NoCases-1 do Term10 := Term10 + SumPSqr[i]; Term10 := Term10 / NoSelected; //Get DF, SS, MS, F and Probabilities DFBetween := (NInGrp * NoAGrps * NoBGrps) - 1.0; DFA := NoAGrps - 1.0; DFB := NoBGrps - 1.0; DFAB := (NoAGrps - 1.0) * (NoBGrps - 1.0); DFerrorBetween := (NoAGrps * NoBGrps) * (NInGrp - 1.0); DFWithin := (NInGrp * NoAGrps * NoBGrps) * (NoSelected - 1.0); DFC := NoSelected - 1.0; DFAC := (NoAGrps - 1.0) * (NoSelected - 1.0); DFBC := (NoBGrps - 1.0) * (NoSelected - 1.0); DFABC := (NoAGrps - 1.0) * (NoBGrps - 1.0) * (NoSelected - 1.0); DFerrorWithin := NoAGrps * NoBGrps * (NInGrp - 1.0) * (NoSelected - 1.0); SSBetweenSubjects := Term10 - Term1; SSA := Term3 - Term1; SSB := Term4 - Term1; SSAB := Term6 - Term3 - Term4 + Term1; SSerrorBetween := Term10 - Term6; SSWithinSubjects := Term2 - Term10; SSC := Term5 - Term1; SSAC := Term7 - Term3 - Term5 + Term1; SSBC := Term8 - Term4 - Term5 + Term1; SSABC := Term9 - Term6 - Term7 - Term8 + Term3 + Term4 + Term5 - Term1; SSerrorWithin := Term2 - Term9 - Term10 + Term6; MSA := SSA / DFA; MSB := SSB / DFB; MSAB := SSAB / DFAB; MSerrorBetween := SSerrorBetween / DFerrorBetween; MSC := SSC / DFC; MSAC := SSAC / DFAC; MSBC := SSBC / DFBC; MSABC := SSABC / DFABC; MSerrorWithin := SSerrorWithin / DFerrorWithin; FA := MSA / MSerrorBetween; FB := MSB / MSerrorBetween; FAB := MSAB / MSerrorBetween; FC := MSC / MSerrorWithin; FAC := MSAC / MSerrorWithin; FBC := MSBC / MSerrorWithin; FABC := MSABC / MSerrorWithin; ProbA := ProbF(FA, DFA, DFerrorBetween); ProbB := ProbF(FB, DFB, DFerrorBetween); ProbAB := ProbF(FAB, DFAB, DFerrorBetween); ProbC := ProbF(FC, DFC, DFerrorWithin); ProbAC := ProbF(FAC, DFAC, DFerrorWithin); ProbBC := ProbF(FBC, DFBC, DFerrorWithin); ProbABC := ProbF(FABC, DFABC, DFerrorWithin); end; end; procedure TABRAnovaForm.Summarize(const AData: TABRAnovaData; AReport: TStrings); begin with AData do begin AReport.Add(DIVIDER_AUTO); AReport.Add('SOURCE DF SS MS F PROB.'); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add('Between Subjects %5.0f%14.3f', [DFBetween, SSBetweenSubjects]); AReport.Add(' A Effects %5.0f%14.3f%12.3f%10.3f%10.3f', [DFA, SSA, MSA, FA, ProbA]); AReport.Add(' B Effects %5.0f%14.3f%12.3f%10.3f%10.3f', [DFB, SSB, MSB, FB, ProbB]); AReport.Add(' AB Effects %5.0f%14.3f%12.3f%10.3f%10.3f', [DFAB, SSAB, MSAB, FAB, ProbAB]); AReport.Add(' Error Between %5.0f%14.3f%12.3f', [DFerrorBetween, SSerrorBetween, MSerrorBetween]); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add('Within Subjects %5.0f%14.3f', [DFWithin, SSWithinSubjects]); AReport.Add(' C Replications %5.0f%14.3f%12.3f%10.3f%10.3f', [DFC, SSC, MSC, FC, ProbC]); AReport.Add(' AC Effects %5.0f%14.3f%12.3f%10.3f%10.3f', [DFAC, SSAC, MSAC, FAC, ProbAC]); AReport.Add(' BC Effects %5.0f%14.3f%12.3f%10.3f%10.3f', [DFBC, SSBC, MSBC, FBC, ProbBC]); AReport.Add(' ABC Effects %5.0f%14.3f%12.3f%10.3f%10.3f', [DFABC, SSABC, MSABC, FABC, ProbABC]); AReport.Add(' Error Within %5.0f%14.3f%12.3f', [DFerrorWithin, SSerrorWithin, MSerrorWithin]); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add('Total %5.0f%14.3f', [DFBetween + DFWithin, SSBetweenSubjects + SSWithinSubjects]); AReport.Add(DIVIDER_AUTO); end; FReportFrame.DisplayReport(AReport); AReport.Clear; end; procedure TABRAnovaForm.MeansReport(const AData: TABRAnovaData; AReport: TStrings); var ColLabels: StrDyneVec = nil; RowLabels: StrDyneVec = nil; AMatrix: DblDyneMat = nil; {%H-}ColHeader: string; Title: string; i, j, k, row: integer; begin AReport.Clear; Title := 'ABR Means Table'; ColHeader := 'Repeated Measures'; SetLength(AMatrix, MaxRows, NoSelected); SetLength(RowLabels, MaxRows); SetLength(ColLabels, NoSelected); row := 0; for i := 0 to AData.NoAGrps-1 do begin for j := 0 to AData.NoBGrps-1 do begin RowLabels[row] := Format('A%d B%d',[i+1, j+1]); for k := 0 to NoSelected-1 do begin AMatrix[row, k] := AData.ABCSums[i, j, k] / AData.NInGrp; ColLabels[k] := OS3MainFrm.DataGrid.Cells[ColNoSelected[k], 0]; end; inc(row); end; end; MatPrint(AMatrix, MaxRows, NoSelected, Title, RowLabels, ColLabels, AData.NInGrp, AReport); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add(''); Title := 'AB Means Table'; ColHeader := 'B Levels'; SetLength(AMatrix, AData.NoAGrps, AData.NoBGrps); SetLength(RowLabels, AData.NoAGrps); SetLength(ColLabels, AData.NoBGrps); for i := 0 to AData.NoAGrps-1 do begin RowLabels[i] := Format('A%d',[i+1]); for j := 0 to AData.NoBGrps-1 do AMatrix[i, j] := AData.ABSums[i, j] / (AData.NInGrp * NoSelected); end; for j := 0 to AData.NoBGrps-1 do ColLabels[j] := Format('B %d',[j+1]); MatPrint(AMatrix, AData.NoAgrps, AData.NoBgrps, Title, RowLabels, ColLabels, AData.NinGrp*NoSelected, AReport); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add(''); Title := 'AC Means Table'; ColHeader := 'C Levels'; SetLength(AMatrix, AData.NoAGrps, NoSelected); SetLength(RowLabels, AData.NoAGrps); SetLength(ColLabels, NoSelected); for i := 0 to AData.NoAGrps-1 do begin RowLabels[i] := Format('A%d',[i+1]); for j := 0 to NoSelected-1 do AMatrix[i, j] := AData.ACSums[i, j] / (AData.NInGrp * AData.NoBGrps); end; for j := 0 to NoSelected-1 do ColLabels[j] := Format('C%d',[j+1]); MatPrint(AMatrix, AData.NoAGrps, NoSelected, Title, RowLabels, ColLabels, AData.NInGrp*AData.NoBGrps, AReport); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add(''); Title := 'BC Means Table'; ColHeader := 'C Levels'; SetLength(AMatrix, AData.NoBGrps, NoSelected); SetLength(RowLabels, AData.NoBGrps); SetLength(ColLabels, NoSelected); for i := 0 to AData.NoBGrps-1 do begin RowLabels[i] := Format('B%d',[i+1]); for j := 0 to NoSelected-1 do AMatrix[i, j] := AData.BCSums[i, j] / (AData.NInGrp * AData.NoAGrps); end; for j := 0 to NoSelected-1 do ColLabels[j] := Format('C%d', [j+1]); MatPrint(AMatrix, AData.NoBGrps, NoSelected, Title, RowLabels, ColLabels, AData.NInGrp*AData.NoAGrps, AReport); FMeansReportFrame.DisplayReport(AReport); AReport.Clear; end; procedure TABRAnovaForm.BoxTests(const AData: TABRAnovaData; AReport: TStrings); const EPS = 1E-35; var errorcode: Boolean = false; // to silence the compiler XVector: DblDyneVec = nil; XSums: DblDyneVec = nil; DetMat: DblDyneMat = nil; ColLabels: StrDyneVec = nil; RowLabels: StrDyneVec = nil; AMatrix: DblDyneMat = nil; PooledMat: DblDyneMat = nil; M1, M2, Sum1, C1, C2, f1, f2, chi, ProbChi, X, avgvar, avgcov: double; {%H-}ColHeader, LabelStr: string; Title: string; i, j, k, l, row, SubjA, SubjB, N, p, quad : integer; Det: Double = 0.0; begin AReport.Clear; SetLength(XVector, NoSelected); SetLength(XSums, NoSelected); SetLength(DetMat, NoSelected+1, NoSelected+1); SetLength(ColLabels, NoSelected); SetLength(RowLabels, NoSelected); SetLength(AMatrix, NoSelected, NoSelected); SetLength(PooledMat, NoSelected, NoSelected); for i := 0 to NoSelected-1 do begin RowLabels[i] := Format('C%d', [i+1]); ColLabels[i] := RowLabels[i]; for j := 0 to NoSelected-1 do PooledMat[i, j] := 0.0; end; // get variance-covariance AMatrix for the repeated measures within // each combination of A and B levels. Pool them for the pooled // covariance AMatrix. Get Determinants of each AMatrix. //OutputFrm.Clear; Sum1 := 0.0; for i := 1 to AData.NoAGrps do begin for j := 1 to AData.NoBGrps do begin LabelStr := Format('Variance-Covariance AMatrix for A%d B%d', [i,j]); Title := LabelStr; ColHeader := 'C Levels'; // initialize AMatrix for this combination for k := 0 to NoSelected-1 do begin for L := 0 to NoSelected-1 do AMatrix[k,0] := 0.0; XSums[k] := 0.0; end; // read data and add to covariances for row := 1 to NoCases do begin if not DataProcs.GoodRecord(row, selected, ColNoSelected) then continue; SubjA := round(StrToFLoat(Trim(OS3MainFrm.DataGrid.Cells[ACol, row]))); SubjA := SubjA - MinA + 1; SubjB := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[BCol, row]))); SubjB := SubjB - MinB + 1; if ((SubjA <> i)or(SubjB <> j)) then continue; for k := 0 to NoSelected-1 do begin X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[k], row])); XVector[k] := X; XSums[k] := XSums[k] + X; end; for k := 0 to NoSelected-1 do begin for L := 0 to NoSelected-1 do AMatrix[k, L] := AMatrix[k, L] + (XVector[k] * XVector[L]); end; end; // next case // convert sums of cross-products to variance-covariance for k := 0 to NoSelected-1 do begin for L := 0 to NoSelected-1 do begin AMatrix[k, L] := AMatrix[k, L] - (XSums[k]*XSums[L] / AData.NInGrp); AMatrix[k, L] := AMatrix[k, L] / (AData.NInGrp - 1); PooledMat[k, L] := PooledMat[k, L] + AMatrix[k, L]; end; end; MatPrint(AMatrix, NoSelected, NoSelected, Title, RowLabels, ColLabels, NoCases, AReport); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add(''); for k := 0 to NoSelected-1 do for L := 0 to NoSelected-1 do DetMat[k, L] := AMatrix[k, L]; Determ(DetMat, NoSelected, NoSelected, Det, errorcode); // if (Det > 0.0e35) then // wp: What's this??? if Det > EPS then Sum1 := sum1 + (AData.NInGrp * ln(Det)) else MessageDlg('Determinant of a covariance AMatrix <= 0.', mtWarning, [mbOK], 0); end;// next B level end; // next A level // Get pooled variance-covariance for i := 0 to NoSelected-1 do for j := 0 to NoSelected-1 do PooledMat[i, j] := PooledMat[i, j] / (AData.NoAGrps * AData.NoBGrps); Title := 'Pooled Variance-Covariance AMatrix'; MatPrint(PooledMat, NoSelected, NoSelected, Title, RowLabels, ColLabels, NoCases, AReport); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add(''); // Calculate F-Max for variance homogeneity // Calculate Box test for covariance homogeneity for i := 0 to NoSelected-1 do for j := 0 to NoSelected-1 do DetMat[i, j] := PooledMat[i, j]; Determ(DetMat, NoSelected, NoSelected, Det, errorcode); if (Det > EPS) then begin with AData do begin M1 := (NinGrp*NoAGrps*NoBGrps * ln(Det)) - Sum1; C1 := (2.0 * NoSelected * NoSelected + 3.0 * NoSelected - 1.0) / (6.0 * (NoSelected+1) * (NoAGrps * NoBGrps - 1.0)); C1 := C1 * ( (NoAGrps * NoBGrps * (1.0 / NinGrp)) - (1.0 / (NinGrp * NoAGrps * NoBGrps))); f1 := (NoSelected * (NoSelected + 1.0) * (NoAGrps * NoBGrps - 1.0))/2.0; end; chi := (1.0 - C1) * M1; ProbChi := 1.0 - ChiSquaredProb(chi, round(f1)); AReport.Add('Test that sample covariances are from same population:'); AReport.Add(''); AReport.Add('Chi-Squared: %0.3f with %d degrees of freedom.', [chi, round(f1)]); AReport.Add('Probability of > Chi-Squared: %0.3f', [ProbChi]); AReport.Add(''); AReport.Add(DIVIDER_SMALL_AUTO); AReport.Add(''); end else ErrorMsg('Determinant of a pooled covariance AMatrix near 0.'); // test that pooled covariance has form of equal variances and equal covariances //if (Det > 0.0e35) then // determinant of pooled covariance > 0 if (Det > EPS) then begin M2 := Det; avgvar := 0.0; for i := 0 to NoSelected-1 do avgvar := avgvar + PooledMat[i, i]; avgvar := avgvar / NoSelected; avgcov := 0.0; for i := 1 to NoSelected-1 do for j := i+1 to NoSelected do avgcov := avgcov + PooledMat[i-1,j-1]; avgcov := avgcov / (NoSelected * (NoSelected - 1) / 2); for i := 0 to NoSelected do DetMat[i, i] := avgvar; for i := 1 to NoSelected-1 do begin for j := i+1 to NoSelected do begin DetMat[i-1,j-1] := avgcov; DetMat[j-1,i-1] := avgcov; end; end; Determ(DetMat, NoSelected, NoSelected, Det, errorcode); if (Det > EPS) then begin with AData do begin N := NoAGrps * NoBGrps * NinGrp; p := NoAGrps * NoBGrps; end; quad := NoSelected * NoSelected + NoSelected - 4; M2 := ln(M2 / Det); M2 := -(N - p) * M2; C2 := NoSelected * (NoSelected + 1) * (NoSelected + 1) * (2 * NoSelected - 3); C2 := C2 / (6 * (N - p) * (NoSelected - 1) * quad); f2 := quad / 2; chi := (1.0 - C2) * M2; ProbChi := 1.0 - ChiSquaredProb(chi, round(f2)); AReport.Add('Test that variance-covariances AMatrix has equal variances and equal covariances:'); AReport.Add(''); AReport.Add('Chi-Squared: %0.3f with %d degrees of freedom.', [chi, round(f2)]); AReport.Add('Probability of > Chi-Squared: %.3f', [ProbChi]); end else ErrorMsg('Determinant of theoretical covariance AMatrix near zero.'); end; FBoxTestsReportFrame.DisplayReport(AReport); AReport.Clear; end; procedure TABRAnovaForm.PlotMeans(AInteraction: TInteraction); const X_TITLE: array[TInteraction] of string = ( 'B Treatment Group', 'C Treatment (within subjects) Group', 'C Treatment (within subjects) Group' ); SERIES_TITLE: array[TInteraction] of string = ( 'A%d', 'A%d', 'B%d' ); var serSource: TListChartSource; i: Integer; begin case AInteraction of AB: serSource := ListChartSource_AB; AC: serSource := ListChartSource_AC; BC: serSource := ListChartSource_BC; end; FBarSeries.Source := serSource; Set3DPlot(ThreeDChk.Checked); ChartStyles.Styles.Clear; for i := 0 to serSource.YCount-1 do begin with TChartStyle(ChartStyles.Styles.Add) do begin Text := Format(SERIES_TITLE[AInteraction], [i+1]); Brush.Color := DATA_COLORS[i mod Length(DATA_COLORS)]; UseBrush := true; end; end; FChartFrame.Chart.BottomAxis.Marks.Source := FBarSeries.Source; FChartFrame.Chart.BottomAxis.Marks.Style := smsXValue; FChartFrame.SetTitle('AxBxR ANOVA'); FChartFrame.SetXTitle(X_TITLE[AInteraction]); FChartFrame.SetYTitle('Means'); end; procedure TABRAnovaForm.PreparePlot(const AData: TABRAnovaData); var idx: Integer; item: PChartDataItem; i, j: Integer; begin FChartFrame.Clear; ListChartSource_AB.Clear; ListChartSource_AC.Clear; ListChartSource_BC.Clear; ChartStyles.Styles.Clear; ListChartSource_AB.YCount := AData.NoAGrps; for j := 0 to AData.NoBGrps-1 do begin idx := ListChartSource_AB.Add(j+1, 0); item := ListChartSource_AB.Item[idx]; for i := 0 to AData.NoAGrps-1 do item^.SetY(i, AData.ABSums[i, j] / (AData.NInGrp * NoSelected)); end; ListChartSource_AC.YCount := AData.NoAGrps; for j := 0 to NoSelected-1 do begin idx := ListChartSource_AC.Add(j+1, 0); item := ListChartSource_AC.Item[idx]; for i := 0 to AData.NoAGrps-1 do item^.SetY(i, AData.ACSums[i, j] / (AData.NInGrp * AData.NoBGrps)); end; ListChartSource_BC.YCount := AData.NoBGrps; for j := 0 to NoSelected-1 do begin idx := ListChartSource_BC.Add(j+1, 0); item := ListChartSource_BC.Item[idx]; for i := 0 to AData.NoBGrps-1 do item^.SetY(i, AData.BCSums[i, j] / (AData.NInGrp * AData.NoAGrps)); end; FBarSeries := FChartFrame.PlotXY(ptBars, nil, nil, nil, nil, '', clDefault) as TBarSeries; with FBarSeries do begin Legend.Multiplicity := lmStyle; Stacked := false; Styles := ChartStyles; {$IF LCL_FullVersion >= 2010000} DepthBrightnessDelta := -30; {$IFEND} end; end; procedure TABRAnovaForm.Reset; var i: integer; begin inherited; ListChartSource_AB.Clear; ListChartSource_AC.Clear; ListChartSource_BC.Clear; BoxTestsPage.TabVisible := false; ChartPage.TabVisible := false; VarList.Items.Clear; CList.Items.Clear; ACodesEdit.Text := ''; BCodesEdit.Text := ''; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i, 0]); PlotChk.Checked := false; TestChk.Checked := false; UpdateBtnStates; end; procedure TABRAnovaForm.Set3DPlot(AEnable: Boolean); const DEPTH: array[boolean] of Integer = (0, 20); begin if (FBarSeries <> nil) then begin FBarSeries.Depth := DEPTH[AEnable]; FChartFrame.Chart.LeftAxis.Grid.Visible := not AEnable; end; end; procedure TABRAnovaForm.ThreeDChkChange(Sender: TObject); begin Set3DPlot(ThreeDChk.Checked); end; procedure TABRAnovaForm.UpdateBtnStates; var lSelected: Boolean; i: Integer; begin inherited; AInBtn.Enabled := (VarList.ItemIndex > -1) and (ACodesEdit.Text = ''); AOutBtn.Enabled := (ACodesEdit.Text <> ''); BInBtn.Enabled := (VarList.ItemIndex > -1) and (BCodesEdit.Text = ''); BOutBtn.Enabled := (BCodesEdit.Text <> ''); lSelected := false; for i := 0 to VarList.Items.Count-1 do if VarList.Selected[i] then begin lSelected := true; break; end; CInBtn.Enabled := lSelected; lSelected := false; for i := 0 to CList.Items.Count-1 do if CList.Selected[i] then begin lSelected := true; break; end; COutBtn.Enabled := lSelected; end; function TABRAnovaForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; begin Result := false; if ACodesEdit.Text = '' then begin AMsg := 'Factor A variable not specified.'; AControl := ACodesEdit; exit; end; if BCodesEdit.Text = '' then begin AMsg := 'Factor B variable not specified.'; AControl := BCodesEdit; exit; end; if CList.Items.Count <= 1 then begin if CList.Items.Count = 0 then AMsg := 'No Repeated Measures variable(s) specified.' else AMsg := 'There must be at least one Repeated Measures variable.'; AControl := CList; exit; end; Result := true; end; procedure TABRAnovaForm.VarListDblClick(Sender: TObject); var index: Integer; s: String; begin index := VarList.ItemIndex; if index > -1 then begin s := VarList.Items[index]; if ACodesEdit.Text = '' then ACodesEdit.Text := s else if BCodesEdit.Text = '' then BCodesEdit.Text := s else CList.Items.Add(s); VarList.Items.Delete(index); UpdateBtnStates; end; end; end.