pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/AXSANOVAUNIT.PAS

903 lines
34 KiB
Plaintext
Raw Normal View History

LazStats: Repeating to add original source (having connectivity problems) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7880 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:01:57 +00:00
unit AxSAnovaUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib, GraphLib, Globals,
DataProcs, contexthelpunit;
type
{ TAxSAnovaFrm }
TAxSAnovaFrm = class(TForm)
PosthocChk: TCheckBox;
DepInBtn: TBitBtn;
DepOutBtn: TBitBtn;
HelpBtn: TButton;
RepInBtn: TBitBtn;
RepOutBtn: TBitBtn;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
PlotChk: TCheckBox;
GrpVar: TEdit;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
RepList: TListBox;
VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject);
procedure DepInBtnClick(Sender: TObject);
procedure DepOutBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure RepInBtnClick(Sender: TObject);
procedure RepOutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure PostHocTests(NoSelected : integer; MSerr : double; dferr : integer;
count : integer; ColMeans : DblDyneVec; Sender: TObject);
procedure TUKEY(error_ms : double; { mean squared for residual }
error_df : double; { deg. freedom for residual }
value : double; { size of smallest group }
group_total : DblDyneVec; { sum of scores in a group }
group_count : DblDyneVec; { no. of cases in a group }
min_grp : integer; { minimum group code }
max_grp : integer); { maximum group code }
procedure SCHEFFETEST(error_ms : double; { mean squared residual }
group_total : DblDyneVec; { sum of scores in a group }
group_count : DblDyneVec; { count of cases in a group }
min_grp : integer; { code of first group }
max_grp : integer; { code of last group }
total_n : double); { total number of cases }
procedure Newman_Keuls(error_ms : double; { residual mean squared }
error_df : double; { deg. freedom for error }
value : double; { number in smallest group }
group_total : DblDyneVec; { sum of scores in a group }
group_count : DblDyneVec; { count of cases in a group }
min_grp : integer; { lowest group code }
max_grp : integer); { largest group code }
procedure TUKEY_KRAMER(error_ms : double; { residual mean squared }
error_df : double; { deg. freedom for error }
value : double; { number in smallest group }
group_total : DblDyneVec; { sum of scores in group }
group_count : DblDyneVec; { number of caes in group }
min_grp : integer; { code of lowest group }
max_grp : integer); { code of highst group }
procedure TUKEYBTEST(ErrorMS : double; // within groups error
ErrorDF : double; // degrees of freedom within
group_total : DblDyneVec; // vector of group sums
group_count : DblDyneVec; // vector of group n's
min_grp : integer; // smallest group code
max_grp : integer; // largest group code
groupsize : double); // size of groups (all equal)
private
{ private declarations }
public
{ public declarations }
end;
var
AxSAnovaFrm: TAxSAnovaFrm;
implementation
{ TAxSAnovaFrm }
procedure TAxSAnovaFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
VarList.Items.Clear;
RepList.Items.Clear;
GrpVar.Text := '';
DepInBtn.Visible := true;
DepOutBtn.Visible := false;
RepInBtn.Visible := true;
RepOutBtn.Visible := false;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
PlotChk.Checked := false;
end;
procedure TAxSAnovaFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TAxSAnovaFrm.HelpBtnClick(Sender: TObject);
begin
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
procedure TAxSAnovaFrm.RepInBtnClick(Sender: TObject);
VAR i, index : integer;
begin
index := VarList.Items.Count;
i := 0;
while i < index do
begin
if (VarList.Selected[i]) then
begin
RepList.Items.Add(VarList.Items.Strings[i]);
VarList.Items.Delete(i);
index := index - 1;
i := 0;
end
else i := i + 1;
end;
RepOutBtn.Visible := true;
end;
procedure TAxSAnovaFrm.RepOutBtnClick(Sender: TObject);
VAR index : integer;
begin
index := RepList.ItemIndex;
if index < 0 then
begin
RepOutBtn.Visible := false;
exit;
end;
VarList.Items.Add(RepList.Items.Strings[index]);
RepList.Items.Delete(index);
end;
procedure TAxSAnovaFrm.DepInBtnClick(Sender: TObject);
VAR index : integer;
begin
index := VarList.ItemIndex;
GrpVar.Text := VarList.Items.Strings[index];
DepInBtn.Visible := false;
DepOutBtn.Visible := true;
end;
procedure TAxSAnovaFrm.ComputeBtnClick(Sender: TObject);
var
a1, a2, agrp, i, j, k, v1, totaln, NoSelected, range : integer;
group, col : integer;
p, X, f1, f2, f3, probf1, probf2, probf3, fd1, fd2, TotMean : double;
TotStdDev, den, maxmean, alpha : double;
C, StdDev : DblDyneMat;
squaredsumx, sumxsquared, coltot, sumsum : DblDyneVec;
degfree : array[1..8] of integer;
ColNoSelected : IntDyneVec;
ss :array[1..8] of double;
ms : array[1..8] of double;
coeff : array[1..6] of double;
N : IntDyneVec;
value, outline : string;
// parray : array[1..10] of pvector;
begin
SetLength(ColNoSelected,NoVariables+1);
if GrpVar.Text = '' then
Begin
ShowMessage('ERROR! Select a variable for between groups treatment groups');
exit;
end;
NoSelected := 1;
// Get between subjects group variable
for j := 1 to NoVariables do
if GrpVar.Text = OS3MainFrm.DataGrid.Cells[j,0] then ColNoSelected[0] := j;
v1 := ColNoSelected[0]; //A treatment (group) variable
//get minimum and maximum group codes for Treatment A
a1 := 1000; //atoi(MainForm.Grid.Cells[v1][1].c_str());
a2 := 0; //a1;
for i := 1 to NoCases do
Begin
if not GoodRecord(i,NoSelected,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;
NoSelected := RepList.Items.Count + 1;
k := NoSelected - 1; //Number of B (within subject) treatment levels
// allocate heap
SetLength(C,range+1,NoSelected+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;
// Get items selected for repeated measures (B treatments)
for i := 0 to RepList.Items.Count - 1 do
Begin
for j := 1 to NoVariables do
Begin
if RepList.Items.Strings[i] = OS3MainFrm.DataGrid.Cells[j,0] then
ColNoSelected[i+1] := j;
end;
end;
//Read data values and get sums and sums of squared values
for i := 1 to NoCases do
Begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
agrp := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[v1,i])));
agrp := agrp - a1 + 1; // offset to one
p := 0.0;
//Now read the B treatment scores
for j := 1 to k do
Begin
col := ColNoSelected[j];
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i]));
C[agrp-1,j-1] := C[agrp-1,j-1] + X;
StdDev[agrp-1,j-1] := StdDev[agrp-1,j-1] + (X * X);
coeff[1]:= coeff[1] + X;
p := p + X;
sumxsquared[agrp-1] := sumxsquared[agrp-1] + (X * X);
TotMean := TotMean + X;
TotStdDev := TotStdDev + (X * X);
end;
N[agrp-1] := N[agrp-1] + 1;
squaredsumx[agrp-1] := squaredsumx[agrp-1] + (p * p);
sumsum[agrp-1] := sumsum[agrp-1] + p;
end; // next case
// Obtain sums of squares for std. dev.s of B treatments
for i := 1 to k do // column (B treatments)
for j := 1 to range do // group of A treatments
StdDev[range,i-1] := StdDev[range,i-1] + StdDev[j-1,i-1];
// Obtain sums of squares for std. dev.s of A treatments
for i := 1 to range do
for j := 1 to k do
StdDev[i-1,k] := StdDev[i-1,k] + StdDev[i-1,j-1];
// Obtain cell standard deviations
for i := 1 to range do // rows
Begin
for j := 1 to k do // columns
Begin
StdDev[i-1,j-1] := StdDev[i-1,j-1] - ((C[i-1,j-1] * C[i-1,j-1]) / (N[i-1]));
StdDev[i-1,j-1] := StdDev[i-1,j-1] / (N[i-1]-1);
StdDev[i-1,j-1] := sqrt(StdDev[i-1,j-1]);
end;
end;
// Obtain A treatment group standard deviations
for i := 1 to range do
Begin
StdDev[i-1,k] := StdDev[i-1,k] - ((sumsum[i-1] * sumsum[i-1]) / (k * N[i-1]));
StdDev[i-1,k] := StdDev[i-1,k] / (k * N[i-1] - 1);
StdDev[i-1,k] := sqrt(StdDev[i-1,k]);
end;
// Obtain coefficients for the sums of squares
for i := 1 to range do
Begin
coeff[2] := coeff[2] + sumxsquared[i-1];
coeff[3] := coeff[3] + ((sumsum[i-1] * (sumsum[i-1]) / ((N[i-1] * k))));
coeff[6] := coeff[6] + squaredsumx[i-1];
totaln := totaln + N[i-1];
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 := 1 to k do
Begin
StdDev[range,j-1] := StdDev[range,j-1] - ((coltot[j-1] * coltot[j-1]) / totaln);
StdDev[range,j-1] := StdDev[range,j-1] / (totaln-1);
StdDev[range,j-1] := sqrt(StdDev[range,j-1]);
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
Begin
den := degfree[i];
ms[i] := ss[i] / den;
end;
// 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
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('ANOVA With One Between Subjects and One Within Subjects Treatments');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('------------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add('Source df SS MS F Prob.');
OutPutFrm.RichEdit.Lines.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);
outline := format('Between %5d %10.3f',[degfree[1],ss[1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format(' Groups (A) %5d %10.3f %10.3f %10.3f %6.4f',
[degfree[2], ss[2], ms[2], f1, probf1]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format(' Subjects w.g.%5d %10.3f %10.3f',
[degfree[3],ss[3],ms[3]]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
outline := format('Within Subjects %5d %10.3f',[degfree[4], ss[4]]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format(' B Treatments %5d %10.3f %10.3f %10.3f %6.4f',
[degfree[5], ss[5], ms[5], f2, probf2]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format(' A X B inter. %5d %10.3f %10.3f %10.3f %6.4f',
[degfree[6], ss[6], ms[6], f3, probf3]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format(' B X S w.g. %5d %10.3f %10.3f',
[degfree[7], ss[7], ms[7]]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
outline := format('TOTAL %5d %10.3f',[degfree[8], ss[8]]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('------------------------------------------------------------------');
//Calculate and print means
OutPutFrm.RichEdit.Lines.Add('Means');
outline := 'TRT. ';
for i := 1 to k do
Begin
value := format('B%3d ',[i]);
outline := outline + value;
end;
outline := outline + 'TOTAL';
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add(' A ');
for i := 1 to range do
Begin
for j := 1 to k do
C[i-1,j-1] := C[i-1,j-1] / N[i-1]; //mean of each B treatment within A treatment
sumsum[i-1] := sumsum[i-1] / (N[i-1] * k); //means in A treatment accross B treatments
end;
for j := 1 to k do coltot[j-1] := coltot[j-1] / totaln;
TotStdDev := TotStdDev - ((TotMean * TotMean) / (k * totaln));
TotStdDev := TotStdDev / (k * totaln - 1);
TotStdDev := sqrt(TotStdDev);
TotMean := TotMean / (k * totaln);
for i := 1 to range do
Begin
outline := format('%3d ',[i+a1-1]);
for j := 1 to k do
Begin
value := format('%7.3f',[C[i-1,j-1]]);
outline := outline + value;
end;
value := format('%7.3f',[sumsum[i-1]]);
outline := outline + value;
OutPutFrm.RichEdit.Lines.Add(outline);
end;
outline := 'TOTAL';
for j := 1 to k do
Begin
value := format('%7.3f',[coltot[j-1]]);
outline := outline + value;
end;
value := format('%7.3f',[TotMean]);
outline := outline + value;
OutPutFrm.RichEdit.Lines.Add(outline);
// Print standard deviations
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Standard Deviations');
outline := 'TRT. ';
for i := 1 to k do
Begin
value := format('B%3d ',[i]);
outline := outline + value;
end;
outline := outline + 'TOTAL';
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add(' A ');
for i := 1 to range do
Begin
outline := format('%3d ',[i+a1-1]);
for j := 1 to k do
Begin
value := format('%7.3f',[StdDev[i-1,j-1]]);
outline := outline + value;
end;
value := format('%7.3f',[StdDev[i-1,k]]);
outline := outline + value;
OutPutFrm.RichEdit.Lines.Add(outline);
end;
outline := 'TOTAL';
for j := 1 to k do
Begin
value := format('%7.3f',[StdDev[range,j-1]]);
outline := outline + value;
end;
value := format('%7.3f',[TotStdDev]);
outline := outline + value;
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.ShowModal;
if PlotChk.Checked = true then // PlotMeans(C,range,k,this)
begin
maxmean := 0.0;
SetLength(GraphFrm.Ypoints,range,k);
SetLength(GraphFrm.Xpoints,1,k);
for i := 1 to range do
begin
outline := 'A ' + IntToStr(i);
GraphFrm.SetLabels[i] := outline;
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.AutoScale := false;
GraphFrm.GraphType := 2; // 3d Vertical Bar Chart
GraphFrm.miny := 0.0;
GraphFrm.maxy := maxmean;
GraphFrm.BackColor := clYellow;
GraphFrm.WallColor := clBlack;
GraphFrm.FloorColor := clLtGray;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
end;
if PosthocChk.Checked = true then
begin
OutPutFrm.RichEdit.Clear;
// Do tests for the A (between groups)
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Comparisons for the Between Group Means');
PostHocTests(range, MS[1], degfree[1], range, sumsum, self);
OutPutFrm.ShowModal;
// Do tests for the B (repeated measures)
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Comparisons for the Repeated Measures Means');
PostHocTests(k, ms[4], degfree[4], NoCases, coltot, self);
end;
OutPutFrm.ShowModal;
// cleanup the heap
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
StdDev := nil;
sumsum := nil;
sumxsquared := nil;
coltot := nil;
squaredsumx := nil;
N := nil;
C := nil;
ColNoSelected := nil;
end;
procedure TAxSAnovaFrm.DepOutBtnClick(Sender: TObject);
begin
VarList.Items.Add(GrpVar.Text);
GrpVar.Text := '';
DepInBtn.Visible := true;
DepOutBtn.Visible := false;
end;
procedure TAxSAnovaFrm.PostHocTests(NoSelected : integer; MSerr : double; dferr : integer;
count : integer; ColMeans : DblDyneVec; Sender: TObject);
VAR
group_total : DblDyneVec;
group_count : DblDyneVec;
i, mingrp : integer;
begin
SetLength(group_total,NoSelected);
SetLength(group_count,NoSelected);
for i := 0 to NoSelected - 1 do
begin
group_count[i] := double(count);
group_total[i] := double(count) * ColMeans[i];
end;
mingrp := 1;
TUKEY(MSerr, dferr, count, group_total, group_count, mingrp, NoSelected);
TUKEY_KRAMER(MSerr, dferr, count, group_total, group_count, mingrp, NoSelected);
TUKEYBTEST(MSerr, dferr, group_total, group_count, mingrp,NoSelected, count);
SCHEFFETEST(MSerr, group_total, group_count, mingrp, NoSelected, count*NoSelected);
Newman_Keuls(MSerr, dferr, count, group_total, group_count, mingrp, NoSelected);
end;
procedure TAxSAnovaFrm.TUKEY(error_ms : double; { mean squared for residual }
error_df : double; { deg. freedom for residual }
value : double; { size of smallest group }
group_total : DblDyneVec; { sum of scores in a group }
group_count : DblDyneVec; { no. of cases in a group }
min_grp : integer; { minimum group code }
max_grp : integer); { maximum group code }
var
sig : boolean;
divisor : double;
df1 : integer;
alpha : double;
contrast, mean1, mean2 : double;
q_stat : double;
i,j : integer;
outline : string;
begin
// alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text);
alpha := 0.05;
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add(' Tukey HSD Test for Differences Between Means');
outline := format(' alpha selected = %4.2f',[alpha]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic Probability Significant?');
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
divisor := sqrt(error_ms / value );
for i := min_grp to max_grp - 1 do
for j := i + 1 to max_grp do
begin
outline := format('%2d - %2d ',[i,j]);
mean1 := group_total[i-1] / group_count[i-1];
mean2 := group_total[j-1] / group_count[j-1];
contrast := mean1 - mean2;
outline := outline + format('%7.3f q = ',[contrast]);
contrast := abs(contrast / divisor) ;
outline := outline + format('%6.3f ',[contrast]);
df1 := max_grp - min_grp + 1;
q_stat := STUDENT(contrast,error_df,df1);
outline := outline + format(' %6.4f',[q_stat]);
if alpha >= q_stat then sig := TRUE else sig := FALSE;
if sig = TRUE then outline := outline + ' YES '
else outline := outline + ' NO';
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
end;
procedure TAxSAnovaFrm.SCHEFFETEST(error_ms : double; { mean squared residual }
group_total : DblDyneVec; { sum of scores in a group }
group_count : DblDyneVec; { count of cases in a group }
min_grp : integer; { code of first group }
max_grp : integer; { code of last group }
total_n : double); { total number of cases }
var
statistic, stat_var, stat_sd : double;
mean1, mean2, alpha, difference, prob_scheffe, f_prob, df1, df2 : double;
outline : string;
i, j : integer;
begin
// alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text);
alpha := 0.05;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add(' Scheffe contrasts among pairs of means.');
outline := format(' alpha selected = %4.2f',[alpha]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('Group vs Group Difference Scheffe Critical Significant?');
OutPutFrm.RichEdit.Lines.Add(' Statistic Value');
OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------');
alpha := 1.0 - alpha ;
for i:= min_grp to max_grp - 1 do
for j := i + 1 to max_grp do
begin
outline := format('%2d %2d ',[i,j]);
mean1 := group_total[i-1] / group_count[i-1];
mean2 := group_total[j-1] / group_count[j-1];
difference := mean1 - mean2;
outline := outline + format('%8.2f ',[difference]);
stat_var := error_ms *
( 1.0 / group_count[i-1] + 1.0 / group_count[j-1]);
stat_sd := sqrt(stat_var);
statistic := abs(difference / stat_sd);
outline := outline + format('%8.2f ',[statistic]);
df1 := max_grp - min_grp;
df2 := total_n - df1 + 1;
f_prob := fpercentpoint(alpha,round(df1),round(df2) );
prob_scheffe := sqrt(df1 * f_prob);
outline := outline + format('%8.3f ',[prob_scheffe]);
if statistic > prob_scheffe then outline := outline + 'YES'
else outline := outline + 'NO';
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------');
end;
procedure TAxSAnovaFrm.Newman_Keuls(error_ms : double; { residual mean squared }
error_df : double; { deg. freedom for error }
value : double; { number in smallest group }
group_total : DblDyneVec; { sum of scores in a group }
group_count : DblDyneVec; { count of cases in a group }
min_grp : integer; { lowest group code }
max_grp : integer); { largest group code }
var
i, j : integer;
temp1, temp2 : double;
groupno : IntDyneVec;
alpha : double;
contrast, mean1, mean2 : double;
q_stat : double;
divisor : double;
tempno : integer;
df1 : integer;
sig : boolean;
outline : string;
begin
SetLength(groupno,max_grp-min_grp+1);
for i := min_grp to max_grp do groupno[i-1] := i;
for i := min_grp to max_grp - 1 do
begin
for j := i + 1 to max_grp do
begin
if group_total[i-1] / group_count[i-1] >
group_total[j-1] / group_count[j-1] then
begin
temp1 := group_total[i-1];
temp2 := group_count[i-1];
tempno := groupno[i-1];
group_total[i-1] := group_total[j-1];
group_count[i-1] := group_count[j-1];
groupno[i-1] := groupno[j-1];
group_total[j-1] := temp1;
group_count[j-1] := temp2;
groupno[j-1] := tempno;
end;
end;
end;
// alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text);
alpha := 0.05;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add(' Neuman-Keuls Test for Contrasts on Ordered Means');
outline := format(' alpha selected = %4.2f',[alpha]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Group Mean');
for i := 1 to max_grp do
begin
outline := format('%3d %10.3f',[groupno[i-1],group_total[i-1] / group_count[i-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic d.f. Probability Significant?');
OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------');
divisor := sqrt(error_ms / value);
for i := min_grp to max_grp - 1 do
begin
for j := i + 1 to max_grp do
begin
outline := format('%2d - %2d ',[groupno[i-1],groupno[j-1]]);
mean1 := group_total[i-1] / group_count[i-1];
mean2 := group_total[j-1] / group_count[j-1];
contrast := mean1 - mean2;
outline := outline + format('%7.3f q = ',[contrast]);
contrast := abs(contrast / divisor );
df1 := j - i + 1;
outline := outline + format('%6.3f %2d %3.0f ',[contrast,df1,error_df]);
q_stat := STUDENT(contrast,error_df,df1);
outline := outline + format(' %6.4f',[q_stat]);
if alpha > q_stat then sig := TRUE else sig := FALSE;
if sig = TRUE then outline := outline + ' YES'
else outline := outline + ' NO';
OutPutFrm.RichEdit.Lines.Add(outline);
end;
end;
OutPutFrm.RichEdit.Lines.Add('----------------------------------------------------------------------');
groupno := nil;
end;
procedure TAxSAnovaFrm.TUKEY_KRAMER(error_ms : double; { residual mean squared }
error_df : double; { deg. freedom for error }
value : double; { number in smallest group }
group_total : DblDyneVec; { sum of scores in group }
group_count : DblDyneVec; { number of caes in group }
min_grp : integer; { code of lowest group }
max_grp : integer); { code of highst group }
var
sig : boolean;
divisor : double;
df1 : integer;
alpha : double;
contrast, mean1, mean2 : double;
q_stat : double;
outline : string;
i, j : integer;
begin
// alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text);
alpha := 0.05;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add(' Tukey-Kramer Test for Differences Between Means');
outline := format(' alpha selected = %4.2f',[alpha]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic Probability Significant?');
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
for i := min_grp to max_grp - 1 do
for j := i + 1 to max_grp do
begin
outline := format('%2d - %2d ',[i,j]);
mean1 := group_total[i-1] / group_count[i-1];
mean2 := group_total[j-1] / group_count[j-1];
contrast := mean1 - mean2;
outline := outline + format('%7.3f q = ',[contrast]);
divisor := sqrt(error_ms *
( ( 1.0/group_count[i-1] + 1.0/group_count[j-1] ) / 2 ) );
contrast := abs(contrast / divisor) ;
outline := outline + format('%6.3f ',[contrast]);
df1 := max_grp - min_grp + 1;
q_stat := STUDENT(contrast,error_df,df1);
outline := outline + format(' %6.4f',[q_stat]);
if alpha >= q_stat then sig := TRUE else sig := FALSE;
if sig = TRUE then outline := outline + ' YES '
else outline := outline + ' NO';
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
end;
procedure TAxSAnovaFrm.TUKEYBTEST(ErrorMS : double; // within groups error
ErrorDF : double; // degrees of freedom within
group_total : DblDyneVec; // vector of group sums
group_count : DblDyneVec; // vector of group n's
min_grp : integer; // smallest group code
max_grp : integer; // largest group code
groupsize : double); // size of groups (all equal)
var
alpha : double;
outline : string;
i, j : integer;
df1 : double;
qstat : double;
tstat : double;
groupno : IntDyneVec;
temp1, temp2 : double;
tempno : integer;
NoGrps : integer;
contrast : double;
mean1, mean2 : double;
sig : string[6];
groups : double;
response : string[5];
divisor : double;
begin
SetLength(groupno,max_grp-min_grp+1);
// alpha := StrToFloat(BlksAnovaFrm.PostAlpha.Text);
alpha := 0.05;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add(' Tukey B Test for Contrasts on Ordered Means');
outline := format(' alpha selected = %4.2f',[alpha]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('---------------------------------------------------------------');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Groups Difference Statistic d.f. Prob.>value Significant?');
divisor := sqrt(ErrorMS / groupsize);
NoGrps := max_grp - min_grp + 1;
for i := min_grp to max_grp do groupno[i-1] := i;
for i := 1 to NoGrps - 1 do
begin
for j := i + 1 to NoGrps do
begin
if group_total[i-1] / group_count[i-1] >
group_total[j-1] / group_count[j-1] then
begin
temp1 := group_total[i-1];
temp2 := group_count[i-1];
tempno := groupno[i-1];
group_total[i-1] := group_total[j-1];
group_count[i-1] := group_count[j-1];
groupno[i-1] := groupno[j-1];
group_total[j-1] := temp1;
group_count[j-1] := temp2;
groupno[j-1] := tempno;
end;
end;
end;
for i := 1 to NoGrps-1 do
begin
for j := i+1 to NoGrps do
begin
mean1 := group_total[i-1] / group_count[i-1];
mean2 := group_total[j-1] / group_count[j-1];
contrast := abs((mean1 - mean2) / divisor);
df1 := j - i + 1.0;
qstat := STUDENT(contrast,ErrorDF,df1);
groups := NoGrps;
tstat := STUDENT(contrast,ErrorDF,groups);
qstat := (qstat + tstat) / 2.0;
if alpha >= qstat then sig := 'YES' else sig := 'NO';
outline := format('%3d - %3d %10.3f %10.3f %4.0f,%4.0f %5.3f %s',
[groupno[i-1],groupno[j-1],
mean1-mean2,contrast,df1,ErrorDF,qstat,sig]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
end;
groupno := nil;
end;
initialization
{$I axsanovaunit.lrs}
end.
Reference in New Issue Copy Permalink