// Use file "abrdata.laz" for testing unit AxSANOVAUnit; {$mode objfpc}{$H+} {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, TAStyles, MainUnit, Globals, ReportFrameUnit, BasicStatsReportAndChartFormUnit; type { TAxSAnovaForm } TAxSAnovaForm = class(TBasicStatsReportAndChartForm) ChartStyles: TChartStyles; PosthocChk: TCheckBox; DepInBtn: TBitBtn; DepOutBtn: TBitBtn; RepInBtn: TBitBtn; RepOutBtn: TBitBtn; PlotChk: TCheckBox; GrpVarEdit: TEdit; GroupBox1: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; RepList: TListBox; PosthocPage: TTabSheet; VarList: TListBox; procedure DepInBtnClick(Sender: TObject); procedure DepOutBtnClick(Sender: TObject); procedure GrpVarEditChange(Sender: TObject); procedure RepInBtnClick(Sender: TObject); procedure RepListDblClick(Sender: TObject); procedure RepOutBtnClick(Sender: TObject); procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); private FPosthocReportFrame: TReportFrame; procedure Plot(AMeans: DblDyneMat; ANumRows, ANumCols: Integer); procedure PostHocTests(NoSelected: integer; MSerr: double; dferr: integer; Count: integer; ColMeans: DblDyneVec; AReport: TStrings); 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 AxSAnovaForm: TAxSAnovaForm; implementation {$R *.lfm} uses Math, StrUtils, TAChartUtils, TALegend, TACustomSource, TACustomSeries, TASeries, ANOVATestsUnit, Utils, GridProcs, MathUnit, ChartFrameUnit; const COL_WIDTH = 10; { TAxSAnovaForm } constructor TAxSAnovaForm.Create(AOwner: TComponent); begin inherited; FPosthocReportFrame := TReportFrame.Create(PostHocPage); FPosthocReportFrame.Parent := PostHocPage; FPosthocReportFrame.Align := alClient; InitToolbar(FPosthocReportFrame.ReportToolbar, tpTop); PostHocPage.PageIndex := 1; FChartFrame.Chart.Margins.Bottom := 0; FChartFrame.Chart.BottomAxis.AxisPen.Visible := true; end; procedure TAxSAnovaForm.AdjustConstraints; begin inherited; ParamsPanel.Constraints.MinWidth := Max( 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left, GroupBox1.Width ); ParamsPanel.Constraints.MinHeight := RepOutBtn.Top + RepOutBtn.Height + GroupBox1.BorderSpacing.Top + GroupBox1.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height; end; procedure TAxSAnovaForm.Compute; var C: DblDyneMat = nil; StdDev: DblDyneMat = nil; squaredsumx: DblDyneVec = nil; sumxsquared: DblDyneVec = nil; coltot: DblDyneVec = nil; sumsum: DblDyneVec = nil; ColNoSelected: IntDyneVec = nil; N: IntDyneVec = nil; a1, a2, agrp, i, j, k, v1, totaln, NoSelected, range: integer; group, col: integer; p, X, Xsq, f1, f2, f3, probf1, probf2, probf3, fd1, fd2, TotMean: double; TotStdDev, den: double; degfree: array[1..8] of integer; ss: array[1..8] of double; ms: array[1..8] of double; coeff: array[1..6] of double; outline, separatorLine: string; lReport: TStrings; begin SetLength(ColNoSelected, NoVariables+1); // Get between subjects group variable v1 := GetVariableIndex(OS3MainFrm.DataGrid, GrpVarEdit.Text); ColNoSelected[0] := v1; // A treatment (group) variable // Get items selected for repeated measures (B treatments) for i := 0 to RepList.Items.Count - 1 do ColNoSelected[i+1] := GetVariableIndex(OS3MainFrm.DataGrid, RepList.Items[i]); // +1 because grp var is at index 0 NoSelected := RepList.Items.Count + 1; SetLength(ColNoSelected, NoSelected); // Trim array to correct size //get minimum and maximum group codes for Treatment A a1 := MaxInt; a2 := -MaxInt; for i := 1 to NoCases do Begin if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue; group := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1, i]))); if group < a1 then a1 := group; if group > a2 then a2 := group; end; range := a2 - a1 + 1; k := NoSelected - 1; //Number of B (within subject) treatment levels // allocate heap SetLength(C, range+1, NoSelected+1); // wp: why +1? SetLength(N, range+1); SetLength(squaredsumx, range+1); SetLength(coltot, NoSelected+1); SetLength(sumxsquared, range+1); SetLength(sumsum, range+1); SetLength(StdDev, range+1, NoSelected+1); // initialize arrays for i := 0 to range-1 do begin N[i] := 0; squaredsumx[i] := 0.0; sumxsquared[i] := 0.0; sumsum[i] := 0.0; for j := 0 to k-1 do C[i,j] := 0.0; end; for j := 0 to k-1 do coltot[j] := 0.0; for i := 0 to range do for j := 0 to k do StdDev[i,j] := 0.0; for i := 1 to 6 do coeff[i] := 0.0; for i := 1 to 8 do degfree[i] := 0; TotStdDev := 0.0; TotMean := 0.0; totaln := 0; //Read data values and get sums and sums of squared values for i := 1 to NoCases do begin if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue; agrp := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1, i]))); agrp := agrp - a1; p := 0.0; //Now read the B treatment scores for j := 0 to k-1 do begin col := ColNoSelected[j+1]; // Offset +1 because Grp var is at index 0 if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue; X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, i])); Xsq := X * X; C[agrp, j] := C[agrp, j] + X; StdDev[agrp, j] := StdDev[agrp, j] + Xsq; coeff[1] := coeff[1] + X; p := p + X; sumxsquared[agrp] := sumxsquared[agrp] + Xsq; TotMean := TotMean + X; TotStdDev := TotStdDev + Xsq; end; N[agrp] := N[agrp] + 1; squaredsumx[agrp] := squaredsumx[agrp] + p * p; sumsum[agrp] := sumsum[agrp] + p; end; // next case // Obtain sums of squares for std. dev.s of B treatments for i := 0 to k-1 do // column (B treatments) for j := 0 to range-1 do // group of A treatments StdDev[range, i] := StdDev[range, i] + StdDev[j, i]; // Obtain sums of squares for std. dev.s of A treatments for i := 0 to range-1 do for j := 0 to k-1 do StdDev[i, k] := StdDev[i, k] + StdDev[i, j]; // Obtain cell standard deviations for i := 0 to range-1 do // rows for j := 0 to k-1 do // columns StdDev[i, j] := sqrt((StdDev[i, j] - sqr(C[i, j]) / N[i]) / (N[i] - 1)); // Obtain A treatment group standard deviations for i := 0 to range-1 do begin StdDev[i, k] := StdDev[i, k] - ((sumsum[i] * sumsum[i]) / (k * N[i])); StdDev[i, k] := StdDev[i, k] / (k * N[i] - 1); StdDev[i, k] := sqrt(StdDev[i, k]); end; // Obtain coefficients for the sums of squares for i := 0 to range-1 do begin coeff[2] := coeff[2] + sumxsquared[i]; coeff[3] := coeff[3] + ((sumsum[i] * (sumsum[i]) / ((N[i] * k)))); coeff[6] := coeff[6] + squaredsumx[i]; totaln := totaln + N[i]; end; coeff[1] := (coeff[1] * coeff[1]) / (totaln * k); den := k; coeff[6] := coeff[6] / den; for j := 1 to k do begin coltot[j-1] := 0.0; for i := 1 to range do begin coltot[j-1] := coltot[j-1] + C[i-1,j-1]; coeff[5] := coeff[5] + ((C[i-1,j-1] * C[i-1,j-1]) / N[i-1]); end; coeff[4] := coeff[4] + (coltot[j-1] * coltot[j-1]); end; den := totaln; coeff[4] := coeff[4] / den; // Obtain B treatment group standard deviations for j := 0 to k-1 do begin StdDev[range, j] := StdDev[range, j] - ((coltot[j] * coltot[j]) / totalN); StdDev[range, j] := StdDev[range, j] / (totalN-1); StdDev[range, j] := sqrt(StdDev[range, j]); end; // Calculate degrees of freedom for the mean squares degfree[1] := totaln - 1; // Between subjects degrees freedom degfree[2] := a2 - a1; // between groups degrees of freedom degfree[3] := totaln - (a2 - a1 + 1);// subjects within groups deg. frd. degfree[4] := totaln * (k - 1); // within subjects degrees of freedom degfree[5] := k - 1; // B treatments degrees of freedom degfree[6] := degfree[2] * degfree[5]; // A x B interaction degrees of frd. degfree[7] := degfree[3] * degfree[5]; // B x Subjects within groups d.f. degfree[8] := k * totaln - 1; // total degrees of freedom // Calculate the sums of squares ss[1] := coeff[6] - coeff[1]; ss[2] := coeff[3] - coeff[1]; ss[3] := coeff[6] - coeff[3]; ss[4] := coeff[2] - coeff[6]; ss[5] := coeff[4] - coeff[1]; ss[6] := coeff[5] - coeff[3] - coeff[4] + coeff[1]; ss[7] := coeff[2] - coeff[5] - coeff[6] + coeff[3]; ss[8] := coeff[2] - coeff[1]; // Calculate the mean squares for i := 1 to 8 do ms[i] := ss[i] / degfree[i]; // Calculate the f-tests for effects A, B and interaction if (ms[3] > 0.0) then f1 := ms[2] / ms[3] else f1 := 1000.0; if (ms[7] > 0.0) then begin f2 := ms[5] / ms[7]; f3 := ms[6] / ms[7]; end else begin f2 := 1000.0; f3 := 1000.0; end; //Now, report results lReport := TStringList.Create; try lReport.Add('ANOVA With One Between Subjects and One Within Subjects Treatments'); lReport.Add(''); lReport.Add('------------------------------------------------------------------'); lReport.Add('Source df SS MS F Prob.'); lReport.Add('------------------------------------------------------------------'); fd1 := degfree[2]; fd2 := degfree[3]; probf1 := ProbF(f1, fd1, fd2); fd1 := degfree[5]; fd2 := degfree[7]; probf2 := ProbF(f2, fd1, fd2); fd1 := degfree[6]; fd2 := degfree[7]; probf3 := ProbF(f3, fd1, fd2); lReport.Add('Between %5d %10.3f', [degfree[1], ss[1]]); lReport.Add(' Groups (A) %5d %10.3f %10.3f %10.3f %6.4f', [degfree[2], ss[2], ms[2], f1, probf1]); lReport.Add(' Subjects w.g.%5d %10.3f %10.3f', [degfree[3], ss[3], ms[3]]); lReport.Add(''); lReport.Add('Within Subjects %5d %10.3f', [degfree[4], ss[4]]); lReport.Add(' B Treatments %5d %10.3f %10.3f %10.3f %6.4f', [degfree[5], ss[5], ms[5], f2, probf2]); lReport.Add(' A X B inter. %5d %10.3f %10.3f %10.3f %6.4f', [degfree[6], ss[6], ms[6], f3, probf3]); lReport.Add(' B X S w.g. %5d %10.3f %10.3f', [degfree[7], ss[7], ms[7]]); lReport.Add(''); lReport.Add('TOTAL %5d %10.3f', [degfree[8], ss[8]]); lReport.Add('------------------------------------------------------------------'); //Calculate and print means for i := 0 to range-1 do begin for j := 1 to k do C[i, j-1] := C[i, j-1] / N[i]; //mean of each B treatment within A treatment sumsum[i] := sumsum[i] / (N[i] * k); //means in A treatment accross B treatments end; for j := 0 to k-1 do coltot[j] := coltot[j] / totalN; TotStdDev := TotStdDev - ((TotMean * TotMean) / (k * totalN)); TotStdDev := TotStdDev / (k * totalN - 1); TotStdDev := sqrt(TotStdDev); TotMean := TotMean / (k * totalN); lReport.Add(''); lReport.Add('MEANS'); separatorLine := DupeString('-', COL_WIDTH + (k+1)*(COL_WIDTH + 2)- 2); lReport.Add(separatorLine); outline := Format('%*s ', [COL_WIDTH-1, 'Treatment']);; for i := 0 to k-1 do outline := outline + CenterString('B'+IntToStr(i+1), COL_WIDTH) + ' '; outline := outline + CenterString('TOTAL', COL_WIDTH); lReport.Add(outline); outline := DupeString(' ', COL_WIDTH-1) + '+'; for i := 0 to k-1 do outline := outline + DupeString('-', COL_WIDTH) + ' '; outline := outline + DupeString('-', COL_WIDTH); lReport.Add(outline); for i := 0 to range-1 do begin outline := Format('%*s |', [COL_WIDTH-2, 'A' + IntToStr(i+a1)]); for j := 0 to k-1 do outline := outline + Format('%*.3f ', [COL_WIDTH, C[i, j]]); outline := outline + Format('%*.3f', [COL_WIDTH, sumSum[i]]); lReport.Add(outline); end; outline := Format('%*s |', [COL_WIDTH-2, 'TOTAL']);; for j := 0 to k-1 do outline := outline + Format('%*.3f ', [COL_WIDTH, coltot[j]]); outline := outline + Format('%*.3f', [COL_WIDTH, TotMean]); lReport.Add(outline); lReport.Add(separatorLine); // Print standard deviations lReport.Add(''); lReport.Add('STANDARD DEVIATIONS'); lReport.Add(separatorLine); outline := Format('%*s ', [COL_WIDTH-1, 'Treatment']);; for i := 0 to k-1 do outline := outline + CenterString('B'+IntToStr(i+1), COL_WIDTH) + ' '; outline := outline + CenterString('TOTAL', COL_WIDTH); lReport.Add(outline); outline := DupeString(' ', COL_WIDTH-1) + '+'; for i := 0 to k-1 do outline := outline + DupeString('-', COL_WIDTH) + ' '; outline := outline + DupeString('-', COL_WIDTH); lReport.Add(outline); for i := 0 to range-1 do begin outline := Format('%*s |', [COL_WIDTH-2, 'A' + IntToStr(i+a1)]); for j := 0 to k-1 do outline := outline + Format('%*.3f ', [COL_WIDTH, StdDev[i, j]]); outline := outline + Format('%*.3f', [COL_WIDTH, StdDev[i, k]]); lReport.Add(outline); end; outline := Format('%*s |', [COL_WIDTH-2, 'TOTAL']);; for j := 0 to k-1 do outline := outline + Format('%*.3f ', [COL_WIDTH, StdDev[range, j]]); outline := outline + Format('%*.3f', [COL_WIDTH, TotStdDev]); lReport.Add(outline); lReport.Add(separatorLine); FReportFrame.DisplayReport(lReport); if PosthocChk.Checked then begin lReport.Clear; // Do tests for the A (between groups) lReport.Add('********************************************'); lReport.Add('* COMPARISONS FOR THE BETWEEN-GROUP MEANS *'); lReport.Add('*********************************************'); PostHocTests(range, MS[1], degfree[1], range, sumsum, lReport); lReport.Add(''); // Do tests for the B (repeated measures) lReport.Add(''); lReport.Add('*************************************************'); lReport.Add('* COMPARISONS FOR THE REPEATED-MEASURES MEANS *'); lReport.Add('*************************************************'); PostHocTests(k, ms[4], degfree[4], NoCases, coltot, lReport); FPostHocReportFrame.DisplayReport(lReport); PostHocPage.TabVisible := true; end else PostHocPage.TabVisible := false; finally lReport.Free; end; Plot(C, range, k); (* if PlotChk.Checked then // PlotMeans(C,range,k,this) begin ChartPage.TabVisible := true; maxmean := 0.0; SetLength(GraphFrm.Ypoints,range,k); SetLength(GraphFrm.Xpoints,1,k); for i := 1 to range do begin GraphFrm.SetLabels[i] := 'A ' + IntToStr(i); for j := 1 to k do begin GraphFrm.Ypoints[i-1,j-1] := C[i-1,j-1]; if C[i-1,j-1] > maxmean then maxmean := C[i-1,j-1]; end; end; for j := 1 to k do begin coltot[j-1] := j; GraphFrm.Xpoints[0,j-1] := j; end; GraphFrm.nosets := range; GraphFrm.nbars := k; GraphFrm.Heading := 'TREATMENTS X SUBJECT REPLICATIONS ANOVA'; GraphFrm.XTitle := 'WITHIN (B) TREATMENT GROUP'; GraphFrm.YTitle := 'Mean'; GraphFrm.barwideprop := 0.5; GraphFrm.AutoScaled := false; GraphFrm.GraphType := 2; // 3d Vertical Bar Chart GraphFrm.miny := 0.0; GraphFrm.maxy := maxmean; GraphFrm.BackColor := clCream; GraphFrm.WallColor := clDkGray; GraphFrm.FloorColor := clLtGray; GraphFrm.ShowBackWall := true; GraphFrm.ShowModal; end else ChartPage.TabVisible := false; *) end; procedure TAxSAnovaForm.DepInBtnClick(Sender: TObject); var index: integer; begin index := VarList.ItemIndex; if (index > -1) and (GrpVarEdit.Text = '') then begin GrpVarEdit.Text := VarList.Items[index]; VarList.Items.Delete(index); end; VarList.ItemIndex := -1; UpdateBtnStates; end; procedure TAxSAnovaForm.DepOutBtnClick(Sender: TObject); begin if GrpVarEdit.Text <> '' then begin VarList.Items.Add(GrpVarEdit.Text); GrpVarEdit.Text := ''; end; UpdateBtnStates; end; procedure TAxSAnovaForm.GrpVarEditChange(Sender: TObject); begin UpdateBtnStates; end; procedure TAxSAnovaForm.Plot(AMeans: DblDyneMat; ANumRows, ANumCols: Integer); var ser: TChartSeries; i, j, idx: Integer; item: PChartDataItem; begin if not PlotChk.Checked then begin ChartPage.TabVisible := false; exit; end; FChartFrame.Clear; FChartFrame.SetTitle('Treatments x Subject Replications ANOVA'); FChartFrame.SetXTitle('Within (B) Treatment Group'); FChartFrame.SetYTitle('Mean'); ser := FChartFrame.PlotXY(ptBars, nil, nil, nil, nil, '', DATA_COLORS[0]); ser.ListSource.YCount := ANumRows; for j := 0 to ANumCols-1 do begin idx := ser.AddXY(j+1, NaN); item := ser.Source.Item[idx]; for i := 0 to ANumRows-1 do item^.SetY(i, AMeans[i, j]); end; with (ser as TBarSeries) do begin Stacked := false; Styles := ChartStyles; Legend.Multiplicity := lmStyle; end; for i := 0 to ANumRows-1 do begin with TChartStyle(ChartStyles.Styles.Add) do begin Brush.Color := DATA_COLORS[i mod Length(DATA_COLORS)]; UseBrush := true; Text := 'A' + IntToStr(i+1); end; end; FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source; FChartFrame.Chart.BottomAxis.Marks.Style := smsXValue; //FChartFrame.Chart.Legend.Visible := false; ChartPage.TabVisible := true; end; procedure TAxSAnovaForm.PostHocTests(NoSelected: Integer; MSerr: double; dferr: integer; Count: integer; ColMeans: DblDyneVec; AReport: TStrings); var groupTotal: DblDyneVec = nil; groupCount: IntDyneVec = nil; i, mingrp: integer; alpha: Double; begin SetLength(groupTotal ,NoSelected); SetLength(groupCount, NoSelected); for i := 0 to NoSelected - 1 do begin groupCount[i] := Count; groupTotal[i] := ColMeans[i] * Count;; end; mingrp := 1; alpha := DEFAULT_ALPHA_LEVEL; Tukey(MSerr, DFerr, Count, groupTotal, groupCount, mingrp, NoSelected, alpha, AReport); Tukey_Kramer(MSerr, dferr, Count, groupTotal, groupCount, mingrp, NoSelected, alpha, AReport); TukeyBTest(MSerr, dferr, groupTotal, groupCount, mingrp,NoSelected, Count, alpha, AReport); ScheffeTest(MSerr, groupTotal, groupCount, mingrp, NoSelected, Count*NoSelected, alpha, AReport); Newman_Keuls(MSerr, dferr, Count, groupTotal, groupCount, mingrp, NoSelected, alpha, AReport); end; procedure TAxSAnovaForm.RepInBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < VarList.Items.Count do begin if (VarList.Selected[i]) then begin RepList.Items.Add(VarList.Items[i]); VarList.Items.Delete(i); i := 0; end else inc(i); end; VarList.ItemIndex := -1; UpdateBtnStates; end; procedure TAxSAnovaForm.RepListDblClick(Sender: TObject); var index: Integer; begin index := RepList.ItemIndex; if index > -1 then begin VarList.Items.Add(RepList.Items[index]); RepList.Items.Delete(index); UpdateBtnStates; end; end; procedure TAxSAnovaForm.RepOutBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < RepList.Items.Count do begin if RepList.Selected[i] then begin VarList.Items.Add(RepList.Items[i]); RepList.Items.Delete(i); i := 0; end else inc(i); end; VarList.ItemIndex := -1; RepList.ItemIndex := -1; UpdateBtnStates; end; procedure TAxSAnovaForm.Reset; var i: integer; begin inherited; if FPosthocReportFrame <> nil then FPosthocReportFrame.Clear; VarList.Items.Clear; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); RepList.Items.Clear; GrpVarEdit.Clear; UpdateBtnStates; end; procedure TAxSAnovaForm.UpdateBtnStates; var lSelected: Boolean; i: Integer; begin inherited; if FPosthocReportFrame <> nil then FPosthocReportFrame.UpdateBtnStates; DepInBtn.Enabled := (VarList.ItemIndex > -1) and (GrpVarEdit.Text = ''); DepOutBtn.Enabled := (GrpVarEdit.Text <> ''); lSelected := false; for i := 0 to VarList.Items.Count-1 do if VarList.Selected[i] then begin lSelected := true; break; end; RepInBtn.Enabled := lSelected; lSelected := false; for i := 0 to RepList.Items.Count-1 do if RepList.Selected[i] then begin lSelected := true; break; end; RepOutBtn.Enabled := lSelected; end; function TAxSAnovaForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; begin Result := false; if GrpVarEdit.Text = '' then begin AControl := VarList; AMsg := 'Select a variable for between-groups treatment groups'; exit; end; if RepList.Items.Count < 2 then begin AControl := VarList; AMsg := 'This test requires at least two variables for repeated measurements.'; exit; end; Result := true; end; procedure TAxSAnovaForm.VarListDblClick(Sender: TObject); var index: Integer; s: String; begin index := VarList.ItemIndex; if index > -1 then begin s := VarList.Items[index]; if GrpVarEdit.Text = '' then GrpVarEdit.Text := s else RepList.Items.Add(s); VarList.Items.Delete(index); UpdateBtnStates; end; end; procedure TAxSAnovaForm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; end.