unit RaschUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib,
  GraphLib, Globals, MatrixLib, DataProcs, Math, contexthelpunit;

type

  { TRaschFrm }

  TRaschFrm = class(TForm)
    HelpBtn: TButton;
    ResetBtn: TButton;
    CancelBtn: TButton;
    ComputeBtn: TButton;
    ReturnBtn: 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 FormShow(Sender: TObject);
    procedure HelpBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
  private
    { private declarations }
    procedure ANALYZE(VAR itemfail : IntDyneVec;
                  VAR grpfail : IntDyneVec;
                  VAR f : IntDyneMat;
                  VAR T : integer;
                  VAR grppass : IntDyneVec;
                  VAR itempass : IntDyneVec;
                  r, C1 : integer;
                  VAR min : double;
                  VAR max : double;
                  VAR p2 : DblDyneVec);
    procedure EXPAND(v1, v2 : double;
               VAR xexpand : double;
               VAR yexpand : double);
    procedure FinishIt(r : integer;
                    VAR i5 : IntDyneVec;
                    VAR rptbis : DblDyneVec;
                    VAR rbis : DblDyneVec;
                    VAR slope : DblDyneVec;
                    VAR mean : DblDyneVec;
                    VAR itemfail : IntDyneVec;
                    VAR P : DblDyneVec );
    procedure FREQUENCIES(C1, r : integer;
                      VAR f : IntDyneMat;
                      VAR rowtot : IntDyneVec;
                      VAR i5 : IntDyneVec;
                      VAR s5 : IntDyneVec;
                      T : integer;
                      VAR S : IntDyneVec);
    procedure GETLOGS(VAR L : DblDyneVec;
                            VAR L1 : DblDyneVec;
                            VAR L2 : DblDyneVec;
                            VAR g : DblDyneVec;
                            VAR g2 : DblDyneVec;
                            VAR f2 : DblDyneVec;
                            VAR rowtot : IntDyneVec;
                            k : integer;
                            VAR s5 : IntDyneVec;
                            VAR S : IntDyneVec;
                            T, r, C1 : integer;
                            VAR v1 : double;
                            VAR v2 : double);
    procedure GETSCORES(VAR noselected : integer;
                              VAR selected : IntDyneVec;
                              NoCases : integer;
                              f : IntDyneMat;
                              VAR mean : DblDyneVec;
                              VAR xsqr : DblDyneVec;
                              VAR sumxy : DblDyneVec;
                              VAR S : IntDyneVec;
                              VAR X : IntDyneVec;
                              VAR sumx : double;
                              VAR sumx2 : double;
                              VAR N : integer);
    procedure MAXABILITY(VAR expdcnt : DblDyneVec;
                               VAR d2 : DblDyneVec;
                               VAR e2 : DblDyneVec;
                               VAR p1 : DblDyneMat;
                               VAR p2 : DblDyneVec;
                               VAR P : DblDyneVec;
                               C1, r : integer;
                               D : DblDyneMat;
                               VAR s5 : IntDyneVec;
                               noloops : integer);
    function MAXITEM(VAR R1 : DblDyneVec;
                           VAR d1 : DblDyneVec;
                           VAR p1 : DblDyneMat;
                           VAR D : DblDyneMat;
                           VAR e1 : DblDyneVec;
                           VAR p2 : DblDyneVec;
                           VAR P : DblDyneVec;
                           VAR S : IntDyneVec;
                           VAR rowtot : IntDyneVec;
                           T, r, C1 : integer) : double;
    procedure MAXOUT(r, C1 : integer;
                           VAR i5 : IntDyneVec;
                           VAR s5 : IntDyneVec;
                           VAR P : DblDyneVec;
                           VAR p2 : DblDyneVec);
    procedure PROX(VAR P : DblDyneVec;
                         VAR p2 : DblDyneVec;
                         k, r, C1 : integer;
                         VAR L1 : DblDyneVec;
                         yexpand, xexpand : double;
                         VAR g : DblDyneVec;
                         T : integer;
                         VAR rowtot : IntDyneVec;
                         VAR i5 : IntDyneVec;
                         VAR s5 : IntDyneVec);
    Function REDUCE(k : integer;
                           VAR r : integer;
                           VAR T : integer;
                           VAR C1 : integer;
                           VAR i5 : IntDyneVec;
                           VAR rowtot : IntDyneVec;
                           VAR s5 : IntDyneVec;
                           VAR f : IntDyneMat;
                           VAR S : IntDyneVec) : integer;
    procedure SLOPES(VAR rptbis : DblDyneVec;
                           VAR rbis : DblDyneVec;
                           VAR slope : DblDyneVec;
                           N : integer;
                           sumx, sumx2 : double;
                           VAR sumxy : DblDyneVec;
                           r : integer;
                           VAR xsqr : DblDyneVec;
                           VAR mean : DblDyneVec);
    procedure TESTFIT(r, C1 : integer;
                            VAR f : IntDyneMat;
                            VAR S : IntDyneVec;
                            VAR P : DblDyneVec;
                            VAR p2 : DblDyneVec;
                            T : integer);
    procedure PLOTINFO(k, r : integer;
                             VAR info : DblDyneMat;
                             VAR A : DblDyneMat;
                             VAR slope : DblDyneVec;
                             VAR P : DblDyneVec);
    procedure plot(VAR xyarray : DblDyneMat;
                         arraysize : integer;
                         Title : string;
                         Vdivisions, Hdivisions : integer);
    procedure PlotItems(r : integer; i5 : IntDyneVec; P : DblDyneVec);
    procedure PlotScrs(C1 : integer; s5 : IntDyneVec; p2 : DblDyneVec);
    procedure PlotTest(VAR TestInfo : DblDyneMat;
                         arraysize : integer;
                         Title : string;
                         Vdivisions, Hdivisions : integer);
  public
    { public declarations }
  end; 

var
  RaschFrm: TRaschFrm;

implementation

{ TRaschFrm }

procedure TRaschFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
     VarList.Clear;
     ItemList.Clear;
     OutBtn.Visible := false;
     InBtn.Visible := true;
     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]);
end;

procedure TRaschFrm.FormShow(Sender: TObject);
begin
     ResetBtnClick(self);
end;

procedure TRaschFrm.HelpBtnClick(Sender: TObject);
begin
  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;
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
    	  ShowMessage('ERROR! You must have data in your data grid!');
          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;

     GETSCORES(NoSelected, ColNoSelected, NoCases, f, mean, xsqr, sumxy, S, X,
                sumx, sumx2, N);
     error := REDUCE(k1, r, T, C1, i5, rowtot, s5, f, S);
     if error = 1 then exit;
     FREQUENCIES(C1, r, f, rowtot, i5, s5, T, S );
     v1 := 0.0;
     v2 := 0.0;
     GETLOGS(L, L1, L2, g, g2, f2, rowtot, k1, s5, S, T, r, C1, v1, v2);
     EXPAND(v1, v2, xexpand, yexpand);
     PROX(P, p2, k1, r, C1, L1, yexpand, xexpand, g, T, rowtot, i5, s5);
     // start iterations for the maximum-liklihood (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);
           noloops := noloops + 1;
           if (noloops > 25) then
           begin
               ShowMessage('WARNING! Maximum Liklihood failed to converge after 25 iterations');
            	finished := true;
           end;
      end;
      MAXOUT(r, C1, i5, s5, P, p2);
      TESTFIT(r, C1, f, S, P, p2, T);
      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);
      PLOTINFO(k1, r, info, A, slope, P);
      FinishIt(r, i5, rptbis, rbis, slope, mean, itemfail, P);

      // cleanup
      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;

procedure TRaschFrm.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 TRaschFrm.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;

procedure TRaschFrm.ANALYZE(VAR itemfail : IntDyneVec;
                  VAR grpfail : IntDyneVec;
                  VAR f : IntDyneMat;
                  VAR T : integer;
                  VAR grppass : IntDyneVec;
                  VAR itempass : IntDyneVec;
                  r, C1 : integer;
                  VAR min : double;
                  VAR max : double;
                  VAR 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;  // End Sub 'end analyze procedure

procedure TRaschFrm.EXPAND(v1, v2 : double;
               VAR xexpand : double;
               VAR 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; //End Sub 'end of expand

procedure TRaschFrm.FinishIt(r : integer;
                    VAR i5 : IntDyneVec;
                    VAR rptbis : DblDyneVec;
                    VAR rbis : DblDyneVec;
                    VAR slope : DblDyneVec;
                    VAR mean : DblDyneVec;
                    VAR itemfail : IntDyneVec;
                    VAR P : DblDyneVec );
var
   i : integer;
   outline : string;
begin
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add('Item Data Summary');
     OutPutFrm.RichEdit.Lines.Add( 'ITEM  PT.BIS.R.  BIS.R.  SLOPE   PASSED  FAILED  RASCH DIFF');
     for i := 0 to r-1 do
     begin
        outline := format('%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]]);
        OutPutFrm.RichEdit.Lines.Add(outline);
     end;
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.ShowModal;
end; // end FinishIt procedure

procedure TRaschFrm.FREQUENCIES(C1, r : integer;
                      VAR f : IntDyneMat;
                      VAR rowtot : IntDyneVec;
                      VAR i5 : IntDyneVec;
                      VAR s5 : IntDyneVec;
                      T : integer;
                      VAR S : IntDyneVec);
var
   i, j, c2, c3 : integer;
   Done : boolean;
   outline, strvalue : string;

begin
     Done := false;
     c3 := C1;
     c2 := 1;
     if (c3 > 16) then c3 := 16;
     while (not Done) do
     begin
      OutPutFrm.RichEdit.Lines.Add('Matrix of Item Failures in Score Groups');
      outline := '   Score Group';
      for j := c2 to c3 do
      begin
        strvalue := format('%4d',[s5[j-1]]);
        outline := outline + strvalue;
      end;
      outline := outline + '     Total';
      OutPutFrm.RichEdit.Lines.Add(outline);
      OutPutFrm.RichEdit.Lines.Add('ITEM' );
      OutPutFrm.RichEdit.Lines.Add('');
      for i := 1 to r do
      begin
      	outline := format('%4d          ',[i5[i-1]]);
        for j := c2 to c3 do
        begin
           strvalue := format('%4d',[f[i-1,j-1]]);
           outline := outline + strvalue;
        end;
        strvalue := format('%7d',[rowtot[i-1]]);
        outline := outline + strvalue;
        OutPutFrm.RichEdit.Lines.Add(outline);
      end;
      outline := 'Total         ';
      for j := c2 to c3 do
      begin
       	  strvalue := format('%4d',[S[j-1]]);
          outline := outline + strvalue;
      end;
      strvalue := format('%7d',[T]);
      outline := outline + strvalue;
      OutPutFrm.RichEdit.Lines.Add(outline);
      OutPutFrm.RichEdit.Lines.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(VAR L : DblDyneVec;
                            VAR L1 : DblDyneVec;
                            VAR L2 : DblDyneVec;
                            VAR g : DblDyneVec;
                            VAR g2 : DblDyneVec;
                            VAR f2 : DblDyneVec;
                            VAR rowtot : IntDyneVec;
                            k : integer;
                            VAR s5 : IntDyneVec;
                            VAR S : IntDyneVec;
                            T, r, C1 : integer;
                            VAR v1 : double;
                            VAR v2 : double);
var
   tx, rowtx, rx, t2, t3, e : double;
   i, j : integer;
   outline : string;

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;
     OutPutFrm.RichEdit.Lines.Add( 'Item Log Odds Deviation Squared Deviation');
     for i := 0 to r-1 do
     begin
          outline := format('%3d  %6.2f   %6.2f     %6.2f',
                     [i+1,L[i],L1[i],L2[i]]);
          OutPutFrm.RichEdit.Lines.Add(outline);
     end;
     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));
     OutPutFrm.RichEdit.Lines.Add('Score Frequency Log Odds Freq.x Log  Freq.x Log Odds Squared');
     for j := 0 to C1-1 do
     begin
        outline := format('%3d   %3d      %6.2f      %6.2f     %6.2f',
                [s5[j],S[j],g[j],g2[j],f2[j]]);
        OutPutFrm.RichEdit.Lines.Add(outline);
     end;
end; //end of  getlogs

procedure TRaschFrm.GETSCORES(VAR noselected : integer;
                              VAR selected : IntDyneVec;
                              NoCases : integer;
                              f : IntDyneMat;
                              VAR mean : DblDyneVec;
                              VAR xsqr : DblDyneVec;
                              VAR sumxy : DblDyneVec;
                              VAR S : IntDyneVec;
                              VAR X : IntDyneVec;
                              VAR sumx : double;
                              VAR sumx2 : double;
                              VAR N : integer);
var
   i, j, k1, T, item : integer;
   outline, strvalue : string;
begin
     OutPutFrm.RichEdit.Clear;
     OutPutFrm.RichEdit.Lines.Add('Rasch One-Parameter Logistic Test Scaling (Item Response Theory)');
     OutPutFrm.RichEdit.Lines.Add('Written by William G. Miller');
     OutPutFrm.RichEdit.Lines.Add('');
     k1 := noselected;
     for i := 1 to k1 do
     begin
          for j := 1 to k1 + 2 do
          begin
             f[i-1,j-1] := 0;
          end;
          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);
                strvalue := format('%2d',[X[j]]);
                outline := outline + strvalue;
                if (X[j] = 0) then f[j,T-1] := f[j,T-1] + 1;
            end;
            OutPutFrm.RichEdit.Lines.Add(outline);
            S[T-1] := S[T-1] + 1;
            N := N + 1;
          end
          else begin
               outline := format('case %3d eliminated.  Total score was %3d',
                       [i, T]);
               OutPutFrm.RichEdit.Lines.Add(outline);
          end;
     end;
     OutPutFrm.RichEdit.Lines.Add('');
end; //end sub getscores

procedure TRaschFrm.MAXABILITY(VAR expdcnt : DblDyneVec;
                               VAR d2 : DblDyneVec;
                               VAR e2 : DblDyneVec;
                               VAR p1 : DblDyneMat;
                               VAR p2 : DblDyneVec;
                               VAR P : DblDyneVec;
                               C1, r : integer;
                               D : DblDyneMat;
                               VAR s5 : IntDyneVec;
                               noloops : integer);
var
   i, j : integer;
   d9 : double;
   outline : string;

begin
     d9 := 0.0;
     outline := format('Maximum Likelihood Iteration Number %2d',[noloops]);
     OutPutFrm.RichEdit.Lines.Add(outline);
     for j := 0 to C1-1 do
     begin
          expdcnt[j] := 0.0;
          d2[j] := 0.0;
     end;
     for i := 0 to r-1 do
     begin
          for j := 0 to C1-1 do
             p1[i,j] := exp(p2[j] - P[i]) / (1.0 + exp(p2[j] - P[i]));
     end;
     for j := 0 to C1-1 do
     begin
          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;
     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(VAR R1 : DblDyneVec;
                           VAR d1 : DblDyneVec;
                           VAR p1 : DblDyneMat;
                           VAR D : DblDyneMat;
                           VAR e1 : DblDyneVec;
                           VAR p2 : DblDyneVec;
                           VAR P : DblDyneVec;
                           VAR S : IntDyneVec;
                           VAR 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; // end of maxitem subroutine

procedure TRaschFrm.MAXOUT(r, C1 : integer;
                           VAR i5 : IntDyneVec;
                           VAR s5 : IntDyneVec;
                           VAR P : DblDyneVec;
                           VAR p2 : DblDyneVec);
var
   i, j : integer;
   outline : string;

begin
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add('Maximum Likelihood Estimates');
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add('Item  Log Difficulty');
     for i := 0 to r-1 do
     begin
         outline := format('%3d     %6.2f',[i5[i],P[i]]);
         OutPutFrm.RichEdit.Lines.Add(outline);
     end;
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add('Score   Log Ability');
     for j := 0 to C1-1 do
     begin
         outline := format('%3d    %6.2f',[s5[j],p2[j]]);
         OutPutFrm.RichEdit.Lines.Add(outline);
     end;
end; // end  of maxout

procedure TRaschFrm.PROX(VAR P : DblDyneVec;
                         VAR p2 : DblDyneVec;
                         k, r, C1 : integer;
                         VAR L1 : DblDyneVec;
                         yexpand, xexpand : double;
                         VAR g : DblDyneVec;
                         T : integer;
                         VAR rowtot : IntDyneVec;
                         VAR i5 : IntDyneVec;
                         VAR s5 : IntDyneVec);
var
   tx, rowtx, errorterm, stderror : double;
   i, j : integer;
   outline : string;
begin
     if ProxChk.Checked then OutPutFrm.RichEdit.Lines.Add('');
     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 ProxChk.Checked then
     begin
          OutPutFrm.RichEdit.Lines.Add( 'Prox values and Standard Errors' );
          OutPutFrm.RichEdit.Lines.Add(' ');
          OutPutFrm.RichEdit.Lines.Add('Item     Scale Value     Standard Error');
     end;
     tx := T;
     for i := 0 to r-1 do
     begin
         rowtx := rowtot[i];
         errorterm := tx / ((tx - rowtx) * rowtx);
         //writeln(lst,'row := ',i:2,' yexpand := ',yexpand:8:2,
         //      total := ',t:8,' row total := ',rowtot(i):8,
         //      error term := ',errorterm:8:2)  end;
         stderror := yexpand * sqrt(errorterm);
         if ProxChk.Checked then
         begin
              outline := format('%3d    %7.3f          %7.3f',[i5[i],P[i],stderror]);
              OutPutFrm.RichEdit.Lines.Add(outline);
         end;
     end;
     if ProxChk.Checked then
     begin
          outline := format('Y expansion factor := %8.4f',[yexpand]);
          OutPutFrm.RichEdit.Lines.Add(outline);
          OutPutFrm.RichEdit.Lines.Add('');
          OutPutFrm.RichEdit.Lines.Add('Score    Scale Value     Standard Error');
     end;
     for j := 0 to C1-1 do
     begin
          stderror := xexpand * sqrt(k / (s5[j] * (k - s5[j])));
          if ProxChk.Checked then
          begin
               outline := format('%3d    %7.3f         %7.3f',[s5[j],p2[j],stderror]);
               OutPutFrm.RichEdit.Lines.Add(outline);
          end;
     end;
     if ProxChk.Checked then
     begin
          outline := format('X expansion factor = %8.4f',[xexpand]);
          OutPutFrm.RichEdit.Lines.Add(outline);
     end;
end; //end of prox

Function TRaschFrm.REDUCE(k : integer;
                           VAR r : integer;
                           VAR T : integer;
                           VAR C1 : integer;
                           VAR i5 : IntDyneVec;
                           VAR rowtot : IntDyneVec;
                           VAR s5 : IntDyneVec;
                           VAR f : IntDyneMat;
                           VAR S : IntDyneVec) : integer;
var
   Done : boolean;
   check, i, j, column, row : integer;
   outline : string;
begin // NOW REDUCE THE MATRIX BY ELIMINATING 0 OR 1 ROWS AND COLUMNS
    OutPutFrm.RichEdit.Lines.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
               outline := format('Row %3d for item %3d eliminated.',[i,i5[i-1]]);
               OutPutFrm.RichEdit.Lines.Add(outline);
               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
               outline := format('Column %3d score group %3d eliminated - total group count = %3d',
                       [j, s5[j-1], S[j-1]]);
               OutPutFrm.RichEdit.Lines.Add(outline);
               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
               ShowMessage('Too many cases or variables eliminated');
               OutPutFrm.ShowModal;
               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
                         ShowMessage('Too many cases or variables eliminated');
                         OutPutFrm.ShowModal;
                         Result := 1;
                         exit;
                    end;
                end;
               Done := true;
          end;
     end;
     outline := format('Total number of score groups := %4d',[C1]);
     OutPutFrm.RichEdit.Lines.Add(outline);
     OutPutFrm.RichEdit.Lines.Add('');
     Result := 0;
end; // end of reduce

procedure TRaschFrm.SLOPES(VAR rptbis : DblDyneVec;
                           VAR rbis : DblDyneVec;
                           VAR slope : DblDyneVec;
                           N : integer;
                           sumx, sumx2 : double;
                           VAR sumxy : DblDyneVec;
                           r : integer;
                           VAR xsqr : DblDyneVec;
                           VAR 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;
                            VAR f : IntDyneMat;
                            VAR S : IntDyneVec;
                            VAR P : DblDyneVec;
                            VAR p2 : DblDyneVec;
                            T : integer);
var
   ct, ch, prob : double;
    i, j : integer;
    outline : string;
begin
     OutPutFrm.RichEdit.Lines.Add('');
     OutPutFrm.RichEdit.Lines.Add( 'Goodness of Fit Test for Each Item');
     OutPutFrm.RichEdit.Lines.Add('Item  Chi-Squared  Degrees of  Probability');
     OutPutFrm.RichEdit.Lines.Add('No.   Value        Freedom     of Larger Value');
     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('%3d   %8.2f     %3d          %6.4f',[i+1,ch,(T-C1),prob]);
          OutPutFrm.RichEdit.Lines.Add(outline);
          ct := ct + ch;
     end;
     OutPutFrm.RichEdit.Lines.Add('');
end; // end of testfit

procedure TRaschFrm.PLOTINFO(k, r : integer;
                             VAR info : DblDyneMat;
                             VAR A : DblDyneMat;
                             VAR slope : DblDyneVec;
                             VAR 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';
     if TestInfoChk.Checked then PlotTest(TestInfo,size,headstring,50,50);
     TestInfo := nil;
end; //end of PlotInfo

procedure TRaschFrm.plot(VAR xyarray : DblDyneMat;
                         arraysize : integer;
                         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
         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.AutoScale := true;
    GraphFrm.GraphType := 5; // 2d line chart
    GraphFrm.BackColor := clYellow;
    GraphFrm.WallColor := clBlack;
    GraphFrm.FloorColor := clLtGray;
    GraphFrm.ShowBackWall := true;
    GraphFrm.ShowModal;

    xvalue := nil;
    yvalue := nil;
    GraphFrm.Xpoints := nil;
    GraphFrm.Ypoints := nil;
end;  //end plot subroutine

procedure TRaschFrm.PlotItems(r : integer; i5 : IntDyneVec; P : DblDyneVec);
var
   i : integer;
   xvalues : DblDyneVec;
begin
    SetLength(xvalues,r);
    SetLength(GraphFrm.Ypoints,1,r);
    SetLength(GraphFrm.Xpoints,1,r);
    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.Ypoints[1] := P;
//    GraphFrm.Xpoints[1] := xvalues;
    GraphFrm.barwideprop := 0.5;
    GraphFrm.AutoScale := true;
    GraphFrm.GraphType := 2; // bar chart
    GraphFrm.BackColor := clYellow;
    GraphFrm.WallColor := clBlack;
    GraphFrm.FloorColor := clLtGray;
    GraphFrm.ShowBackWall := true;
    GraphFrm.ShowModal;
    xvalues := nil;
    GraphFrm.Xpoints := nil;
    GraphFrm.Ypoints := nil;
end;

procedure TRaschFrm.PlotScrs(C1 : integer; s5 : IntDyneVec; p2 : DblDyneVec);
var
   i : integer;
   xvalues : DblDyneVec;
begin
    SetLength(xvalues,C1);
    SetLength(GraphFrm.Ypoints,1,C1);
    SetLength(GraphFrm.Xpoints,1,C1);
    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.AutoScale := true;
    GraphFrm.GraphType := 2; // bar chart
    GraphFrm.BackColor := clYellow;
    GraphFrm.WallColor := clBlack;
    GraphFrm.FloorColor := clLtGray;
    GraphFrm.ShowBackWall := true;
    GraphFrm.ShowModal;
    xvalues := nil;
    GraphFrm.Xpoints := nil;
    GraphFrm.Ypoints := nil;
end;

procedure TRaschFrm.PlotTest(VAR TestInfo : DblDyneMat;
                         arraysize : integer;
                         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 := 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.Ypoints[1] := yvalue;
//    GraphFrm.Xpoints[1] := xvalue;
    GraphFrm.barwideprop := 0.5;
    GraphFrm.AutoScale := true;
    GraphFrm.GraphType := 5; // 2d line chart
    GraphFrm.BackColor := clYellow;
    GraphFrm.WallColor := clBlack;
    GraphFrm.FloorColor := clLtGray;
    GraphFrm.ShowBackWall := true;
    GraphFrm.ShowModal;

    xvalue := nil;
    yvalue := nil;
    GraphFrm.Xpoints := nil;
    GraphFrm.Ypoints := nil;
end;  //end plot subroutine


initialization
  {$I raschunit.lrs}

end.