pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Some more improvements in RaschUnit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7898 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-11-22 22:29:04 +00:00
parent 29721742a0
commit 128c037e14
7 changed files with 176 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
applications/lazstats/source/forms/analysis/comparisons/bnestaunit.pas
View File

@ -565,8 +565,6 @@ end;
procedure TBNestedAForm.Reset;
var
i: integer;
begin
inherited;
@ -579,9 +577,7 @@ begin
BCodesEdit.Clear;
DepEdit.Clear;
VarList.Items.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
end;

8
applications/lazstats/source/forms/analysis/correlation/canonunit.pas
View File

@ -81,7 +81,7 @@ implementation
{$R *.lfm}
uses
Utils, MathUnit;
Utils, MathUnit, GridProcs;
{ TCanonicalForm }
@ -615,15 +615,11 @@ begin
end;
procedure TCanonicalForm.Reset;
var
i: integer;
begin
inherited;
LeftList.Clear;
RightList.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
if FCreated then
begin

16
applications/lazstats/source/forms/analysis/descriptive/boxplotunit.pas
View File

@ -60,7 +60,7 @@ implementation
uses
TAChartUtils, TALegend, TAMultiSeries,
Math, Utils;
Math, Utils, GridProcs;
const
BOX_COLORS: Array[0..3] of TColor = (clBlue, clGreen, clFuchsia, clLime);
@ -170,7 +170,7 @@ begin
maxGrp := -MaxInt;
for i := 1 to NoCases do
begin
if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue;
G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i]));
minGrp := Min(G, minGrp);
maxGrp := Max(G, maxGrp);
@ -191,7 +191,7 @@ begin
numValues := 0;
for i := 1 to NoCases do
begin
if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue;
inc(numValues);
X := StrToFloat(OS3MainFrm.DataGrid.Cells[MeasVar, i]);
MaxScore := Max(MaxScore, X);
@ -256,7 +256,7 @@ begin
cnt := 0;
for i := 1 to NoCases do
begin // get scores for this group j
if not GoodRecord(i, Length(ColNoSelected), ColNoSelected) then continue;
if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then continue;
G := round(StrToFloat(OS3MainFrm.DataGrid.Cells[GrpVar, i]));
G := G - minGrp + 1;
if G = j+1 then // subject in this group
@ -392,7 +392,6 @@ begin
end;
end;
function TBoxPlotFrm.Percentile(nScoreGrps: integer;
APercentile: double; const Freq, CumFreq, Scores: DblDyneVec): double;
var
@ -431,16 +430,13 @@ end;
procedure TBoxPlotFrm.Reset;
var
i: integer;
begin
inherited;
VarList.Clear;
CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
GroupEdit.Text := '';
MeasEdit.Text := '';
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end;

11
applications/lazstats/source/forms/analysis/measurement_programs/raschunit.lfm
View File

@ -140,6 +140,7 @@ inherited RaschForm: TRaschForm
Constraints.MinHeight = 220
ItemHeight = 0
MultiSelect = True
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 0
end
@ -174,6 +175,7 @@ inherited RaschForm: TRaschForm
BorderSpacing.Top = 2
ItemHeight = 0
MultiSelect = True
OnDblClick = ItemListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 3
end
@ -202,8 +204,9 @@ inherited RaschForm: TRaschForm
Left = 357
Height = 403
Width = 490
ActivePage = ItemFuncsPage
TabIndex = 3
inherited ReportPage: TTabSheet
Caption = 'Results'
end
inherited ChartPage: TTabSheet
Caption = 'Plot Item Difficulties'
TabVisible = False
@ -220,5 +223,9 @@ inherited RaschForm: TRaschForm
Caption = 'Plot Test Info'
TabVisible = False
end
object ProxPage: TTabSheet[5]
Caption = 'Prox'
TabVisible = False
end
end
end

180
applications/lazstats/source/forms/analysis/measurement_programs/raschunit.pas
View File

@ -11,7 +11,7 @@ interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
ExtCtrls, ComCtrls, MainUnit, FunctionsLib, Globals,
ChartFrameUnit, BasicStatsReportAndChartFormUnit;
ReportFrameUnit, ChartFrameUnit, BasicStatsReportAndChartFormUnit;
type
@ -24,6 +24,7 @@ type
ItemFuncsChk: TCheckBox;
ScoresPage: TTabSheet;
ItemFuncsPage: TTabSheet;
ProxPage: TTabSheet;
TestInfoPage: TTabSheet;
TestInfoChk: TCheckBox;
OptionsGroup: TGroupBox;
@ -34,7 +35,9 @@ type
Label1: TLabel;
VarList: TListBox;
procedure InBtnClick(Sender: TObject);
procedure ItemListDblClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private
@ -65,10 +68,10 @@ type
const P, p2: DblDyneVec; AReport: TStrings);
procedure Prox(const P, p2: DblDyneVec; k, r, C1: integer;
const L1: DblDyneVec; yexpand, xexpand: double; const g: DblDyneVec;
T: integer; const rowtot, i5, s5: IntDyneVec; AReport: TStrings);
T: integer; const rowtot, i5, s5: IntDyneVec);
function Reduce(k: integer; out r, T, C1: integer;
const i5, rowtot, s5: IntDyneVec; const f: IntDyneMat; const S: IntDyneVec;
AReport: TStrings): integer;
AReport: TStrings): boolean;
procedure Slopes(const rptbis, rbis, slope: DblDyneVec; N: integer;
sumx, sumx2: double; const sumxy: DblDyneVec; r: integer;
const xsqr, mean: DblDyneVec);
@ -81,10 +84,11 @@ type
procedure PlotItems(r: integer; const i5: IntDyneVec; const P: DblDyneVec);
procedure PlotScrs(C1: integer; const s5: IntDyneVec; const p2: DblDyneVec);
procedure PlotTest(const TestInfo: DblDyneMat; ArraySize: integer;
const Title: string{; Vdivisions, Hdivisions: integer});
const Title: string);
private
FChartCombobox: TCombobox;
FProxReportFrame: TReportFrame;
FItemDiffsChartFrame: TChartFrame;
FScoresChartFrame: TChartFrame;
FItemFuncsChartFrame: TChartFrame;
@ -106,6 +110,7 @@ type
var
RaschForm: TRaschForm;
implementation
{$R *.lfm}
@ -115,12 +120,16 @@ uses
TAChartUtils, TACustomSeries,
Utils, GridProcs;
{ TRaschForm }
constructor TRaschForm.Create(AOwner: TComponent);
begin
inherited;
FReportFrame.ClearBorderSpacings;
InitToolbar(FReportFrame.ReportToolbar, tpTop);
FItemDiffsChartFrame := FChartFrame; // already created by ancestor
FScoresChartFrame := TChartFrame.Create(self);
@ -136,6 +145,13 @@ begin
FTestInfoChartFrame := TChartFrame.Create(self);
FTestInfoChartFrame.Parent := TestInfoPage;
FTestInfoChartFrame.Align := alClient;
FProxReportFrame := TReportFrame.Create(self);
FProxReportFrame.Parent := ProxPage;
FProxReportFrame.Align := alClient;
ProxPage.PageIndex := 1;
PageControl.ActivePageIndex := 0;
end;
@ -267,7 +283,7 @@ begin
for i := 0 to NoSelected-1 do
colNoSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, ItemList.Items[i]);
//begin ( main program )
// begin main program
finished := false;
N := NoCases;
k1 := NoSelected;
@ -275,8 +291,7 @@ begin
lReport := TStringList.Create;
try
GetScores(NoSelected, ColNoSelected, NoCases, f, mean, xsqr, sumxy, S, X, sumx, sumx2, N, lReport);
error := Reduce(k1, r, T, C1, i5, rowtot, s5, f, S, lReport);
if error = 1 then
if not Reduce(k1, r, T, C1, i5, rowtot, s5, f, S, lReport) then
exit;
Frequencies(C1, r, f, rowtot, i5, s5, T, S, lReport);
@ -284,8 +299,9 @@ begin
v2 := 0.0;
GetLogs(L, L1, L2, g, g2, f2, rowtot, k1, s5, S, T, r, C1, v1, v2, lReport);
Expand(v1, v2, xexpand, yexpand);
Prox(P, p2, k1, r, C1, L1, yexpand, xexpand, g, T, rowtot, i5, s5, lReport);
// start iterations for the maximum-likelihood (SetLengthton-Rhapson procedure)
Prox(P, p2, k1, r, C1, L1, yexpand, xexpand, g, T, rowtot, i5, s5);
// Start iterations for the maximum likelihood (SetLengthton-Rhapson procedure)
// estimates
noloops := 0;
@ -299,7 +315,7 @@ begin
noloops := noloops + 1;
if (noloops > 25) then
begin
MessageDlg('Maximum Likelihood failed to converge after 25 iterations', mtInformation, [mbOK], 0);
ErrorMsg('Maximum Likelihood failed to converge after 25 iterations');
finished := true;
end;
end;
@ -308,19 +324,19 @@ begin
Slopes(rptbis, rbis, slope, N, sumx, sumx2, sumxy, r, xsqr, mean);
Analyze(itemfail, grpfail, f, T, grppass, itempass, r, C1, min, max, p2);
if PlotItemDiffChk.Checked then PlotItems(r, i5, P);
if PlotScrsChk.Checked then PlotScrs(C1, s5, p2);
PlotItems(r, i5, P);
PlotScrs(C1, s5, p2);
PlotInfo(r, info, A, slope, P);
ChartPage.TabVisible := PlotItemDiffChk.Checked;
ScoresPage.TabVisible := PlotScrsChk.Checked;
ItemFuncsPage.TabVisible := ItemFuncsChk.Checked;
TestInfopage.TabVisible := TestInfoChk.Checked;
FinishIt(r, i5, rptbis, rbis, slope, mean, itemfail, P, lReport);
FReportFrame.DisplayReport(lReport);
ProxPage.TabVisible := ProxChk.Checked;
ChartPage.TabVisible := PlotItemDiffChk.Checked;
ScoresPage.TabVisible := PlotScrsChk.Checked;
ItemFuncsPage.TabVisible := ItemFuncsChk.Checked;
TestInfoPage.TabVisible := TestInfoChk.Checked;
finally
lReport.Free;
end;
@ -340,6 +356,8 @@ procedure TRaschForm.FinishIt(r: integer; const i5: IntDyneVec;
var
i: integer;
begin
AReport.Add('');
AReport.Add(DIVIDER_SMALL_AUTO);
AReport.Add('');
AReport.Add('Item Data Summary');
AReport.Add('');
@ -547,6 +565,20 @@ begin
end;
procedure TRaschForm.ItemListDblClick(Sender: TObject);
var
index: Integer;
begin
index := ItemList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(ItemList.Items[index]);
ItemList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TRaschForm.Maxability(const expdcnt, d2, e2: DblDyneVec;
const p1: DblDyneMat; const p2, P: DblDyneVec; C1, r: integer;
const D: DblDyneMat; const s5: IntDyneVec; noloops: integer; AReport: TStrings);
@ -554,8 +586,9 @@ var
i, j: integer;
d9: double;
begin
AReport.Add('Maximum Likelihood Iteration Number %d', [noLoops]);
d9 := 0.0;
AReport.Add('Maximum Likelihood Iteration Number %d', [noloops]);
for j := 0 to C1-1 do
begin
expdcnt[j] := 0.0;
@ -568,7 +601,7 @@ begin
for i := 0 to r-1 do
begin
expdcnt[j] := expdcnt[j] + p1[i,j];
// expected number in score group
// Expected number in score group
D[i,j] := exp(p2[j] - P[i]) / (sqrt(1.0 + exp(p2[j] - P[i])));
d2[j] := d2[j] + D[i,j]; // rate of change value
end;
@ -624,7 +657,7 @@ begin
end;
e1[i] := e1[i] / d1[i];
// adjustment for item difficulty estimates
// Adjustment for item difficulty estimates
if (abs(e1[i]) > d9) then d9 := abs(e1[i]);
P[i] := P[i] + e1[i];
end;
@ -649,6 +682,8 @@ procedure TRaschForm.MAXOUT(r, C1: integer; const i5, s5: IntDyneVec;
var
i, j: integer;
begin
AReport.Add('');
AReport.Add(DIVIDER_SMALL_AUTO);
AReport.Add('');
AReport.Add('Maximum Likelihood Estimates');
AReport.Add('');
@ -777,6 +812,9 @@ var
i: integer;
ser: TChartSeries;
begin
if not PlotItemDiffChk.Checked then
exit;
FItemDiffsChartFrame.Clear;
FItemDiffsChartFrame.SetTitle('LOG DIFFICULTIES FOR ITEMS');
FItemDiffsChartFrame.SetXTitle('Item');
@ -799,6 +837,9 @@ var
i: integer;
ser: TChartSeries;
begin
if not PlotScrsChk.Checked then
exit;
FScoresChartFrame.Clear;
FScoresChartFrame.SetTitle('LOG ABILITIES FOR SCORE GROUPS');
FScoresChartFrame.SetXTitle('Score');
@ -814,7 +855,7 @@ end;
procedure TRaschForm.PlotTest(const TestInfo: DblDyneMat;
ArraySize: integer; const Title: string{; Vdivisions, Hdivisions: integer});
ArraySize: integer; const Title: string);
var
i: integer;
ser: TChartSeries;
@ -834,10 +875,11 @@ end;
procedure TRaschForm.Prox(const P, p2: DblDyneVec; k, r, C1 : integer;
const L1: DblDyneVec; yexpand, xexpand: double; const g: DblDyneVec;
T: integer; const rowtot, i5, s5: IntDyneVec; AReport: TStrings);
T: integer; const rowtot, i5, s5: IntDyneVec);
var
tx, rowtx, errorterm, stdError: double;
i, j: integer;
lReport: TStrings;
begin
for i := 0 to r-1 do P[i] := L1[i] * yexpand;
for j := 0 to C1-1 do p2[j] := g[j] * xexpand;
@ -845,11 +887,12 @@ begin
if not ProxChk.Checked then
exit;
AReport.Add('');
AReport.Add('Prox values and Standard Errors' );
AReport.Add('');
AReport.Add('Item Scale Value Standard Error');
AReport.Add('---- ----------- --------------');
lReport := TStringList.Create;
try
lReport.Add('Prox values and Standard Errors' );
lReport.Add('');
lReport.Add('Item Scale Value Standard Error');
lReport.Add('---- ----------- --------------');
//xxx xxxxxxx xxxxxxx
tx := T;
@ -858,43 +901,47 @@ begin
rowtx := rowtot[i];
errorterm := tx / ((tx - rowtx) * rowtx);
stdError := yexpand * sqrt(errorterm);
if ProxChk.checked then
AReport.Add('%3d %7.3f %7.3f', [i5[i], P[i], stdError]);
lReport.Add('%3d %7.3f %7.3f', [i5[i], P[i], stdError]);
end;
AReport.Add('Y expansion factor: %8.4f', [yexpand]);
AReport.Add('');
AReport.Add('Score Scale Value Standard Error');
AReport.Add('----- ----------- --------------');
lReport.Add('Y expansion factor: %8.4f', [yexpand]);
lReport.Add('');
lReport.Add('Score Scale Value Standard Error');
lReport.Add('----- ----------- --------------');
// xxx xxxxxxx xxxxxxx
for j := 0 to C1-1 do
begin
stdError := xexpand * sqrt(k / (s5[j] * (k - s5[j])));
AReport.Add(' %3d %7.3f %7.3f', [s5[j], p2[j], stdError]);
lReport.Add(' %3d %7.3f %7.3f', [s5[j], p2[j], stdError]);
end;
lReport.Add('X expansion factor: %8.4f', [xexpand]);
FProxReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;
AReport.Add('X expansion factor: %8.4f', [xexpand]);
AReport.Add('');
end;
function TRaschForm.Reduce(k: integer; out r, T, C1: Integer;
const i5, RowTot, s5: IntDyneVec; const f: IntDyneMat; const S: IntDyneVec;
AReport: TStrings): integer;
AReport: TStrings): boolean;
var
done: boolean;
check, i, j, column, row: integer;
begin
// NOW REDUCE THE MATRIX BY ELIMINATING 0 OR 1 ROWS AND COLUMNS
// Reduce the matrix by eliminating 0 or 1 rows and columns
AReport.Add('');
//Store item numbers in i5 array and initialize row totals
// Store item numbers in i5 array and initialize row totals
for i := 0 to k-1 do
begin
i5[i] := i+1;
rowtot[i] := 0;
end;
//Store group numbers in s5 array
// Store group numbers in s5 array
r := k;
T := 0;
C1 := k - 1; // No. of score groups (all correct group eliminated)
@ -904,11 +951,11 @@ begin
T := T + S[j];
end;
//Get row totals of the failures matrix (item totals)
// Get row totals of the failures matrix (item totals)
for i := 0 to r-1 do
for j := 0 to C1-1 do rowtot[i] := rowtot[i] + f[i,j];
// now check for item elimination
// Check for item elimination
done := false;
while not done do
begin
@ -919,7 +966,8 @@ begin
AReport.Add('Row %3d for item %3d eliminated.', [i, i5[i-1]]);
if (i < r) then
begin
for j := i to r-1 do //move rows up to replace row i
// Move rows up to replace row i
for j := i to r-1 do
begin
for column := 1 to C1 do
f[j-1, column-1] := f[j, column-1];
@ -938,7 +986,7 @@ begin
done := true;
end;
// check for group elimination
// Check for group elimination
done := false;
j := 1;
while (not done) do
@ -963,10 +1011,10 @@ begin
if C1 = 0 then
begin
MessageDlg('Too many cases or variables eliminated', mtError, [mbOK], 0);
ErrorMsg('Too many cases or variables eliminated');
FReportFrame.DisplayReport(AReport);
AReport.clear;
Result := 1;
AReport.Clear;
Result := false;
exit;
end;
@ -980,10 +1028,10 @@ begin
C1 := C1 - 1;
if C1 = 0 then
begin
MessageDlg('Too many cases or variables eliminated', mtError, [mbOK], 0);
ErrorMsg('Too many cases or variables eliminated');
FReportFrame.DisplayReport(AReport);
AReport.Clear;
Result := 1;
Result := false;
exit;
end;
end;
@ -993,24 +1041,27 @@ begin
AReport.Add('Total number of score groups: %4d', [C1]);
AReport.Add('');
Result := 0;
end; // end of reduce
Result := true;
end;
procedure TRaschForm.Reset;
var
i: integer;
begin
inherited;
if FProxReportFrame <> nil then FProxReportFrame.Clear;
if FItemDiffsChartFrame <> nil then FItemDiffsChartFrame.Clear;
if FScoresChartFrame <> nil then FScoresChartFrame.Clear;
if FItemFuncsChartFrame <> nil then FItemFuncsChartFrame.Clear;
if FTestInfoChartFrame <> nil then FTestInfoChartFrame.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
ProxPage.TabVisible := false;
ChartPage.TabVisible := false;
ScoresPage.TabVisible := false;
ItemFuncsPage.TabVisible := false;
TestInfoPage.TabVisible := false;
CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
ItemList.Clear;
ProxChk.Checked := false;
@ -1081,6 +1132,8 @@ var
i, j: integer;
outline: string;
begin
AReport.Add('');
AReport.Add(DIVIDER_SMALL_AUTO);
AReport.Add('');
AReport.Add('Goodness of Fit Test for Each Item');
AReport.Add('');
@ -1107,6 +1160,7 @@ procedure TRaschForm.UpdateBtnStates;
begin
inherited;
if FProxReportFrame <> nil then FProxReportFrame.UpdateBtnStates;
if FItemDiffsChartFrame <> nil then FItemDiffsChartFrame.UpdateBtnStates;
if FScoresChartFrame <> nil then FScoresChartFrame.UpdateBtnStates;
if FItemFuncsChartFrame <> nil then FItemFuncsChartFrame.UpdateBtnStates;
@ -1132,6 +1186,20 @@ begin
end;
procedure TRaschForm.VarListDblClick(Sender: TObject);
var
index: Integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
ItemList.Items.Add(VarList.Items[index]);
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TRaschForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;

9
applications/lazstats/source/forms/analysis/multivariate/kmeansunit.pas
View File

@ -789,20 +789,19 @@ end;
procedure TKMeansForm.Reset;
var
i: integer;
begin
inherited;
CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
SelList.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
ReplaceChk.Checked := false;
StandardizeChk.Checked := true;
DescriptiveChk.Checked := false;
NoClustersEdit.Clear;
ItersEdit.Text := '100';
UpdateBtnStates;
end;

12
applications/lazstats/source/units/gridprocs.pas
View File

@ -8,6 +8,8 @@ uses
Classes, SysUtils, Grids,
Globals, DictionaryUnit;
procedure CollectVariableNames(AGrid: TStringGrid; AList: TStrings);
function CollectVecValues(AGrid: TStringGrid; AColIndex: Integer;
AColCheck: IntDyneVec = nil): DblDyneVec;
@ -42,6 +44,16 @@ implementation
uses
Math;
procedure CollectVariableNames(AGrid: TStringGrid; AList: TStrings);
var
i: Integer;
begin
AList.Clear;
for i := 1 to AGrid.ColCount-1 do
AList.Add(AGrid.Cells[i, 0]);
end;
{ Extracts the values in the given column from the grid and returns them as an
array.
Cells which are filtered or empty are not considered. This check is extended