// File for testing: itemdata2.laz // Select the variables VAR1...VAR5 unit RaschUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls, MainUnit, OutputUnit, FunctionsLib, GraphLib, Globals, DataProcs, ContextHelpUnit; type { TRaschFrm } TRaschFrm = class(TForm) Bevel1: TBevel; HelpBtn: TButton; ResetBtn: TButton; ComputeBtn: TButton; CloseBtn: TButton; ProxChk: TCheckBox; PlotItemsChk: TCheckBox; PlotScrsChk: TCheckBox; ItemInfoChk: TCheckBox; TestInfoChk: TCheckBox; GroupBox1: TGroupBox; InBtn: TBitBtn; Label2: TLabel; ItemList: TListBox; OutBtn: TBitBtn; Label1: TLabel; VarList: TListBox; procedure ComputeBtnClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure HelpBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; User: boolean); private { private declarations } FAutoSized: Boolean; procedure UpdateBtnStates; procedure Analyze(const itemfail, grpfail: IntDyneVec; const f: IntDyneMat; var T: integer; const grppass, itempass: IntDyneVec; r, C1: integer; out min, max: double; const p2: DblDyneVec); procedure Expand(v1, v2: double; out xExpand, yExpand: Double); procedure FinishIt(r: integer; const i5: IntDyneVec; const rptbis, rbis, slope, mean: DblDyneVec; const itemfail: IntDyneVec; const P: DblDyneVec; AReport: TStrings); procedure Frequencies(C1, r: integer; const f: IntDyneMat; const rowtot, i5, s5: IntDyneVec; T: integer; const S: IntDyneVec; AReport: TStrings); procedure GetLogs(const L, L1, L2, g, g2, f2: DblDyneVec; const rowtot: IntDyneVec; k: integer; const s5, S: IntDyneVec; T, r, C1: integer; var v1, v2: double; AReport: TStrings); procedure GetScores(NoSelected: integer; const Selected: IntDyneVec; NoCases: integer; const f: IntDyneMat; const Mean, XSqr, SumXY: DblDyneVec; const S, X: IntDyneVec; out sumx, sumx2: double; var N: integer; AReport: TStrings); procedure 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); function MaxItem(const R1, d1: DblDyneVec; const p1, D: DblDyneMat; const e1, p2, P: DblDyneVec; const S, rowtot: IntDyneVec; T, r, C1 : integer) : double; procedure MaxOut(r, C1: integer; const i5, s5: IntDyneVec; 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); function Reduce(k: integer; out r, T, C1: integer; const i5, rowtot, s5: IntDyneVec; const f: IntDyneMat; const S: IntDyneVec; AReport: TStrings): integer; procedure Slopes(const rptbis, rbis, slope: DblDyneVec; N: integer; sumx, sumx2: double; const sumxy: DblDyneVec; r: integer; const xsqr, mean: DblDyneVec); procedure TestFit(r, C1: integer; const f: IntDyneMat; const S: IntDyneVec; const P, P2: DblDyneVec; T: integer; AReport: TStrings); procedure PlotInfo(k, r: integer; const Info, A: DblDyneMat; const Slope, P: DblDyneVec); procedure Plot(const xyArray: DblDyneMat; ArraySize: integer; const Title: string; Vdivisions, Hdivisions: integer); 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); public { public declarations } end; var RaschFrm: TRaschFrm; implementation uses Math, Utils; { TRaschFrm } procedure TRaschFrm.ResetBtnClick(Sender: TObject); var i: integer; begin VarList.Clear; ItemList.Clear; ProxChk.Checked := false; PlotItemsChk.Checked := false; PlotScrsChk.Checked := false; ItemInfoChk.Checked := false; TestInfoChk.Checked := false; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); UpdateBtnStates; end; procedure TRaschFrm.FormActivate(Sender: TObject); var w: Integer; begin if FAutoSized then exit; w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); HelpBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w; Constraints.MinWidth := Width; Constraints.MinHeight := Height; FAutoSized := true; end; procedure TRaschFrm.FormCreate(Sender: TObject); begin Assert(OS3MainFrm <> nil); if OutputFrm = nil then Application.CreateForm(TOutputFrm, OutputFrm); if GraphFrm = nil then Application.CreateForm(TGraphFrm, GraphFrm); end; procedure TRaschFrm.FormShow(Sender: TObject); begin ResetBtnClick(self); end; procedure TRaschFrm.HelpBtnClick(Sender: TObject); begin if ContextHelpForm = nil then Application.CreateForm(TContextHelpForm, ContextHelpForm); ContextHelpForm.HelpMessage((Sender as TButton).tag); end; procedure TRaschFrm.ComputeBtnClick(Sender: TObject); var i, j, k1, N, C1, r, T,noloops : integer; sumx, sumx2, v1, v2, xexpand, yexpand, d9, min, max : double; X, rowtot, itemfail, itempass, grpfail, grppass, S, s5, i5 : IntDyneVec; f : IntDyneMat; mean, xsqr, sumxy, L, L1, L2, g, g2, f2, P, p2, R1, d1, e1 : DblDyneVec; expdcnt, d2 : DblDyneVec; e2, rptbis, rbis, slope : DblDyneVec; p1, D, info, A : DblDyneMat; NoSelected : integer; ColNoSelected : IntDyneVec; finished : boolean; cellstring : string; error : integer; lReport: TStrings; begin SetLength(ColNoSelected,NoVariables); SetLength(mean,NoVariables); SetLength(xsqr,NoVariables); SetLength(sumxy,NoVariables); SetLength(L,NoVariables); SetLength(L1,NoVariables); SetLength(L2,NoVariables); SetLength(g,NoVariables); SetLength(g2,NoVariables); SetLength(f2,NoVariables); SetLength(P,NoVariables); SetLength(p2,NoVariables); SetLength(R1,NoVariables); SetLength(d1,NoVariables); SetLength(e1,NoVariables); SetLength(expdcnt,NoVariables); SetLength(d2,NoVariables); SetLength(e2,NoVariables); SetLength(rptbis,NoVariables); SetLength(rbis,NoVariables); SetLength(slope,NoVariables); SetLength(p1,NoVariables,NoVariables); SetLength(D,NoVariables,NoVariables); SetLength(info,52,52); SetLength(A,52,2); SetLength(X,NoVariables); SetLength(rowtot,NoVariables); SetLength(itemfail,NoVariables); SetLength(itempass,NoVariables); SetLength(grpfail,NoVariables); SetLength(grppass,NoVariables); SetLength(S,NoVariables+2); SetLength(s5,NoVariables); SetLength(i5,NoVariables); SetLength(f,NoVariables+2,NoVariables+2); if (NoVariables < 1) then begin MessageDlg('You must have data in your data grid.', mtError, [mbOK], 0); exit; end; // Get selected variables NoSelected := ItemList.Items.Count; for i := 1 to NoSelected do begin for j := 1 to NoVariables do begin cellstring := OS3MainFrm.DataGrid.Cells[j,0]; if cellstring = ItemList.Items.Strings[i-1] then ColNoSelected[i-1] := j; end; end; //begin ( main program ) finished := false; N := NoCases; k1 := NoSelected; 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 exit; Frequencies(C1, r, f, rowtot, i5, s5, T, S, lReport); v1 := 0.0; 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) // estimates noloops := 0; while (not finished) do begin d9 := MaxItem(R1, d1, p1, D, e1, p2, P, S, rowtot, T, r, C1); if (d9 < 0.01) then finished := true else Maxability(expdcnt, d2, e2, p1, p2, P, C1, r, D, s5, noloops, lReport); noloops := noloops + 1; if (noloops > 25) then begin MessageDlg('Maximum Likelihood failed to converge after 25 iterations', mtInformation, [mbOK], 0); finished := true; end; end; MaxOut(r, C1, i5, s5, P, p2, lReport); TestFit(r, C1, f, S, P, p2, T, lReport); Slopes(rptbis, rbis, slope, N, sumx, sumx2, sumxy, r, xsqr, mean); Analyze(itemfail, grpfail, f, T, grppass, itempass, r, C1, min, max, p2); if PlotItemsChk.Checked then PlotItems(r, i5, P); if PlotScrsChk.Checked then PlotScrs(C1, s5, p2); if TestInfoChk.Checked then PlotInfo(k1, r, info, A, slope, P); FinishIt(r, i5, rptbis, rbis, slope, mean, itemfail, P, lReport); DisplayReport(lReport); finally // cleanup lReport.Free; A := nil; info := nil; D := nil; p1 := nil; f := nil; grppass := nil; grpfail := nil; itempass := nil; itemfail := nil; i5 := nil; s5 := nil; S := nil; sumxy := nil; xsqr := nil; mean := nil; rowtot := nil; X := nil; d1 := nil; R1 := nil; p2 := nil; P := nil; f2 := nil; g2 := nil; g := nil; L2 := nil; L1 := nil; L := nil; e1 := nil; expdcnt := nil; d2 := nil; e2 := nil; slope := nil; rbis := nil; rptbis := nil; ColNoSelected := nil; end; end; procedure TRaschFrm.InBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < VarList.Items.Count do begin if VarList.Selected[i] then begin ItemList.Items.Add(VarList.Items[i]); VarList.Items.Delete(i); i := 0; end else i := i + 1; end; UpdateBtnStates; end; procedure TRaschFrm.OutBtnClick(Sender: TObject); var i: integer; begin i := 0; while i < ItemList.Items.Count do begin if ItemList.Selected[i] then begin VarList.Items.Add(ItemList.Items[i]); ItemList.Items.Delete(i); i := 0; end else i := i + 1; end; UpdateBtnStates; end; procedure TRaschFrm.Analyze(const itemfail, grpfail: IntDyneVec; const f: IntDyneMat; var T: integer; const grppass, itempass: IntDyneVec; r, C1: integer; out min, max: double; const p2: DblDyneVec); var i, j: integer; begin for i := 0 to r-1 do itemfail[i] := 0; for j := 0 to C1-1 do grpfail[j] := 0; for i := 0 to r-1 do begin for j := 0 to C1-1 do begin grpfail[j] := grpfail[j] + f[i,j]; itemfail[i] := itemfail[i] + f[i,j]; end; end; T := 0; for j := 0 to C1-1 do T := T + grpfail[j]; for j := 0 to C1-1 do grppass[j] := T - grpfail[j]; for i := 0 to r-1 do itempass[i] := T - itemfail[i]; min := p2[0]; max := p2[0]; for i := 0 to C1-1 do begin if (p2[i] < min) then min := p2[i]; if (p2[i] > max) then max := p2[i]; end; end; procedure TRaschFrm.Expand(v1, v2: double; out xExpand, yExpand: Double); begin yExpand := sqrt( (1.0 + (v2 / 2.89)) / (1.0 - (v1 * v2 / 8.35)) ); xExpand := sqrt( (1.0 + (v1 / 2.89)) / (1.0 - (v1 * v2 / 8.35)) ); end; procedure TRaschFrm.FinishIt(r: integer; const i5: IntDyneVec; const rptbis, rbis, slope, mean: DblDyneVec; const itemfail: IntDyneVec; const P: DblDyneVec; AReport: TStrings); var i: integer; begin AReport.Add(''); AReport.Add('Item Data Summary'); AReport.Add(''); AReport.Add('ITEM PT.BIS.R. BIS.R. SLOPE PASSED FAILED RASCH DIFF'); AReport.Add('---- --------- ------ ----- ------ ------ ----------'); //xxx xxxxxx xxxxxx xxxxx xxxxxx xxxx xxxxxx for i := 0 to r-1 do AReport.Add('%3d %6.3f %6.3f %5.2f %6.2f %4d %6.3f', [ i5[i], rptbis[i], rbis[i], slope[i], mean[i], itemfail[i], P[i] ]); AReport.Add(''); end; procedure TRaschFrm.Frequencies(C1, r: integer; const f: IntDyneMat; const rowtot, i5, s5: IntDyneVec; T: integer; const S: IntDyneVec; AReport: TStrings); var i, j, c2, c3: integer; done: boolean; outline: string; begin done := false; c3 := C1; c2 := 1; if (c3 > 16) then c3 := 16; while not done do begin AReport.Add('Matrix of Item Failures in Score Groups'); outline := ' Score Group'; for j := c2 to c3 do outline := outline + Format('%4d', [s5[j-1]]); outline := outline + ' Total'; AReport.Add(outline); AReport.Add('ITEM' ); AReport.Add(''); for i := 1 to r do begin outline := Format('%4d ', [i5[i-1]]); for j := c2 to c3 do outline := outline + Format('%4d', [f[i-1, j-1]]); outline := outline + Format('%7d', [rowtot[i-1]]); AReport.Add(outline); end; outline := 'Total '; for j := c2 to c3 do outline := outline + Format('%4d', [S[j-1]]); outline := outline + Format('%7d', [T]); AReport.Add(outline); AReport.Add( ''); if (c3 = C1) then done := true else begin c2 := c3 + 1; c3 := c2 + 15; if (c3 > C1) then c3 := C1; end; end; // end while not done end; // end sub frequencies procedure TRaschFrm.GetLogs(const L, L1,L2, g, g2, f2: DblDyneVec; const rowtot: IntDyneVec; k : integer; const s5, S: IntDyneVec; T, r, C1 : integer; var v1, v2: Double; AReport: TStrings); var tx, rowtx, rx, t2, t3, e : double; i, j : integer; begin t2 := 0.0; tx := T; rx := r; for i := 0 to r-1 do begin rowtx := rowtot[i]; L[i] := ln(rowtx / (tx - rowtx)); t2 := t2 + L[i]; end; t2 := t2 / rx; for i := 0 to r-1 do begin L1[i] := L[i] - t2; L2[i] := L1[i] * L1[i]; v1 := v1 + L2[i]; end; v1 := v1 / rx; AReport.Add('Item Log Odds Deviation Squared Deviation'); AReport.Add('---- -------- --------- -----------------'); //xxxx xxxxxx xxxxxx xxxxxx for i := 0 to r-1 do AReport.Add('%4d %6.2f %6.2f %6.2f', [i+1, L[i], L1[i], L2[i]]); t3 := 0.0; v2 := 0.0; for j := 0 to C1-1 do begin e := s5[j]; g[j] := ln(e / (k - e)); g2[j] := S[j] * g[j]; t3 := t3 + g2[j]; f2[j] := S[j] * (g[j] * g[j]); v2 := v2 + f2[j]; end; t3 := t3 / tx; v2 := v2 / (tx - (t3 * t3)); AReport.Add(''); AReport.Add('Score Frequency Log Odds Freq.x Log Freq.x Log Odds Squared'); AReport.Add('----- --------- -------- ---------- -----------------------'); // xxx xxx xxxxxx xxxxx xxxxxx for j := 0 to C1-1 do AReport.Add(' %3d %3d %6.2f %6.2f %6.2f', [s5[j], S[j], g[j], g2[j], f2[j]]); AReport.Add(''); end; procedure TRaschFrm.GetScores(NoSelected: integer; const Selected: IntDyneVec; NoCases: integer; const f: IntDyneMat; const Mean, XSqr, SumXY: DblDyneVec; const S, X: IntDyneVec; out sumx, sumx2: double; var N: integer; AReport: TStrings); var i, j, k1, T, item: integer; outline: string; begin AReport.Add('RASCH ONE-PARAMETER LOGISTIC TEST SCALING (ITEM RESPONSE THEORY)'); AReport.Add('Written by William G. Miller'); AReport.Add(''); k1 := NoSelected; for i := 1 to k1 do begin for j := 1 to k1 + 2 do f[i-1,j-1] := 0; Mean[i-1] := 0.0; XSqr[i-1] := 0.0; SumXY[i-1] := 0.0; end; for j := 1 to k1 + 2 do S[j-1] := 0; N := 0; SumX := 0.0; SumX2 := 0.0; // Read each case and scores for each item. Eliminate rows (subjects) // that have a total score of zero or all items correct for i := 1 to NoCases do begin if not GoodRecord(i, NoSelected, Selected) then continue; T := 0; for j := 1 to k1 do begin item := Selected[j-1]; X[j-1] := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[item,i]))); T := T + X[j-1]; end; if (T < k1) and (T > 0) then begin outline := format('Case %3d: Total Score: %3d Item scores', [i, T]); SumX := SumX + T; SumX2 := SumX2 + T * T; for j := 0 to k1-1 do begin Mean[j] := Mean[j] + X[j]; XSqr[j] := XSqr[j] + X[j] * X[j]; SumXY[j] := SumXY[j] + X[j] * T; outline := outline + Format('%2d', [X[j]]); if (X[j] = 0) then f[j,T-1] := f[j,T-1] + 1; end; AReport.Add(outline); S[T-1] := S[T-1] + 1; N := N + 1; end else AReport.Add('Case %3d eliminated. Total score was %3d', [i, T]); end; AReport.Add(''); end; procedure TRaschFrm.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); var i, j: integer; d9: double; begin d9 := 0.0; AReport.Add('Maximum Likelihood Iteration Number %d', [noloops]); for j := 0 to C1-1 do begin expdcnt[j] := 0.0; d2[j] := 0.0; end; for i := 0 to r-1 do for j := 0 to C1-1 do p1[i,j] := exp(p2[j] - P[i]) / (1.0 + exp(p2[j] - P[i])); for j := 0 to C1-1 do for i := 0 to r-1 do begin expdcnt[j] := expdcnt[j] + p1[i,j]; // 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; for j := 0 to C1-1 do begin e2[j] := expdcnt[j] - s5[j]; // discrepency e2[j] := e2[j] / d2[j]; if (abs(e2[j]) > d9) then d9 := abs(e2[j]); p2[j] := p2[j] - e2[j]; end; { Debug check in old sample program ' writeln ' writeln('Actual and Estimated Scores') ' writeln ' writeln('Score Estimated Adjustment') ' for j := 1 to c1 do ' writeln(s5(j):3,' ',expdcnt(j):6:2,' ',e2(j):6:2) ' writeln } end; // end of maxability function TRaschFrm.MaxItem(const R1, d1: DblDyneVec; const p1, D: DblDyneMat; const e1, p2, P: DblDyneVec; const S, rowtot: IntDyneVec; T, r, C1: integer): double; var i, j: integer; d9: double; begin d9 := 0.0; for i := 0 to r-1 do begin R1[i] := 0.0; d1[i] := 0.0; end; for i := 0 to r-1 do for j := 0 to C1-1 do p1[i,j] := exp(p2[j] - P[i]) / (1.0 + exp(p2[j] - P[i])); for i := 0 to r-1 do begin for j := 0 to C1-1 do R1[i] := R1[i] + S[j] * p1[i,j]; e1[i] := R1[i] - (T - rowtot[i]); end; // e1(i) contains the difference between actual and expected passes // now calculate derivatives and adjustments for i := 0 to r-1 do begin for j := 0 to C1-1 do begin D[i,j] := exp(p2[j] - P[i]) / (sqrt(1.0 + exp(p2[j] - P[i]))); d1[i] := d1[i] + (S[j] * D[i,j]); end; e1[i] := e1[i] / d1[i]; // adjustment for item difficulty estimates if (abs(e1[i]) > d9) then d9 := abs(e1[i]); P[i] := P[i] + e1[i]; end; { debug check from old sample program ' writeln ' writeln('actual and estimated items right') ' writeln ' writeln('item actual estimated adjustment') ' for i := 1 to r do ' begin ' writeln(i:3,' ',(t-rowtot(i)):3,' ',e1(i):6:2) ' end ' writeln } Result := d9; end; procedure TRaschFrm.MAXOUT(r, C1: integer; const i5, s5: IntDyneVec; const P, p2: DblDyneVec; AReport: TStrings); var i, j: integer; begin AReport.Add(''); AReport.Add('Maximum Likelihood Estimates'); AReport.Add(''); AReport.Add('Item Log Difficulty'); AReport.Add('---- --------------'); //xxx xxxxxx for i := 0 to r-1 do AReport.Add('%3d %6.2f', [i5[i], P[i]]); AReport.Add(''); AReport.Add('Score Log Ability'); AReport.Add('----- -----------'); // xxx xxxxxx for j := 0 to C1-1 do AReport.Add(' %3d %6.2f', [s5[j], p2[j]]); end; procedure TRaschFrm.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); var tx, rowtx, errorterm, stdError: double; i, j: integer; 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; 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('---- ----------- --------------'); //xxx xxxxxxx xxxxxxx tx := T; for i := 0 to r-1 do 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]); end; AReport.Add('Y expansion factor: %8.4f', [yexpand]); AReport.Add(''); AReport.Add('Score Scale Value Standard Error'); AReport.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]); end; AReport.Add('X expansion factor: %8.4f', [xexpand]); AReport.Add(''); end; Function TRaschFrm.Reduce(k: integer; out r, T, C1: Integer; const i5, RowTot, s5: IntDyneVec; const f: IntDyneMat; const S: IntDyneVec; AReport: TStrings): integer; var done: boolean; check, i, j, column, row: integer; begin // NOW REDUCE THE MATRIX BY ELIMINATING 0 OR 1 ROWS AND COLUMNS AReport.Add(''); //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 r := k; T := 0; C1 := k - 1; // No. of score groups (all correct group eliminated) for j := 0 to C1-1 do begin s5[j] := j+1; T := T + S[j]; end; //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 done := false; while not done do begin for i := 1 to r do begin if (rowtot[i-1] = 0) or (rowtot[i-1] = T) then 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 begin for column := 1 to C1 do f[j-1, column-1] := f[j, column-1]; rowtot[j-1] := rowtot[j]; i5[j-1] := i5[j]; end; end; r := r - 1; end; // end if end; // end for i check := 1; for i := 0 to r-1 do if ((rowtot[i] = 0) or (rowtot[i] = T)) then check := 0; if (check = 1) then done := true; end; // check for group elimination done := false; j := 1; while (not done) do begin if (S[j-1] = 0) then begin AReport.Add('Column %3d score group %3d eliminated - total group count = %3d', [j, s5[j-1], S[j-1]]); if (j < C1) then begin for i := j to C1 - 1 do begin for row := 1 to r do f[row-1, i-1] := f[row-1, i]; S[i-1] := S[i]; s5[i-1] := s5[i]; end; C1 := C1 - 1; end else C1 := C1 - 1; end; if C1 = 0 then begin MessageDlg('Too many cases or variables eliminated', mtError, [mbOK], 0); DisplayReport(AReport); AReport.clear; Result := 1; exit; end; if (S[j-1] > 0) then j := j + 1; if (j >= C1) then begin while (S[C1-1] <= 0) do begin C1 := C1 - 1; if C1 = 0 then begin MessageDlg('Too many cases or variables eliminated', mtError, [mbOK], 0); DisplayReport(AReport); AReport.Clear; Result := 1; exit; end; end; done := true; end; end; AReport.Add('Total number of score groups: %4d', [C1]); AReport.Add(''); Result := 0; end; // end of reduce procedure TRaschFrm.Slopes(const rptbis, rbis, slope: DblDyneVec; N: integer; sumx, sumx2: double; const sumxy: DblDyneVec; r: integer; const xsqr, mean: DblDyneVec); var propi, term1, term2, z, Y: double; j: integer; begin z := 0.0; term1 := N * sumx2 - sumx * sumx; for j := 0 to r-1 do begin rptbis[j] := N * sumxy[j] - mean[j] * sumx; term2 := N * xsqr[j] - (mean[j] * mean[j]); if ((term1 > 0) and (term2 > 0)) then rptbis[j] := rptbis[j] / sqrt(term1 * term2) else rptbis[j] := 1.0; propi := mean[j] / N; if ((propi > 0.0) and (propi < 1.0)) then z := inversez(propi); if (propi <= 0.0) then z := -3.0; if (propi >= 1.0) then z := 3.0; Y := ordinate(z); if (Y > 0) then rbis[j] := rptbis[j] * (sqrt(propi * (1.0 - propi)) / Y) else rbis[j] := 1.0; if (rbis[j] <= -1.0) then rbis[j] := -0.99999; if (rbis[j] >= 1.0) then rbis[j] := 0.99999; slope[j] := rbis[j] / sqrt(1.0 - (rbis[j] * rbis[j])); end; end; // end of slopes procedure procedure TRaschFrm.TestFit(r, C1: integer; const f: IntDyneMat; const S: IntDyneVec; const P, P2: DblDyneVec; T: integer; AReport: TStrings); var ct, ch, prob: double; i, j: integer; outline: string; begin AReport.Add(''); AReport.Add('Goodness of Fit Test for Each Item'); AReport.Add(''); AReport.Add('Item Chi-Squared Degrees of Probability'); AReport.Add('No. Value Freedom of Larger Value'); AReport.Add('---- ----------- ---------- ---------------'); //xxxx xxxxxxx xxxx xxxxxx ct := 0.0; for i := 0 to r-1 do begin ch := 0.0; for j := 0 to C1-1 do ch := ch + (exp(p2[j] - P[i]) * f[i,j]) + (exp(P[i] - p2[j]) * (S[j] - f[i,j])); prob := 1.0 - chisquaredprob(ch, T - C1); outline := format('%4d %7.2f %4d %6.4f', [i+1,ch,(T-C1),prob]); AReport.Add(outline); ct := ct + ch; end; AReport.Add(''); end; procedure TRaschFrm.PlotInfo(k, r : integer; const Info, A: DblDyneMat; const Slope, P: DblDyneVec); var min, max, cg, hincrement, Ymax, elg, term1, term2, jx : double; headstring, valstring : string; i, j, jj, size : integer; TestInfo: DblDyneMat; begin min := -3.5; max := 3.5; size := 0; hincrement := (max - min) / 50; SetLength(TestInfo, 52,2); cg := 0.2; Ymax := 0; for i := 1 to r do // item loop begin TestInfo[i-1,0] := 0.0; TestInfo[i-1,1] := 0.0; jj := 1; jx := min; while (jx <= (max + hincrement)) do begin if (slope[i-1] > 30) then slope[i-1] := 30; elg := 1.7 * slope[i-1] * (P[i-1] - jx); elg := exp(elg); term1 := 2.89 * (slope[i-1]) * (1.0 - cg) * (slope[i-1]) * (1.0 - cg); term2 := (cg + elg) * (1.0 + 1.0 / elg) * (1.0 + 1.0 / elg); info[i-1,jj-1] := term1 / term2; if (info[i-1,jj-1] > Ymax) then Ymax := info[i-1,jj-1]; jj := jj + 1; jx := jx + hincrement; end; size := jj-1; end; for i := 1 to r do //item loop begin headstring := 'Item Information Function for Item '; valstring := format('%3d',[i]); headstring := headstring + valstring; for j := 1 to size do begin A[j-1,0] := min + (hincrement * j ); A[j-1,1] := info[i-1,j-1]; TestInfo[j-1,1] := TestInfo[j-1,1] + info[i-1,j-1]; end; if ItemInfoChk.Checked then plot(A, size, headstring, 50, 50); end; for j := 1 to size do TestInfo[j-1,0] := min + (hincrement * j ); headstring := 'Item Information Function for Test'; PlotTest(TestInfo,size,headstring,50,50); TestInfo := nil; end; //end of PlotInfo procedure TRaschFrm.Plot(const xyArray: DblDyneMat; Arraysize: integer; const Title: string; Vdivisions, Hdivisions: integer); var i : integer; //xvalue, yvalue : DblDyneVec; begin // Allocate space for point sets of means //SetLength(xvalue,arraysize); //SetLength(yvalue,arraysize); SetLength(GraphFrm.Ypoints, 1, ArraySize); SetLength(GraphFrm.Xpoints, 1, ArraySize); // store points for means for i := 0 to ArraySize-1 do begin GraphFrm.XPoints[0, i] := xyArray[i, 0]; GraphFrm.YPoints[0, i] := xyArray[i, 1]; { yvalue[i] := xyarray[i,1]; xvalue[i] := xyarray[i,0]; GraphFrm.Ypoints[0,i] := yvalue[i]; GraphFrm.Xpoints[0,i] := xvalue[i]; } end; GraphFrm.nosets := 1; GraphFrm.nbars := arraysize; GraphFrm.Heading := Title; GraphFrm.XTitle := 'log ability'; GraphFrm.YTitle := 'Info'; // GraphFrm.Ypoints[1] := yvalue; // GraphFrm.Xpoints[1] := xvalue; GraphFrm.barwideprop := 0.5; GraphFrm.AutoScaled := true; GraphFrm.GraphType := 5; // 2d line chart GraphFrm.BackColor := GRAPH_BACK_COLOR; GraphFrm.WallColor := GRAPH_WALL_COLOR; GraphFrm.FloorColor := GRAPH_FLOOR_COLOR; GraphFrm.ShowBackWall := true; GraphFrm.ShowModal; // xvalue := nil; // yvalue := nil; GraphFrm.Xpoints := nil; GraphFrm.Ypoints := nil; end; //end plot subroutine procedure TRaschFrm.PlotItems(r: integer; const i5: IntDyneVec; const P: DblDyneVec); var i : integer; // xvalues : DblDyneVec; begin // SetLength(xvalues,r); SetLength(GraphFrm.Ypoints,1,r); SetLength(GraphFrm.Xpoints,1,r); for i := 0 to r-1 do begin GraphFrm.XPoints[0, i] := i5[i]; GraphFrm.YPoints[0, i] := P[i]; end; { for i := 1 to r do begin xvalues[i-1] := i5[i-1]; GraphFrm.Xpoints[0,i-1] := xvalues[i-1]; GraphFrm.Ypoints[0,i-1] := P[i-1]; end; } GraphFrm.nosets := 1; GraphFrm.nbars := r; GraphFrm.Heading := 'LOG DIFFICULTIES FOR ITEMS'; GraphFrm.XTitle := 'ITEM'; GraphFrm.YTitle := 'LOG DIFFICULTY'; GraphFrm.barwideprop := 0.5; GraphFrm.AutoScaled := true; GraphFrm.GraphType := 2; // bar chart GraphFrm.BackColor := GRAPH_BACK_COLOR; GraphFrm.WallColor := GRAPH_WALL_COLOR; GraphFrm.FloorColor := GRAPH_FLOOR_COLOR; GraphFrm.ShowBackWall := true; GraphFrm.ShowModal; //xvalues := nil; GraphFrm.Xpoints := nil; GraphFrm.Ypoints := nil; end; procedure TRaschFrm.PlotScrs(C1: integer; const s5: IntDyneVec; const p2: DblDyneVec); var i: integer; //xvalues: DblDyneVec; begin //SetLength(xvalues,C1); SetLength(GraphFrm.Ypoints,1,C1); SetLength(GraphFrm.Xpoints,1,C1); for i := 0 to C1-1 do begin GraphFrm.XPoints[0, i] := s5[i]; GraphFrm.YPoints[0, i] := p2[i]; end; { for i := 1 to C1 do begin xvalues[i-1] := s5[i-1]; GraphFrm.Xpoints[0,i-1] := xvalues[i-1]; GraphFrm.Ypoints[0,i-1] := p2[i-1]; end; } GraphFrm.nosets := 1; GraphFrm.nbars := C1; GraphFrm.Heading := 'LOG ABILITIES FOR SCORE GROUPS'; GraphFrm.XTitle := 'SCORE'; GraphFrm.YTitle := 'LOG ABILITY'; // GraphFrm.Ypoints[1] := p2; // GraphFrm.Xpoints[1] := xvalues; GraphFrm.barwideprop := 0.5; GraphFrm.AutoScaled := true; GraphFrm.GraphType := 2; // bar chart GraphFrm.BackColor := GRAPH_BACK_COLOR; GraphFrm.WallColor := GRAPH_WALL_COLOR; GraphFrm.FloorColor := GRAPH_FLOOR_COLOR; GraphFrm.ShowBackWall := true; GraphFrm.ShowModal; //xvalues := nil; GraphFrm.Xpoints := nil; GraphFrm.Ypoints := nil; end; procedure TRaschFrm.PlotTest(const TestInfo: DblDyneMat; ArraySize: integer; const Title: string; Vdivisions, Hdivisions: integer); var i: integer; // xvalue, yvalue: DblDyneVec; begin // Allocate space for point sets of means //SetLength(xvalue,arraysize); //SetLength(yvalue,arraysize); SetLength(GraphFrm.Ypoints, 1, Arraysize); SetLength(GraphFrm.Xpoints, 1, Arraysize); // store points for means for i := 0 to ArraySize-1 do begin GraphFrm.XPoints[0, i] := TestInfo[i, 0]; GraphFrm.YPoints[0, i] := TestInfo[i, 1]; end; { for i := 1 to arraysize do begin yvalue[i-1] := TestInfo[i-1,1]; xvalue[i-1] := TestInfo[i-1,0]; GraphFrm.Ypoints[0,i-1] := yvalue[i-1]; GraphFrm.Xpoints[0,i-1] := xvalue[i-1]; end; } GraphFrm.nosets := 1; GraphFrm.nbars := arraysize; GraphFrm.Heading := Title; GraphFrm.XTitle := 'log ability'; GraphFrm.YTitle := 'Info'; GraphFrm.barwideprop := 0.5; GraphFrm.AutoScaled := true; GraphFrm.GraphType := 5; // 2d line chart GraphFrm.BackColor := GRAPH_BACK_COLOR; GraphFrm.WallColor := GRAPH_WALL_COLOR; GraphFrm.FloorColor := GRAPH_FLOOR_COLOR; GraphFrm.ShowBackWall := true; GraphFrm.ShowModal; //xvalue := nil; //yvalue := nil; GraphFrm.Xpoints := nil; GraphFrm.Ypoints := nil; end; //end plot subroutine procedure TRaschFrm.UpdateBtnStates; begin InBtn.Enabled := AnySelected(VarList); OutBtn.Enabled := AnySelected(ItemList); end; procedure TRaschFrm.VarListSelectionChange(Sender: TObject; User: boolean); begin UpdateBtnStates; end; initialization {$I raschunit.lrs} end.