pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
c95d86dba082c99173b6dc50f714c99dba0938a4
lazarus-ccr/applications/lazstats/source_orig/testscoreunit.pas
wp_xxyyzz eb017ea8b7 LazStats: Adding original source, part 8. 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7887 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2020-11-16 11:23:17 +00:00

1085 lines
35 KiB
ObjectPascal
Raw Blame History

unit TestScoreUnit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, MatrixLib, MainUnit, Globals, DataProcs, Math,
OutPutUnit, FunctionsLib, GraphLib, DictionaryUnit;
type
{ TTestScoreFrm }
TTestScoreFrm = class(TForm)
MeansPlotChk: TCheckBox;
HoytChk: TCheckBox;
DescChk: TCheckBox;
PlotChk: TCheckBox;
CorrsChk: TCheckBox;
SimultChk: TCheckBox;
FirstChk: TCheckBox;
ReplaceChk: TCheckBox;
AddChk: TCheckBox;
ListChk: TCheckBox;
AlphaChk: TCheckBox;
StepChk: TCheckBox;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
InBtn: TBitBtn;
OutBtn: TBitBtn;
LastInBtn: TBitBtn;
FirstInBtn: TBitBtn;
IDInBtn: TBitBtn;
Label14: TLabel;
Label15: TLabel;
ScoreEdit: TEdit;
Label13: TLabel;
ResponseEdit: TEdit;
Label12: TLabel;
RespNoEdit: TEdit;
ItemNoEdit: TEdit;
FractEdit: TEdit;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
Label10: TLabel;
Label11: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
LastNameEdit: TEdit;
FirstNameEdit: TEdit;
IDNoEdit: TEdit;
Label1: TLabel;
Label2: TLabel;
ItemList: TListBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
NoCorBtn: TRadioButton;
FractWrongBtn: TRadioButton;
ItemScroll: TScrollBar;
ResponseScroll: TScrollBar;
SumRespBtn: TRadioButton;
VarList: TListBox;
procedure CancelBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FirstChkClick(Sender: TObject);
procedure FirstInBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure IDInBtnClick(Sender: TObject);
procedure InBtnClick(Sender: TObject);
procedure ItemScrollChange(Sender: TObject);
procedure LastInBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure ResponseScrollChange(Sender: TObject);
procedure ReturnBtnClick(Sender: TObject);
private
{ private declarations }
NoItems : integer;
NoSelected : integer;
NCases : integer; // count of good records (not counting key if included)
ColNoSelected : IntDyneVec;
ColLabels, RowLabels : StrDyneVec;
Responses : array[1..5] of StrDyneVec;
RespWghts : array[1..5] of DblDyneVec;
Means, Variances, StdDevs : DblDyneVec;
CorMat : DblDyneMat; // correlations among items and total score
Data : DblDyneMat; //store item scores and total score
IDCol, FNameCol, LNameCol : integer;
MaxRespNo : integer;
procedure ItemScores(Sender: TObject);
procedure ScoreReport(Sender: TObject);
procedure Alpha(Sender: TObject);
procedure Cors(Sender: TObject);
procedure SimMR(Sender: TObject);
procedure Hoyt(Sender: TObject);
procedure StepKR(Sender: TObject);
procedure PlotScores(Sender: TObject);
procedure PlotMeans(Sender: TObject);
public
{ public declarations }
end;
var
TestScoreFrm: TTestScoreFrm;
implementation
{ TTestScoreFrm }
procedure TTestScoreFrm.ResetBtnClick(Sender: TObject);
VAR i, j : integer;
begin
ItemScroll.Min := 1;
ResponseScroll.Min := 1;
ItemScroll.Position := 1;
ResponseScroll.Position := 1;
InBtn.Visible := true;
OutBtn.Visible := false;
VarList.Items.Clear;
ItemList.Items.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
ItemNoEdit.Text := '1';
RespNoEdit.Text := '1';
ResponseEdit.Text := '1';
ScoreEdit.Text := '1';
FractEdit.Text := '4';
LastNameEdit.Text := '';
FirstNameEdit.Text := '';
IDNoEdit.Text := '';
NoCorBtn.Checked := true;
ReplaceChk.Checked := false;
AddChk.Checked := false;
ListChk.Checked := false;
AlphaChk.Checked := false;
SimultChk.Checked := false;
CorrsChk.Checked := false;
PlotChk.Checked := false;
DescChk.Checked := false;
FirstChk.Checked := true;
GroupBox2.Visible := false;
MaxRespNo := 0;
LastInBtn.Visible := true;
FirstInBtn.Visible := true;
IDInBtn.Visible := true;
StepChk.Checked := false;
HoytChk.Checked := false;
MeansPlotChk.Checked := false;
//allocate space on heap
SetLength(ColNoSelected,NoVariables);
SetLength(ColLabels,NoVariables+1);
SetLength(RowLabels,NoVariables+1);
SetLength(Means,NoVariables+1);
SetLength(Variances,NoVariables+1);
SetLength(StdDevs,NoVariables+1);
SetLength(CorMat,NoVariables+2,NoVariables+2);
SetLength(Data,NoCases+1,NoVariables+2);
for i := 1 to 5 do
begin
SetLength(RespWghts[i],NoVariables);
SetLength(Responses[i],NoVariables);
end;
for i := 1 to 5 do
begin
for j := 1 to NoVariables do
begin
RespWghts[i][j-1] := 1.0;
Responses[i][j-1] := '1';
end;
end;
end;
procedure TTestScoreFrm.ResponseScrollChange(Sender: TObject);
var
item, respno : integer;
begin
item := StrToInt(ItemNoEdit.Text);
if item <= 0 then exit;
respno := StrToInt(RespNoEdit.Text);
if respno > 5 then exit; // already at max
if respno > MaxRespNo then MaxRespNo := respno;
// save current response
Responses[respno][item-1] := ResponseEdit.Text;
RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text);
// display new position response
respno := ResponseScroll.Position;
RespNoEdit.Text := IntToStr(respno);
ResponseEdit.Text := Responses[respno][item-1];
ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]);
end;
procedure TTestScoreFrm.ReturnBtnClick(Sender: TObject);
begin
CancelBtnClick(self);
end;
procedure TTestScoreFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TTestScoreFrm.IDInBtnClick(Sender: TObject);
VAR index : integer;
begin
index := VarList.ItemIndex;
if index < 0 then exit;
IDNoEdit.Text := VarList.Items.Strings[index];
VarList.Items.Delete(index);
IDInBtn.Visible := false;
end;
procedure TTestScoreFrm.InBtnClick(Sender: TObject);
VAR i, index : integer;
begin
if VarList.ItemIndex < 0 then
begin
InBtn.Visible := false;
exit;
end;
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;
ItemScroll.Max := ItemList.Items.Count;
end;
procedure TTestScoreFrm.ItemScrollChange(Sender: TObject);
var
item, respno : integer;
begin
item := StrToInt(ItemNoEdit.Text);
respno := StrToInt(RespNoEdit.Text);
if respno > MaxRespNo then MaxRespNo := respno;
// save last one
if (item <> ItemScroll.Position) then
begin
Responses[respno][item-1] := ResponseEdit.Text;
RespWghts[respno][item-1] := StrToFloat(ScoreEdit.Text);
end;
item := ItemScroll.Position;
ItemNoEdit.Text := IntToStr(item);
respno := 1;
ResponseScroll.Position := 1; // first response
RespNoEdit.Text := '1'; // default
ScoreEdit.Text := '1'; // default
// load previous one
ResponseEdit.Text := Responses[respno][item-1];
ScoreEdit.Text := FloatToStr(RespWghts[respno][item-1]);
end;
procedure TTestScoreFrm.LastInBtnClick(Sender: TObject);
VAR index : integer;
begin
index := VarList.ItemIndex;
if index < 0 then exit;
LastNameEdit.Text := VarList.Items.Strings[index];
VarList.Items.Delete(index);
LastInBtn.Visible := false;
end;
procedure TTestScoreFrm.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);
InBtn.Visible := true;
end;
procedure TTestScoreFrm.CancelBtnClick(Sender: TObject);
VAR i : integer;
begin
for i := 1 to 5 do
begin
Responses[i] := nil;
RespWghts[i] := nil;
end;
Data := nil;
CorMat := nil;
StdDevs := nil;
Variances := nil;
Means := nil;
RowLabels := nil;
ColLabels := nil;
ColNoSelected := nil;
TestScoreFrm.Hide;
end;
procedure TTestScoreFrm.ComputeBtnClick(Sender: TObject);
var
i, j, col, start, count : integer;
cellstring : string;
begin
OutPutFrm.RichEdit.Clear;
NoItems := ItemList.Items.Count;
// Insure last item scoring definition is saved
if FirstChk.Checked = false then ItemScroll.Position := 1;
for i := 1 to NoItems do // items to analyze
begin
for j := 1 to NoVariables do // variables in grid
begin
cellstring := OS3MainFrm.DataGrid.Cells[j,0];
if cellstring = ItemList.Items.Strings[i-1] then
begin // matched - save info
ColNoSelected[i-1] := j;
ColLabels[i-1] := cellstring;
RowLabels[i-1] := cellstring;
end; // end match
end; // next j
end; // next i
ColLabels[NoItems] := 'TOTAL';
RowLabels[NoItems] := 'TOTAL';
for j := 1 to NoVariables do
begin
cellstring := OS3MainFrm.DataGrid.Cells[j,0];
if cellstring = IDNoEdit.Text then IDCol := j;
if cellstring = LastNameEdit.Text then LNameCol := j;
if cellstring = FirstNameEdit.Text then FNameCol := j;
end;
if FirstChk.Checked then // first record is the key
begin
for i := 1 to NoItems do
begin
col := ColNoSelected[i-1];
Responses[1][i-1] := Trim(OS3MainFrm.DataGrid.Cells[col,1]);
RespWghts[1][i-1] := 1.0;
MaxRespNo := 1;
end;
end;
// check to see if grid item values are numeric or string
// if numeric, insure that they are integers, not floating values
for i := 1 to NoItems do
begin
col := ColNoSelected[i-1];
if isnumeric(OS3MainFrm.DataGrid.Cells[col,2]) then // second case
begin
if DictionaryFrm.DictGrid.Cells[5,col] <> '0' then
begin
ShowMessage('Sorry, you must format cell values with 0 decimal parts.');
exit;
end;
end;
end;
// now score the responses
ItemScores(self);
// place item scores in grid if elected
if ReplaceChk.Checked then
begin
if FirstChk.Checked then start := 2 else start := 1;
count := 0;
for i := start to NoCases do
begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
count := count + 1;
for j := 1 to NoItems do
begin
col := ColNoSelected[j-1];
OS3MainFrm.DataGrid.Cells[col,i] := FloatToStr(Data[count-1,j-1]);
end;
end;
end;
// add total to grid if elected
if AddChk.Checked then
begin
cellstring := 'TOTAL';
col := NoVariables + 1;
DictionaryFrm.NewVar(col);
DictionaryFrm.DictGrid.Cells[1,NoVariables] := cellstring;
OS3MainFrm.DataGrid.Cells[NoVariables,0] := cellstring;
DictionaryFrm.DictGrid.Cells[1,col] := cellstring;
count := 0;
if FirstChk.Checked then start := 2 else start := 1;
for i := start to NoCases do
begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
count := count + 1;
col := NoVariables;
OS3MainFrm.DataGrid.Cells[col,i] := FloatToStr(Data[count-1,NoItems]);
end;
end;
// list the scores if elected
if ListChk.Checked then ScoreReport(self);
// get Cronbach Alpha reliability estimate if elected
if AlphaChk.Checked then Alpha(self);
// get intraclass reliabilities (Hoyt) if elected
if HoytChk.Checked then Hoyt(self);
// get step kr#20 if elected
if StepChk.Checked then StepKR(self);
// get interitem correlation matrix if elected
if CorrsChk.Checked then Cors(self);
// Get simultaneous multiple regressions if elected
if SimultChk.Checked then SimMR(self);
// plot subject scores if elected
if PlotChk.Checked then PlotScores(self);
// Plot item means if elected
if MeansPlotChk.Checked then PlotMeans(self);
end;
procedure TTestScoreFrm.FirstChkClick(Sender: TObject);
begin
if FirstChk.Checked then GroupBox2.Visible := false else
GroupBox2.Visible := true;
end;
procedure TTestScoreFrm.FirstInBtnClick(Sender: TObject);
VAR index : integer;
begin
index := VarList.ItemIndex;
if index < 0 then exit;
FirstNameEdit.Text := VarList.Items.Strings[index];
VarList.Items.Delete(index);
FirstInBtn.Visible := false;
end;
procedure TTestScoreFrm.ItemScores(Sender: TObject);
var
start, i, j, k, count, col : integer;
score, denom, fract : double;
response : string;
begin
if FirstChk.Checked then start := 2 else start := 1;
count := 0;
for i := start to NoCases do
begin
score := 0.0;
if (not GoodRecord(i,NoSelected,ColNoSelected)) then continue;
count := count + 1;
for j := 1 to NoItems do
begin
col := ColNoSelected[j-1];
response := Trim(OS3MainFrm.DataGrid.Cells[col,i]);
for k := 1 to MaxRespNo do
begin
if (response = Responses[k][j-1])then
begin
if SumRespBtn.Checked = true then
begin
score := score + RespWghts[k][j-1];
Data[count-1,j-1] := RespWghts[k][j-1];
end;
if NoCorBtn.Checked = true then
begin
score := score + 1;
Data[count-1,j-1] := 1;
end;
if FractWrongBtn.Checked = true then
begin
denom := StrToFloat(FractEdit.Text);
fract := 1.0 / denom;
score := score + RespWghts[k][j-1] - (fract * RespWghts[k][j-1]);
Data[count-1,j-1] :=RespWghts[k][j-1] - (fract * RespWghts[k][j-1]);
end;
end;
end;
end; // next item in scale
Data[count-1,NoItems] := score;
end; // next case
NCases := count;
end;
procedure TTestScoreFrm.ScoreReport(Sender: TObject);
var
i, start, count, col : integer;
outline, namestr : string;
begin
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('TEST SCORING REPORT');
OutPutFrm.RichEdit.Lines.Add('');
if FirstChk.Checked then start := 2 else start := 1;
outline := '';
if IDNoEdit.Text <> '' then outline := outline + 'PERSON ID NUMBER '
else outline := outline + 'CASE ';
if FirstNameEdit.Text <> '' then outline := outline + 'FIRST NAME ';
if LastNameEdit.Text <> '' then outline := outline + 'LAST NAME ';
outline := outline + 'TEST SCORE';
OutPutFrm.RichEdit.Lines.Add(outline);
count := 0;
for i := start to NoCases do
begin
if not GoodRecord(i,NoSelected,ColNoSelected) then continue;
count := count + 1;
outline := '';
if IDNoEdit.Text <> '' then
begin
col := IDCol;
namestr := Trim(OS3MainFrm.DataGrid.Cells[col,i]);
outline := outline + format('%16s ',[namestr]);
end
else
begin
namestr := Trim(OS3MainFrm.DataGrid.Cells[0,i]);
outline := outline + format('%-16s ',[namestr]);
end;
if FirstNameEdit.Text <> '' then
begin
col := FNameCol;
namestr := Trim(OS3MainFrm.DataGrid.Cells[col,i]);
outline := outline + format('%10s ',[namestr]);
end;
if LastNameEdit.Text <> '' then
begin
col := LNameCol;
namestr := Trim(OS3MainFrm.DataGrid.Cells[col,i]);
outline := outline + format('%10s ',[namestr]);
end;
outline := outline + format('%6.2f',[Data[count-1,NoItems]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
OutPutFrm.ShowModal;
end;
procedure TTestScoreFrm.Alpha(Sender: TObject);
var
i, j : integer;
AlphaRel, SEMeas : double;
outline : string;
begin
OutPutFrm.RichEdit.Clear;
OutPutFrm.RichEdit.Lines.Add('');
AlphaRel := 0.0;
// get item variances
for j := 1 to NoItems + 1 do
begin
Variances[j-1] := 0.0;
Means[j-1] := 0.0;
end;
for j := 1 to NoItems + 1 do
begin
for i := 1 to NCases do
begin
Variances[j-1] := Variances[j-1] + sqr(Data[i-1,j-1]);
Means[j-1] := Means[j-1] + Data[i-1,j-1];
end;
end;
for j := 1 to NoItems + 1 do
begin
Variances[j-1] := Variances[j-1] - (sqr(Means[j-1]) / NCases);
Variances[j-1] := Variances[j-1] / (NCases - 1);
Means[j-1] := Means[j-1] / NCases;
end;
for i := 1 to NoItems do
begin
AlphaRel := AlphaRel + variances[i-1]; // sum of item variances
end;
AlphaRel := AlphaRel / variances[NoItems];
AlphaRel := 1.0 - AlphaRel;
AlphaRel := (NoItems / (NoItems - 1.0)) * AlphaRel;
if AlphaRel > 1.0 then AlphaRel := 1.0;
SEMeas := sqrt(Variances[NoItems]) * sqrt(1.0 - AlphaRel);
outline := format('Alpha Reliability Estimate for Test = %6.4f S.E. of Measurement = %8.3f',
[AlphaRel,SEMeas]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.ShowModal;
end;
procedure TTestScoreFrm.Cors(Sender: TObject);
var
i, j, k : integer;
title : string;
begin
OutPutFrm.RichEdit.Clear;
for i := 1 to NoItems +1 do
begin
for j := 1 to NoItems + 1 do
begin
CorMat[i-1,j-1] := 0.0;
end;
Means[i-1] := 0.0;
Variances[i-1] := 0.0;
end;
for i := 1 to NCases do
begin
for j := 1 to NoItems + 1 do
begin
for k := 1 to NoItems + 1 do
begin
CorMat[j-1,k-1] := Cormat[j-1,k-1] + (Data[i-1,j-1] * Data[i-1,k-1]);
end;
Means[j-1] := Means[j-1] + Data[i-1,j-1];
Variances[j-1] := Variances[j-1] + sqr(Data[i-1,j-1]);
end;
end;
for i := 1 to NoItems + 1 do
begin
Variances[i-1] := Variances[i-1] - (sqr(Means[i-1]) / NCases);
Variances[i-1] := Variances[i-1] / (NCases - 1);
StdDevs[i-1] := sqrt(Variances[i-1]);
end;
for i := 1 to NoItems + 1 do
begin
for j := 1 to NoItems + 1 do
begin
CorMat[i-1,j-1] := CorMat[i-1,j-1] - (Means[i-1] * Means[j-1] / NCases);
CorMat[i-1,j-1] := CorMat[i-1,j-1] / (NCases - 1);
if (StdDevs[i-1] > 0) and (StdDevs[j-1] > 0) then
CorMat[i-1,j-1] := CorMat[i-1,j-1] / (StdDevs[i-1] * StdDevs[j-1])
else begin
ShowMessage('ERROR! A zero variance found.');
CorMat[i-1,j-1] := 99.99;
end;
end;
end;
for i := 1 to NoItems + 1 do Means[i-1] := Means[i-1] / NCases;
if CorrsChk.Checked then
begin
title := 'Item and Total Score Intercorrelations';
MAT_PRINT(CorMat,NoItems + 1,NoItems + 1,title,RowLabels,ColLabels,NCases);
end;
if DescChk.Checked then
begin
title := 'Means';
DynVectorPrint(means,NoItems+1,title,ColLabels,NCases);
title := 'Variances';
DynVectorPrint(variances,NoItems+1,title,ColLabels,NCases);
title := 'Standard Deviations';
DynVectorPrint(stddevs,NoItems+1,title,ColLabels,NCases);
end;
if (CorrsChk.Checked) or (DescChk.Checked) then OutPutFrm.ShowModal;
end;
procedure TTestScoreFrm.SimMR(Sender: TObject);
Label cleanup;
var
i, j : integer;
determinant, df1, df2, StdErr, x : double;
outline, valstring : string;
CorrMat : DblDyneMat;
ProdMat : DblDyneMat;
R2s : DblDyneVec;
W : DblDyneVec;
FProbs : DblDyneVec;
errorcode : boolean;
title : string;
begin
SetLength(CorrMat,NoVariables+1,NoVariables+1);
SetLength(R2s,NoVariables);
SetLength(W,NoVariables);
SetLength(FProbs,NoVariables);
SetLength(ProdMat,NoVariables+1,NoVariables+1);
OutPutFrm.RichEdit.Clear;
if CorrsChk.Checked = false then Cors(self);
determinant := 0.0;
for i := 0 to NoItems-1 do
for j := 0 to NoItems-1 do
CorrMat[i,j] := CorMat[i,j];
Determ(CorrMat,NoItems,NoItems,determinant,errorcode);
if (determinant < 0.000001) then
begin
ShowMessage('ERROR! Matrix is singular!');
goto cleanup;
end;
outline := format('Determinant of correlation matrix = %8.4f',[determinant]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
for i := 0 to NoItems-1 do
for j := 0 to NoItems-1 do
CorrMat[i,j] := CorMat[i,j];
SVDinverse(CorrMat,NoItems);
OutPutFrm.RichEdit.Lines.Add('Multiple Correlation Coefficients for Each Variable');
OutPutFrm.RichEdit.Lines.Add('');
outline := format('%10s%8s%10s%10s%12s%5s%5s',['Variable','R','R2','F','Prob.>F','DF1','DF2']);
OutPutFrm.RichEdit.Lines.Add(outline);
df1 := NoItems - 1.0;
df2 := NCases - NoItems;
for i := 0 to NoItems-1 do
begin // R squared values
R2s[i] := 1.0 - (1.0 / CorrMat[i,i]);
W[i] := (R2s[i] / df1) / ((1.0-R2s[i]) / df2);
FProbs[i] := probf(W[i],df1,df2);
valstring := format('%10s',[ColLabels[i]]);
outline := format('%10s%10.3f%10.3f%10.3f%10.3f%5.0f%5.0f',
[valstring,sqrt(R2s[i]),R2s[i],W[i],FProbs[i],df1,df2]);
OutPutFrm.RichEdit.Lines.Add(outline);
for j := 0 to NoItems-1 do
begin // betas
ProdMat[i,j] := -CorrMat[i,j] / CorrMat[j,j];
end;
end;
title := 'Betas in Columns';
MAT_PRINT(ProdMat,NoItems,NoItems,title,RowLabels,ColLabels,NCases);
OutPutFrm.RichEdit.Lines.Add('Standard Errors of Prediction');
OutPutFrm.RichEdit.Lines.Add('Variable Std.Error');
for i := 0 to NoItems-1 do
begin
StdErr := (NCases-1) * Variances[i] * (1.0 / CorrMat[i,i]);
StdErr := sqrt(StdErr / (NCases - NoItems));
valstring := format('%10s',[ColLabels[i]]);
outline := format('%10s%10.3f',[valstring,StdErr]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
for i := 0 to NoItems-1 do
for j := 0 to NoItems-1 do
if (i <> j) then ProdMat[i,j] := ProdMat[i,j] * (StdDevs[j]/StdDevs[i]);
title := 'Raw Regression Coefficients';
MAT_PRINT(ProdMat,NoItems,NoItems,title,RowLabels,ColLabels,NCases);
OutPutFrm.RichEdit.Lines.Add('Variable Constant');
for i := 0 to NoItems-1 do
begin
x := 0.0;
for j := 0 to NoItems-1 do
begin
if (i <> j) then x := x + (ProdMat[j,i] * Means[j]);
end;
x := Means[i] - x;
valstring := format('%10s',[ColLabels[i]]);
outline := format('%10s%10.3f',[valstring,x]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
cleanup:
ProdMat := nil;
FProbs := nil;
W := nil;
R2s := nil;
CorrMat := nil;
OutPutFrm.ShowModal;
end;
procedure TTestScoreFrm.Hoyt(Sender: TObject);
var
i, j, k, col : integer;
Hoyt1, Hoyt2, Hoyt3, Hoyt4, SEMeas1, SEMeas2, SEMeas3, SEMeas4 : double;
SSError, SSCases, SSItems, SSWithin, TotalSS, TotalX, Constant : double;
MSItems, MSWithin, MSTotal, MSCases, MSError, score, ItemTotal : double;
F1, F2, prob1, prob2, dfcases, dfwithin, dferror, dftotal : double;
dfitems : double;
outline : string;
begin
if CorrsChk.Checked = false then Cors(self);
OutPutFrm.RichEdit.clear;
SSCases := 0.0;
SSItems := 0.0;
TotalSS := 0.0;
TotalX := 0.0;
for j := 1 to NoItems do
begin
ItemTotal := 0.0;
for i := 1 to NCases do //subject loop
begin
score := Data[i-1,j-1];
ItemTotal := ItemTotal + score;
TotalSS := TotalSS + (score * score);
end;
TotalX := TotalX + ItemTotal;
SSItems := SSItems + (ItemTotal * ItemTotal) / NCases;
end;
for i := 1 to NCases do // subject loop
begin
score := Data[i-1,NoItems];
SSCases := SSCases + (score * score);
end;
SSCases := SSCases / NoItems;
Constant := (TotalX * TotalX) / (NCases * NoItems);
SSCases := SSCases - Constant;
TotalSS := TotalSS - Constant;
SSWithin := TotalSS - SSCases;
SSItems := SSItems - Constant;
MSItems := SSItems / (NoItems - 1);
SSError := SSWithin - SSItems;
MSWithin := SSWithin / (NCases * (NoItems - 1));
MSTotal := TotalSS / ((NCases * NoItems) - 1.0);
MSCases := SSCases / (NCases - 1.0);
MSError := SSError / ((NCases - 1.0) * (NoItems - 1.0));
dfcases := NCases - 1;
dfitems := NoItems - 1;
dfwithin := NCases * (NoItems - 1);
dferror := (NCases - 1) * (NoItems - 1);
dftotal := (NCases * NoITems) - 1;
F1 := MSCases / MSError;
F2 := MSItems / MSError;
prob1 := probf(F1,dfcases,dferror);
prob2 := probf(F2,dfitems,dferror);
OutPutFrm.RichEdit.Lines.Add('Analysis of Variance for Hoyt Reliabilities');
OutPutFrm.RichEdit.Lines.Add('');
OutPutFrm.RichEdit.Lines.Add('SOURCE D.F. SS MS F PROB');
outline := format('Subjects %3.0f %8.2f %8.2f %8.2f %8.2f',
[dfcases,SSCases,MSCases,F1,prob1]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Within %3.0f %8.2f %8.2f',
[dfwithin,SSWithin,MSWithin]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Items %3.0f %8.2f %8.2f %8.2f %8.2f',
[dfitems,SSItems,MSItems,F2,prob2]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Error %3.0f %8.2f %8.2f',
[dferror,SSerror,MSerror]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := format('Total %3.0f %8.2f',
[dftotal,TotalSS, MSTotal]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.RichEdit.Lines.Add('');
Hoyt1 := 1.0 - (MSWithin / MSCases);
Hoyt2 := (MSCases - MSError) / MSCases;
Hoyt4 := (MSCases - MSError) /
(MSCases + (NoItems-1.0)*MSError);
Hoyt3 := (MSCases - MSWithin) /
(MSCases + (NoItems-1.0) * MSWithin);
SEMeas1 := stddevs[NoItems] * sqrt(1.0 - Hoyt1);
outline := format('Hoyt Unadjusted Test Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f',
[ColLabels[NoItems],Hoyt1,SEMeas1]);
OutPutFrm.RichEdit.Lines.Add(outline);
SEMeas2 := stddevs[NoItems] * sqrt(1.0 - Hoyt2);
outline := format('Hoyt Adjusted Test Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f',
[ColLabels[NoItems],Hoyt2,SEMeas2]);
OutPutFrm.RichEdit.Lines.Add(outline);
SEMeas3 := stddevs[NoItems] * sqrt(1.0 - Hoyt3);
outline := format('Hoyt Unadjusted Item Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f',
[ColLabels[NoItems],Hoyt3,SEMeas3]);
OutPutFrm.RichEdit.Lines.Add(outline);
SEMeas4 := stddevs[NoItems] * sqrt(1.0 - Hoyt4);
outline := format('Hoyt Adjusted Item Rel. for scale %s = %6.4f S.E. of Measurement = %8.3f',
[ColLabels[NoItems],Hoyt4,SEMeas4]);
OutPutFrm.RichEdit.Lines.Add(outline);
OutPutFrm.ShowModal;
end;
procedure TTestScoreFrm.StepKR(Sender: TObject);
var
i, j, col : integer;
score, KR20, meanscore, scorevar, sumvars, hicor : double;
selected : IntDyneVec;
v1, v2, nselected, incount : integer;
invalues : IntDyneVec;
PtBis : DblDyneVec;
outline : string;
done : boolean;
begin
SetLength(selected,NoVariables);
SetLength(invalues,NoVariables);
SetLength(PtBis,NoVariables);
Cors(self);
OutPutFrm.RichEdit.Clear;
v1 := 0;
v2 := 0;
nselected := NoItems;
for i := 1 to nselected do selected[i-1] := i;
// pick highest correlation for items to start
hicor := -1.0;
for i := 1 to nselected - 1 do
begin
for j := i + 1 to nselected do
begin
if CorMat[i-1,j-1] > hicor then
begin
hicor := CorMat[i-1,j-1];
v1 := i;
v2 := j;
end;
end;
end;
invalues[0] := v1; // cor matrix col
invalues[1] := v2; // cor matrix row
incount := 2;
// now add items based on highest pt.bis. with subscores
done := false;
repeat
begin
meanscore := 0.0;
scorevar := 0.0;
sumvars := 0.0;
for j := 1 to nselected do PtBis[j-1] := 0.0;
// first get score for each subject
for i := 1 to NCases do
begin
score := 0;
for j := 1 to incount do
begin
col := selected[invalues[j-1]-1];
score := score + Data[i-1,col-1];
end;
meanscore := meanscore + score;
scorevar := scorevar + sqr(score);
for j := 1 to nselected do
begin
col := selected[j-1];
PtBis[j-1] := PtBis[j-1] + (score * Data[i-1,col-1]);
end;
end;
scorevar := scorevar - (sqr(meanscore) / NCases);
scorevar := scorevar / (NCases - 1);
for j := 1 to nselected do
begin
if (Variances[j-1] > 0) and (scorevar > 0) then
begin
PtBis[j-1] := PtBis[j-1] - (meanscore * Means[j-1]);
PtBis[j-1] := PtBis[j-1] / (NCases - 1);
PtBis[j-1] := PtBis[j-1] / sqrt(Variances[j-1] * scorevar);
end else PtBis[j-1] := 0.0;
end;
meanscore := meanscore / NCases;
// get sum of item variances
for j := 1 to incount do sumvars := sumvars + Variances[invalues[j-1]-1];
KR20 := (incount / (incount - 1)) * (1.0 - sumvars / scorevar);
outline := format('KR#20 = %6.4f for the test with mean = %6.3f and variance = %6.3f',
[KR20,meanscore, scorevar]);
OutPutFrm.RichEdit.Lines.Add(outline);
outline := 'Item Mean Variance Pt.Bis.r';
OutPutFrm.RichEdit.Lines.Add(outline);
for j := 1 to incount do
begin
outline := format('%3d %6.3f %6.3f %6.4f',
[selected[invalues[j-1]-1],Means[invalues[j-1]-1],Variances[invalues[j-1]-1],PtBis[invalues[j-1]-1]]);
OutPutFrm.RichEdit.Lines.Add(outline);
end;
if incount = nselected then done := true else
begin
hicor := -1.0;
for j := 1 to incount do PtBis[invalues[j-1]-1] := -2.0;
for j := 1 to nselected do
begin
if PtBis[j-1] > hicor then
begin
v1 := j;
hicor := PtBis[j-1];
end;
end;
incount := incount + 1;
invalues[incount-1] := v1;
end;
end;
until done;
OutPutFrm.ShowModal;
// cleanup
PtBis := nil;
invalues := nil;
selected := nil;
end;
procedure TTestScoreFrm.PlotScores(Sender: TObject);
var
rowvar : DblDyneVec;
totscrs : DblDyneVec;
i, j : integer;
temp : double;
begin
SetLength(rowvar,NoCases);
SetLength(totscrs,NoCases);
// use rowvar to hold case no.
for i := 1 to NCases do rowvar[i-1] := i;
// use totscrs to hold total subject scores
for i := 1 to NCases do totscrs[i-1] := Data[i-1,NoItems];
// sort into ascending order
for i := 1 to NCases - 1 do
begin
for j := i + 1 to NCases do
begin
if totscrs[i-1] > totscrs[j-1] then // swap
begin
temp := totscrs[j-1];
totscrs[j-1] := totscrs[i-1];
totscrs[i-1] := temp;
temp := rowvar[j-1];
rowvar[j-1] := rowvar[i-1];
rowvar[i-1] := temp;
end;
end;
end;
SetLength(GraphFrm.Ypoints,1,NoCases);
SetLength(GraphFrm.Xpoints,1,NoCases);
for i := 1 to NoCases do
begin
GraphFrm.Ypoints[0,i-1] := totscrs[i-1];
GraphFrm.Xpoints[0,i-1] := rowvar[i-1];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := NoCases;
GraphFrm.Heading := 'DISTRIBUTION OF TOTAL SCORES';
GraphFrm.XTitle := 'Case';
GraphFrm.YTitle := 'Score';
// GraphFrm.Ypoints[1] := totscrs;
// GraphFrm.Xpoints[1] := rowvar;
GraphFrm.barwideprop := 0.5;
GraphFrm.AutoScale := true;
GraphFrm.GraphType := 2; // 3d Vertical Bar Chart
GraphFrm.BackColor := clYellow;
GraphFrm.WallColor := clBlack;
GraphFrm.FloorColor := clLtGray;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
rowvar := nil;
totscrs := nil;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
end;
procedure TTestScoreFrm.PlotMeans(Sender: TObject);
var
rowvar : DblDyneVec;
i : integer;
begin
SetLength(rowvar,NoItems);
SetLength(GraphFrm.Ypoints,1,NoItems);
SetLength(GraphFrm.Xpoints,1,NoItems);
// use rowvar to hold variable no.
for i := 1 to NoItems do
begin
rowvar[i-1] := i;
GraphFrm.Xpoints[0,i-1] := i;
GraphFrm.Ypoints[0,i-1] := Means[i-1];
end;
GraphFrm.nosets := 1;
GraphFrm.nbars := NoItems;
GraphFrm.Heading := 'ITEM MEANS';
GraphFrm.XTitle := 'Item No.';
GraphFrm.YTitle := 'Mean';
GraphFrm.barwideprop := 0.5;
GraphFrm.AutoScale := true;
GraphFrm.GraphType := 2; // 3d Vertical Bar Chart
GraphFrm.BackColor := clYellow;
GraphFrm.WallColor := clBlack;
GraphFrm.FloorColor := clLtGray;
GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal;
rowvar := nil;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
end;
initialization
{$I testscoreunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink