lazarus-ccr/applications/lazstats/source/forms/analysis/measurement_programs/guttmanunit.pas

unit GuttmanUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Buttons, ExtCtrls,
  ComCtrls, MainUnit, Globals, ReportFrameUnit, BasicStatsReportFormUnit;

type

  { TGuttmanForm }

  TGuttmanForm = class(TBasicStatsReportForm)
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    Label1: TLabel;
    Label2: TLabel;
    ItemList: TListBox;
    PageControl: TPageControl;
    CornellPage: TTabSheet;
    GoodenoughPage: TTabSheet;
    VarList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure ItemListDblClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure VarListDblClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);

  private
    FCornellReportFrame: TReportFrame;
    FGoodenoughReportFrame: TReportFrame;
	
  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;
    function Validate(out AMsg: String; out AControl: TWinControl): boolean; override;
		
  public
    constructor Create(AOwner: TComponent); override;
    procedure Reset; override;
  end; 

var
  GuttmanForm: TGuttmanForm;


implementation

{$R *.lfm}

uses
  Utils, MatrixUnit, GridProcs;


{ TGuttmanForm }

constructor TGuttmanForm.Create(AOwner: TComponent);
begin
  inherited;

  FCornellReportFrame := FReportFrame;
  InitToolbar(FReportFrame.ReportToolbar, tpTop);
  FReportFrame.ClearBorderSpacings;
  FReportFrame.Parent := CornellPage;

  FGoodenoughReportFrame := TReportFrame.Create(self);
  FGoodenoughReportFrame.Parent := GoodenoughPage;
  FGoodenoughReportFrame.Align := alClient;

  PageControl.ActivePageIndex := 0;
end;


procedure TGuttmanForm.AdjustConstraints;
begin
  inherited;

  ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
  ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height +
    ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;


procedure TGuttmanForm.AllBtnClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to VarList.Items.Count - 1 do
    ItemList.Items.Add(VarList.Items[i-1]);
  VarList.Clear;
  UpdateBtnStates;
end;


procedure TGuttmanForm.Compute;
var
  i, j, k, X, e0, e1, e2, e3, first, last, errors : integer;
  totalerrors, rowno : integer;
  FreqMat0 : IntDyneMat = nil; // Pointer to array of 0 responses for each item by score group
  FreqMat1 : IntDyneMat = nil; // Pointer to array of 1 responses for each item by score group
  RowTots : IntDyneVec= nil; // Pointer to vector of total score frequencies for items
  ColTots : IntDyneMat = nil; // Pointer to array of 0 and 1 column totals
  ColProps : DblDyneVec = nil; // Pointer to array of proportions correct in columns
  ColNoSelected : IntDyneVec = nil; // Pointer to vector of item Grid columns
  CaseVector : IntDyneVec = nil; // Pointer to vector of subject's item responses
  TotalScore : integer; // Total score of a subject
  temp : integer; // temporary variable used in sorting
  CutScore : IntDyneVec = nil; // Optimal cut scores for each item
  ErrorMat : IntDyneMat = nil; // matrix of errors above and below cut scores
  sequence : IntDyneVec = nil; // original and sorted sequence no. of items
  CaseNo : IntDyneVec = nil; // ID number for each case
  ModalArray : IntDyneMat = nil; // Array of modal item responses
  NoSelected : integer;
  VarLabels : StrDyneVec = nil; // variable labels
  outline, astring : string;
  done : boolean;
  CoefRepro : double;
  Min_Coeff : double;
  lReport: TStrings;
begin
  // Allocate heap space for arrays
  SetLength(FreqMat0,NoCases,NoVariables);
  SetLength(FreqMat1,NoCases,NoVariables);
  SetLength(RowTots,NoCases);
  SetLength(ColTots,NoVariables,2);
  SetLength(ColProps,NoVariables);
  SetLength(CaseVector,NoCases);
  SetLength(CutScore,NoCases);
  SetLength(ErrorMat,NoVariables,2);
  SetLength(sequence,NoVariables);
  SetLength(CaseNo,NoCases);
  SetLength(ModalArray, NoVariables+1, NoVariables+1);

   // Get variables used for the analysis
   NoSelected := ItemList.Items.Count;
   SetLength(VarLabels, NoSelected);
   SetLength(ColNoSelected, NoSelected);
   for j := 0 to NoSelected-1 do
   begin
     VarLabels[j] := ItemList.Items[j];
     ColNoSelected[j] := GetVariableIndex(OS3MainFrm.DataGrid, VarLabels[j]);
   end;

  // Initialize sequence
  for i := 0 to NoSelected-1 do sequence[i] := i+1;

  // Initialize arrays
  for i := 0 to NoCases-1 do
    CaseNo[i] := i+1;

  // Get data into the frequency matrices of 0 and 1 responses
  for i := 1 to NoCases do
  begin
    if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
    TotalScore := 0;
    for j := 0 to NoSelected-1 do
    begin
      X := round(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[j], i])));
      CaseVector[j] := X;
      TotalScore := TotalScore + X;
    end;
    for j := 0 to NoSelected-1 do
      if (CaseVector[j] = 0) then
        FreqMat0[i-1, j] := 1
      else
        FreqMat1[i-1, j] := 1;
  end;

  // Get Row Totals for each score group (rows of FreqMat1)
  for i := 1 to NoCases do
  begin
    if (not GoodRecord(oS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
    for j := 0 to NoSelected-1 do
      RowTots[i-1] := RowTots[i-1] + FreqMat1[i-1, j];
  end;

  // Get Column Totals for item scores of 1 and 0
  for i := 0 to NoSelected-1 do //columns
  begin
    for j := 0 to NoCases-1 do // rows
    begin
      if (not GoodRecord(OS3MainFrm.DataGrid, j+1, ColNoSelected)) then continue;
      ColTots[i, 0] := ColTots[i, 0] + FreqMat0[j, i];
      ColTots[i, 1] := ColTots[i, 1] + FreqMat1[j, i];
    end;
  end;

  //Sort frequency matrices into descending order
  for i := 1 to NoCases - 1 do
  begin
    if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
    for j := i + 1 to NoCases do
    begin
      if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
      if (RowTots[i-1] < RowTots[j-1]) then //swap
      begin
        for k := 1 to NoSelected do
        begin // carry all columns in the swap
          Exchange(FreqMat0[i-1, k-1], FreqMat0[j-1, k-1]);
          Exchange(FreqMat1[i-1, k-1], FreqMat1[j-1, k-1]);
        end;

        // Also swap row totals
        Exchange(RowTots[i-1], RowTots[j-1]);

        // And case number
        Exchange(CaseNo[i-1], CaseNo[j-1]);
      end; // end if
    end; // Next j
  end; // next i

  // Now sort the columns into ascending order of number right
  for i := 1 to NoSelected - 1 do
  begin
      for j := i + 1 to NoSelected do
      begin
          if (ColTots[i-1,1] > ColTots[j-1,1]) then //swap
          begin
              for k := 1 to NoCases do
              begin
                  if (not GoodRecord(OS3MainFrm.DataGrid, k, ColNoSelected)) then continue;
                  temp := FreqMat0[k-1,i-1];
                  FreqMat0[k-1,i-1] := FreqMat0[k-1,j-1];
                  FreqMat0[k-1,j-1] := temp;
                  temp := FreqMat1[k-1,i-1];
                  FreqMat1[k-1,i-1] := FreqMat1[k-1,j-1];
                  FreqMat1[k-1,j-1] := temp;
              end; // next k
              // swap column totals also
              temp := ColTots[i-1,0];
              ColTots[i-1,0] := ColTots[j-1,0];
              ColTots[j-1,0] := temp;
              temp := ColTots[i-1,1];
              ColTots[i-1,1] := ColTots[j-1,1];
              ColTots[j-1,1] := temp;
              // swap label pointers
              temp := sequence[i-1];
              sequence[i-1] := sequence[j-1];
              sequence[j-1] := temp;
          end; // end if
      end; // next j
  end; // next i

  //For each item (column), find the optimal cutting value
  for i := 1 to NoSelected do
  begin
      CutScore[i-1] := 0;
      for j := 1 to NoCases do // j is the trial cut point
      begin
          if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
          e0 := 0;
          e1 := 0;
          //Get errors prior to the cut point
          for k := 1 to j do
          begin
              if (not GoodRecord(OS3MainFrm.DataGrid, k, ColNoSelected)) then continue;
              if (FreqMat0[k-1,i-1] = 1) then e0 := e0 + 1;
          end;
          //Get errors following the cut point
          for k := j + 1 to NoCases do
          begin
              if (not GoodRecord(OS3MainFrm.DataGrid, k, ColNoSelected)) then continue;
              if (FreqMat1[k-1,i-1] = 1) then e1 := e1 + 1;
          end;
          //Save errors for each cut
          CaseVector[j-1] := e0 + e1;
      end; // next j
      // Save minimum cut score index
      e2 := 32000;
      e3 := 0;
      for j := 1 to NoCases do
      begin
          if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
          if (CaseVector[j-1] < e2) then
          begin
              e2 := CaseVector[j-1];
              e3 := j;
          end;
      end;
      CutScore[i-1] := e3; //Position of optimal cut for item i
  end;

  // Get error counts;
  for i := 1 to NoSelected do
  begin
      for j := 1 to CutScore[i-1] do
      begin
          if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
          if ((FreqMat0[j-1,i-1] > 0) or (FreqMat1[j-1,i-1] > 0)) then
              ErrorMat[i-1,0] := ErrorMat[i-1,0] + FreqMat0[j-1,i-1];
      end;
      for j := CutScore[i-1] + 1 to NoCases do
      begin
          if (not GoodRecord(OS3MainFrm.DataGrid, j, ColNoSelected)) then continue;
          if ((FreqMat0[j-1,i-1] > 0) or (FreqMat1[j-1,i-1] > 0)) then
              ErrorMat[i-1,1] := ErrorMat[i-1,1] + FreqMat1[j-1,i-1];
      end;
  end;

  // Print results
  lReport := TStringList.Create;
  try
    lReport.Add('GUTTMAN SCALOGRAM ANALYSIS');
    lReport.Add('Cornell Method');
    lReport.Add('');
    lReport.Add('Number of cases: %5d', [NoCases]);
    lReport.Add('Number of items: %5d', [NoSelected]);
    lReport.Add('');
    lReport.Add('RESPONSE MATRIX');
    lReport.Add('');
    first := 1;
    last := first + 5; // column (item) index
    if (last > NoSelected) then last := NoSelected;
    done := false;

    // Loop through all of the score groups
    while (not done) do
    begin
      lReport.Add('Subject Row                      Item Number');
      outline :=  ' Label  Sum  ';
      for i := first to last do
        outline := outline + '  ' + CenterString(VarLabels[sequence[i-1]-1], 10);
      lReport.Add(outline);

      outline :=  '             ';
      for i := first to last do
        outline := outline + '  ' + '  0    1  ';

      lReport.Add(outline);
      lReport.Add('');
      for i := 1 to NoCases do // rows
      begin
        if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
        outline := Format('  %3d   %3d  ', [CaseNo[i-1], RowTots[i-1]]);
        for j := first to last do
          outline := outline + Format('  %3d  %3d  ', [FreqMat0[i-1,j-1], FreqMat1[i-1,j-1]]);
        lReport.Add(outline);

        // check for optimal cut point for this score
        outline :='             ';
        for j := first to last do
          if (CutScore[j-1] = i) then
            outline := outline + '    -cut-   '
          else
            outline := outline + '            ';
        lReport.Add(outline);
      end; // Next row (score group)
      lReport.Add('');

      outline :=  'TOTALS       ';
      for j := first to last do
        outline := outline + Format('  %3d  %3d  ', [ColTots[j-1,0], ColTots[j-1,1]]);
      lReport.Add(outline);

      outline :=  'ERRORS       ';
      for j := first to last do
        outline := outline + Format('  %3d  %3d  ', [ErrorMat[j-1,0], ErrorMat[j-1,1]]);
      lReport.Add(outline);
      if (last < NoSelected) then
      begin
        first := last + 1;
        last := first + 5; // column (item) index
        if (last > NoSelected) then last := NoSelected;
      end
      else
        done := true;
      lReport.Add('');
    end;

    lReport.Add('');
    CoefRepro := 0.0;
    for j := 1 to NoSelected do
        CoefRepro := CoefRepro + ErrorMat[j-1,0] + ErrorMat[j-1,1];
    CoefRepro := 1.0 - (CoefRepro / (NoCases * NoSelected));
    lReport.Add('Coefficient of Reproducibility := %6.3f',[CoefRepro]);

    FCornellReportFrame.DisplayReport(lReport);
    lReport.Clear;


    //-----------------------------GOODENOUGH----------------------------------
    // Complete Goodenough method and print results
    lReport.Add('GUTTMAN SCALOGRAM ANALYSIS');
    lReport.Add('Goodenough Modification Using Modal Responses');
    lReport.Add('');
    totalerrors := 0;
    Min_Coeff := 0.0;
    for i := 1 to NoSelected + 1 do
      for j := 1 to NoSelected do ModalArray[i-1,j-1] := 0;
    for i := 1 to NoSelected do // column
    begin
      ColProps[i-1] := ColTots[i-1,1] / NoCases;
      ErrorMat[i-1,0] := 0;
      ErrorMat[i-1,1] := 0;
    end;
    // Get the cut scores for each score row based on rounded proportions
    for i := 1 to NoSelected do
    begin
      CutScore[i-1] := Trunc(ColProps[i-1] * (NoSelected+1));
    end;

    // Build modal response array for the total scores by items
    lReport.Add('');
    lReport.Add('MODAL ITEM RESPONSES');
    lReport.Add('');
    lReport.Add('TOTAL                 ITEMS');
    outline := '     ';
    for i := 1 to NoSelected do
    begin
      astring := format('%10s',[VarLabels[sequence[i-1]-1]]);
      outline := outline + astring;
    end;
    lReport.Add(outline);
    for i := 0 to NoSelected do
    begin
      for j := 1 to NoSelected do
        if (CutScore[j-1] > i) then
          ModalArray[i,j-1] := 1
        else
          ModalArray[i,j-1] := 0;
      astring := format(' %3d ',[NoSelected - i]);
      outline := astring;
      for j := 1 to NoSelected do
      begin
        astring := format('    %3d   ',[ModalArray[i,j-1]]);
        outline := outline + astring;
      end;
      lReport.Add(outline);
    end;

    lReport.Add('');
    lReport.Add('Number of cases: %3d', [NoCases]);
    lReport.Add('Number of items: %3d', [NoSelected]);
    lReport.Add('');
    lReport.Add('');
    lReport.Add('RESPONSE MATRIX');
    lReport.Add('');
    first := 1;
    last := first + 5; // column (item) index
    if (last > NoSelected) then last := NoSelected;

    // Loop through all of the score groups
    done := false;
    while (not done) do
    begin
      lReport.Add('Subject  Row  Error                    Item Number');
      outline :=  ' Label   Sum  Count';
      for i := first to last do
        outline := outline + '  ' + CenterString(Varlabels[sequence[i-1]-1], 10);
      lReport.Add(outline);
      outline :=  '                   ';
      for i := first to last do
        outline := outline + '  ' + '  0    1  ';
      lReport.Add(outline);
      lReport.Add('');
      for i := 1 to NoCases do // rows
      begin
        if (not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected)) then continue;
        errors := 0;
        for j := first to last do
        begin
          rowno := NoSelected - RowTots[i-1] + 1;
          if (FreqMat1[i-1,j-1] <> ModalArray[rowno-1,j-1]) then  errors := errors + 1;
        end;

        outline := Format('   %3d   %3d   %3d ',[CaseNo[i-1],RowTots[i-1],errors]);
        for j := first to last do
        begin
          astring := Format('  %3d  %3d  ',[FreqMat0[i-1,j-1],FreqMat1[i-1,j-1]]);
          outline := outline + astring;
        end;
        lReport.Add(outline);
        totalerrors := totalerrors + errors;
      end; // Next row (score group)
      lReport.Add('');

      outline :=  'TOTALS             ';
      for j := first to last do
        outline := outline + Format('  %3d  %3d  ',[ColTots[j-1,0], ColTots[j-1,1]]);
      lReport.Add(outline);

      outline :=  'PROPORTIONS        ';
      for j := first to last do
        outline := outline + Format('%5.2f%5.2f  ',[(1.0-ColProps[j-1]), ColProps[j-1]]);
      lReport.Add(outline);

      if (last < NoSelected) then
      begin
        first := last + 1;
        last := first + 5; // column (item) index
        if (last > NoSelected) then last := NoSelected;
      end
      else
        done := true;
      lReport.Add('');
    end;
    lReport.Add('');
    CoefRepro := 1.0 - (totalerrors / (NoCases * NoSelected));
    lReport.Add('Coefficient of Reproducibility:   %6.3f', [CoefRepro]);

    for j := 1 to NoSelected do
      if (ColProps[j-1] > (1.0 - ColProps[j-1])) then
        Min_Coeff := Min_Coeff + ColProps[j-1]
      else
        Min_Coeff := Min_Coeff + (1.0 - ColProps[j-1]);
    Min_Coeff := Min_coeff / NoSelected;

    lReport.Add('Minimal Marginal Reproducibility: %6.3f', [Min_Coeff]);

    FGoodenoughReportFrame.DisplayReport(lReport);
  finally
    lReport.Free;
  end;
end;


procedure TGuttmanForm.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
      inc(i);
  end;
  UpdateBtnStates;
end;


procedure TGuttmanForm.ItemListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := ItemList.ItemIndex;
  if index > -1 then
  begin
    VarList.Items.Add(ItemList.Items[index]);
    ItemList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;


procedure TGuttmanForm.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
      inc(i);
  end;
  UpdateBtnStates;
end;


procedure TGuttmanForm.Reset;
begin
  inherited;

  if FGoodenoughReportFrame <> nil then
    FGoodenoughReportFrame.Clear;

  CollectVariableNames(OS3MainFrm.DataGrid, VarList.Items);
  ItemList.Clear;
  UpdateBtnStates;
end;


procedure TGuttmanForm.UpdateBtnStates;
begin
  inherited;

  if FGoodenoughReportFrame <> nil then
    FGoodenoughReportFrame.UpdateBtnStates;

  InBtn.Enabled := AnySelected(Varlist);
  OutBtn.Enabled := AnySelected(Itemlist);
  AllBtn.Enabled := VarList.Items.Count > 0;
end;


function TGuttmanForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
begin
  Result := false;

  if ItemList.Count = 0 then
  begin
    AMsg := 'No variable(s) selected.';
    AControl := VarList;
    exit;
  end;

  Result := true;
end;


procedure TGuttmanForm.VarListDblClick(Sender: TObject);
var
  index: Integer;
begin
  index := VarList.ItemIndex;
  if index > -1 then
  begin
    ItemList.Items.Add(VarList.Items[index]);
    VarList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;


procedure TGuttmanForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;


end.