pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/succintunit.pas
wp_xxyyzz 819af1d403 LazStats: Adding original source, part 7. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7886 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:21:34 +00:00

581 lines
17 KiB
ObjectPascal
Raw Blame History

unit SuccIntUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib, Globals,
DataProcs, Math;
type
{ TSuccIntFrm }
TSuccIntFrm = class(TForm)
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
InBtn: TBitBtn;
OutBtn: TBitBtn;
AllBtn: TBitBtn;
Label1: TLabel;
Label2: TLabel;
ItemList: TListBox;
VarList: TListBox;
procedure AllBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure InBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
SuccIntFrm: TSuccIntFrm;
implementation
{ TSuccIntFrm }
procedure TSuccIntFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
VarList.Clear;
ItemList.Clear;
OutBtn.Visible := false;
InBtn.Visible := true;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
end;
procedure TSuccIntFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TSuccIntFrm.AllBtnClick(Sender: TObject);
VAR i, count : integer;
begin
count := VarList.Items.Count;
for i := 1 to count do
ItemList.Items.Add(VarList.Items.Strings[i-1]);
InBtn.Visible := false;
OutBtn.Visible := true;
end;
procedure TSuccIntFrm.ComputeBtnClick(Sender: TObject);
var
i, j, k, col, X, NoSelected, MaxCat, count, subscript : integer;
discrow : integer;
CatCount : IntDyneVec;
ColNoSelected : IntDyneVec;
FreqMat : IntDyneMat;
RowTots : IntDyneVec;
PropMat, Zmatrix, WidthMat, TheorZMat, ThCumPMat, CumMat : DblDyneMat;
DiscDisp, Mean, StdDev, CumWidth, ScaleValue : DblDyneVec;
d1, d2, C1, L1, L2, t3, sum, discrep, z, prop, maxdiscrep : double;
RowLabels, ColLabels : StrDyneVec;
outline, astring : string;
Save_Cursor : TCursor;
found : boolean;
begin
MaxCat := 0;
L1 := 0.01;
L2 := 0.99;
maxdiscrep := 0.0;
// Allocate space
SetLength(DiscDisp,NoVariables);
SetLength(ScaleValue,NoVariables);
SetLength(RowLabels,NoVariables);
SetLength(ColNoSelected,NoVariables);
// Get items selected
NoSelected := ItemList.Items.Count;
for i := 1 to NoSelected do
begin
for j := 1 to NoVariables do
begin
outline := ItemList.Items.Strings[i-1];
if outline = OS3MainFrm.DataGrid.Cells[j,0] then ColNoSelected[i-1] := j;
end;
end;
(*
OutPutFrm.RichEdit.Lines.Add('check of parameters');
outline := format('No Selected = %3d',[NoSelected]);
OutPutFrm.RichEdit.Lines.Add(outline);
for i := 1 to NoSelected do
begin
outline := format('ItemList %d = %s',[i-1,ItemList.Items.Strings[i-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Col. No. Selected %3d = %3d',[i-1,ColNoSelected[i-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.ShowModal;
OutPutFrm.RichEdit.Clear;
*)
//Find largest category value in data
for i := 1 to NoCases do
begin
if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
for j := 1 to NoSelected do
begin
col := ColNoSelected[j-1];
X := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])));
if (X > MaxCat) then MaxCat := X;
end;
end;
// Initialize arrays
SetLength(CatCount,MaxCat);
SetLength(FreqMat,NoVariables,MaxCat);
SetLength(RowTots,NoVariables);
SetLength(PropMat,NoVariables,MaxCat);
SetLength(Zmatrix,NoVariables,MaxCat);
SetLength(WidthMat,NoVariables,MaxCat);
SetLength(TheorZMat,NoVariables,MaxCat);
SetLength(ThCumPMat,NoVariables,MaxCat);
SetLength(CumMat,NoVariables,MaxCat);
SetLength(Mean,MaxCat);
SetLength(StdDev,MaxCat);
SetLength(CumWidth,MaxCat);
SetLength(ColLabels,MaxCat);
for i := 0 to NoSelected-1 do
begin
RowTots[i] := 0;
DiscDisp[i] := 0.0;
ScaleValue[i] := 0.0;
for j := 0 to MaxCat-1 do
begin
FreqMat[i,j] := 0;
PropMat[i,j] := 0.0;
CumMat[i,j] := 0.0;
Zmatrix[i,j] := 0.0;
WidthMat[i,j] := 0.0;
TheorZMat[i,j] := 0.0;
ThCumPMat[i,j] := 0.0;
end;
end;
for j := 0 to MaxCat-1 do
begin
CumWidth[j] := 0.0;
StdDev[j] := 0.0;
Mean[j] := 0.0;
CatCount[j] := 0;
end;
Save_Cursor := Screen.Cursor; // save current cursor
Screen.Cursor := crHourGlass; // Show hourglass cursor
//Build frequency matrix
for i := 1 to NoCases do
begin
if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
for j := 1 to NoSelected do
begin
col := ColNoSelected[j-1];
X := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,i])));
if ((X > 0) and (X <= MaxCat)) then
FreqMat[j-1,X-1] := FreqMat[j-1,X-1] + 1;
end;
end;
// Get row totals of the frequency matrix
for i := 0 to NoSelected-1 do
begin
RowTots[i] := 0;
for j := 0 to MaxCat-1 do
begin
RowTots[i] := RowTots[i] + FreqMat[i,j];
end;
end;
// Convert frequencies to proportions of the row totals
for i := 0 to NoSelected-1 do
for j := 0 to MaxCat-1 do
PropMat[i,j] := FreqMat[i,j] / RowTots[i];
// Accumulate the proportions accross the categories
for i := 1 to NoSelected do
begin
CumMat[i-1,0] := PropMat[i-1,0];
for j := 2 to MaxCat do
begin
CumMat[i-1,j-1] := CumMat[i-1,j-2] + PropMat[i-1,j-1];
if (j = MaxCat) then CumMat[i-1,j-1] := 1.0;
end;
end;
// Convert cumulative proportions to z scores
for i := 0 to NoSelected-1 do
begin
for j := 0 to MaxCat-1 do
begin
if (CumMat[i,j] < L1) then Zmatrix[i,j] := 99.0; //flag -infinity
if (CumMat[i,j] > L2) then Zmatrix[i,j] := 99.0; //flag +infinity
if ((CumMat[i,j] >= L1) and (CumMat[i,j] <= L2)) then
Zmatrix[i,j] := inversez(CumMat[i,j]);
end;
end;
// Obtain discriminal dispersions of the items
t3 := 0.0;
for i := 1 to NoSelected do
begin
d1 := 0.0;
d2 := 0.0;
C1 := 0.0;
for j := 1 to MaxCat - 1 do
begin
if (Zmatrix[i-1,j-1] <> 99.0) then
begin
d1 := d1 + Zmatrix[i-1,j-1];
d2 := d2 + (Zmatrix[i-1,j-1] * Zmatrix[i-1,j-1]);
C1 := C1 + 1.0;
end;
end;
if (C1 > 1) then
begin
DiscDisp[i-1] := d2 - ((d1 * d1) / C1);
DiscDisp[i-1] := DiscDisp[i-1] / (C1-1.0);
DiscDisp[i-1] := sqrt(DiscDisp[i-1]);
end
else DiscDisp[i-1] := 99.0;
if ((DiscDisp[i-1] > 0) and (DiscDisp[i-1] <> 99.0))then t3 := t3 + (1.0 / DiscDisp[i-1]);
end;
//Constant t3 =No. items / recipricols of std.dev.s of item z scores
t3 := NoSelected / t3;
for i := 0 to NoSelected-1 do
begin
if ((DiscDisp[i] > 0.0) and (t3 > 0)) then
DiscDisp[i] := (1.0 / DiscDisp[i]) * t3
else DiscDisp[i] := 99.0;
end;
// Now, calculate interval widths
for j := 2 to MaxCat - 1 do
begin
for i := 1 to NoSelected do
begin
if ((Zmatrix[i-1,j-1] <> 99.0) and (Zmatrix[i-1,j-2] <> 99.0)) then
WidthMat[i-1,j-2] := Zmatrix[i-1,j-1] - Zmatrix[i-1,j-2]
else WidthMat[i-1,j-2] := 99.0;
end;
end;
//Calculate Means and Standard Deviations of category Widths
for j := 1 to MaxCat-2 do
begin
for i := 1 to NoSelected do
begin
if (WidthMat[i-1,j-1] <> 99.0) then
begin
CatCount[j-1] := CatCount[j-1] + 1;
Mean[j-1] := Mean[j-1] + WidthMat[i-1,j-1];
StdDev[j-1] := StdDev[j-1] + (WidthMat[i-1,j-1] * WidthMat[i-1,j-1]);
end;
end;
if (CatCount[j-1] > 1) then
begin
Mean[j-1] := Mean[j-1] / CatCount[j-1];
StdDev[j-1] := (StdDev[j-1] / CatCount[j-1]) - (Mean[j-1] * Mean[j-1]);
StdDev[j-1] := StdDev[j-1] * (CatCount[j-1] / (CatCount[j-1] - 1));
end;
end;
// Calculate cumulative widths
CumWidth[0] := Mean[0];
for j := 2 to MaxCat - 1 do
CumWidth[j-1] := CumWidth[j-2] + Mean[j-1];
// Calculate scale item scale values
for i := 1 to NoSelected do
begin
found := false;
count := 1;
while (not found) do
begin
if (CumMat[i-1,count-1] >= 0.5) then
begin
found := true;
subscript := count;
end;
if (count = (MaxCat)) then
begin
found := true;
subscript := count;
end;
count := count + 1;
end;
if ((subscript > 2) and (subscript < MaxCat)) then
begin
ScaleValue[i-1] := Mean[subscript-2] * ((0.5 - CumMat[i-1,subscript-2])
/ PropMat[i-1,subscript-1]);
if (subscript > 1) then ScaleValue[i-1] := ScaleValue[i-1] +
CumWidth[subscript-3];
end
else
begin //extreme value - get average of z scores in first cat. and / 2
sum := 0.0;
for k := 1 to NoSelected do sum := sum + Zmatrix[i-1,0];
sum := sum / abs(NoSelected * 2);
ScaleValue[i-1] := sum * ((0.5 - (CumMat[i-1,0] / 2.0)) / (CumMat[i-1,0] / 2.0));
end;
end;
//Calculate Theoretical z scores from the scale values
discrep := 0.0;
count := 0;
for i := 1 to NoSelected do
begin
z := -ScaleValue[i-1];
TheorZMat[i-1,0] := z;
prop := probz(z);
ThCumPMat[i-1,0] := prop;
for j := 2 to MaxCat - 1 do
begin
z := CumWidth[j-2] - ScaleValue[i-1];
if (z < -3) then z := -3.0;
if (z > 3) then z := 3.0;
prop := probz(z);
TheorZMat[i-1,j-1] := z;
ThCumPMat[i-1,j-1] := prop;
discrep := discrep + abs(CumMat[i-1,j-1] - prop);
if abs(CumMat[i-1,j-1] - prop) > maxdiscrep then
begin
maxdiscrep := abs(CumMat[i-1,j-1] - prop);
discrow := i;
end;
count := count + 1;
end;
ThCumPMat[i-1,MaxCat-1] := 1.0;
end;
discrep := discrep / count; // average discrepency between theoretical and observed
// Report results
for i := 1 to NoSelected do
RowLabels[i-1] := OS3MainFrm.DataGrid.Cells[ColNoSelected[i-1],0];
for i := 1 to MaxCat do
begin
outline := format(' %2d-%2d ',[i-1,i]);
ColLabels[i-1] := outline;
end;
OutPutFrm.RichEdit.Lines.Add(' SUCCESSIVE INTERVAL SCALING RESULTS');
OutPutFrm.RichEdit.Lines.Add('');
outline := ' ';
for i := 1 to MaxCat do outline := outline + ColLabels[i-1];
OutPutFrm.RichEdit.Lines.Add(outline);
for i := 1 to NoSelected do
begin
outline := format('%10s',[RowLabels[i-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Frequency ';
for j := 1 to MaxCat do
begin
astring := format('%7d',[FreqMat[i-1,j-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Proportion ';
for j := 1 to MaxCat do
begin
astring := format('%7.3f',[PropMat[i-1,j-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Cum. Prop. ';
for j := 1 to MaxCat do
begin
astring := format('%7.3f',[CumMat[i-1,j-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Normal z ';
for j := 1 to MaxCat do
begin
if (Zmatrix[i-1,j-1] <> 99.0) then
begin
astring := format('%7.3f',[Zmatrix[i-1,j-1]]);
outline := outline + astring;
end
else outline := outline + ' - ';
end;
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add(' INTERVAL WIDTHS');
outline := ' ';
for i := 1 to MaxCat - 2 do
begin
astring := format(' %2d-%2d ',[i+1,i]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := '';
for i := 1 to NoSelected do
begin
astring := format('%10s',[RowLabels[i-1]]);
outline := outline + astring;
for j := 1 to MaxCat-2 do
begin
if (WidthMat[i-1,j-1] <> 99.0) then
begin
astring := format('%7.3f',[WidthMat[i-1,j-1]]);
outline := outline + astring;
end
else outline := outline + ' - ';
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := '';
end;
OutPutFrm.RichEdit.Lines.Add('');
outline := 'Mean Width';
for i := 1 to MaxCat - 2 do
begin
astring := format('%7.2f',[Mean[i-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'No. Items ';
for i := 1 to MaxCat - 2 do
begin
astring := format('%7d',[CatCount[i-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Std. Dev.s';
for i := 1 to MaxCat - 2 do
begin
astring := format('%7.2f',[StdDev[i-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Cum. Means';
for i := 1 to MaxCat - 2 do
begin
astring := format('%7.2f',[CumWidth[i-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('ESTIMATES OF SCALE VALUES AND THEIR DISPERSIONS');
OutPutFrm.RichEdit.Lines.Add('Item No. Ratings Scale Value Discriminal Dispersion');
for i := 0 to NoSelected-1 do
begin
outline := format('%10s %3d %6.3f %6.3f',
[RowLabels[i],RowTots[i],ScaleValue[i],DiscDisp[i]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Z scores Estimated from Scale values');
outline := ' ';
for i := 0 to MaxCat-1 do outline := outline + ColLabels[i];
OutPutFrm.RichEdit.Lines.Add(outline);
for i := 1 to NoSelected do
begin
outline := format('%10s',[RowLabels[i-1]]);
for j := 1 to MaxCat - 1 do
begin
astring := format('%7.3f',[TheorZMat[i-1,j-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('Cumulative Theoretical Proportions');
outline := ' ';
for i := 1 to MaxCat do outline := outline + ColLabels[i-1];
OutPutFrm.RichEdit.Lines.Add(outline);
for i := 1 to NoSelected do
begin
outline := format('%10s',[RowLabels[i-1]]);
for j := 1 to MaxCat do
begin
astring := format('%7.3f',[ThCumPMat[i-1,j-1]]);
outline := outline + astring;
end;
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.RichEdit.Lines.Add('');
outline := 'Average Discrepency Between Theoretical and Observed Cumulative Proportions = ';
astring := format('%6.3f',[discrep]);
outline := outline + astring;
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Maximum discrepency = %6.3f found in item %s',
[maxdiscrep,RowLabels[discrow-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
Screen.Cursor := Save_Cursor;
OutPutFrm.ShowModal;
// Clean up heap
ColLabels := nil;
RowLabels := nil;
ScaleValue := nil;
CumWidth := nil;
StdDev := nil;
Mean := nil;
DiscDisp := nil;
CumMat := nil;
ThCumPMat := nil;
TheorZMat := nil;
WidthMat := nil;
Zmatrix := nil;
PropMat := nil;
RowTots := nil;
FreqMat := nil;
CatCount := nil;
ColNoSelected := nil;
end;
procedure TSuccIntFrm.InBtnClick(Sender: TObject);
VAR i, index : integer;
begin
index := VarList.Items.Count;
i := 0;
while i < index do
begin
if (VarList.Selected[i]) then
begin
ItemList.Items.Add(VarList.Items.Strings[i]);
VarList.Items.Delete(i);
index := index - 1;
i := 0;
end
else i := i + 1;
end;
OutBtn.Visible := true;
end;
procedure TSuccIntFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
begin
index := ItemList.ItemIndex;
if index < 0 then
begin
OutBtn.Visible := false;
exit;
end;
VarList.Items.Add(ItemList.Items.Strings[index]);
ItemList.Items.Delete(index);
end;
initialization
{$I succintunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink