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

// File for testing: CompRelData.laz, use all variables

unit CompRelUnit;

{$mode objfpc}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Buttons, ExtCtrls,
  MainUnit, Globals, MatrixLib, DictionaryUnit, BasicStatsReportFormUnit;

type

  { TCompRelForm }

  TCompRelForm = class(TBasicStatsReportForm)
    Bevel1: TBevel;
    InBtn: TBitBtn;
    OutBtn: TBitBtn;
    AllBtn: TBitBtn;
    RMatChk: TCheckBox;
    GridScrChk: TCheckBox;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    ItemList: TListBox;
    Label3: TLabel;
    Label4: TLabel;
    WeightList: TListBox;
    RelList: TListBox;
    VarList: TListBox;
    procedure AllBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure ItemListSelectionChange(Sender: TObject; {%H-}User: boolean);
    procedure OutBtnClick(Sender: TObject);
    procedure RelListClick(Sender: TObject);
    procedure WeightListClick(Sender: TObject);

  private

  protected
    procedure AdjustConstraints; override;
    procedure Compute; override;
    procedure UpdateBtnStates; override;
    function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;

  public
    procedure Reset; override;
  end; 

var
  CompRelForm: TCompRelForm;


implementation

{$R *.lfm}

uses
  Dialogs, Math,
  Utils, GridProcs;


{ TCompRelForm }

procedure TCompRelForm.AdjustConstraints;
begin
  inherited;

  RelList.Width := Max(Label3.Width, Label4.Width);
  WeightList.Width := RelList.Width;

  ParamsPanel.Constraints.MinWidth := MaxValueI([
    GroupBox1.Width,
    4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
    Max(Label1.Width, Label2.Width)*2 + 2*RelList.Width +
      AllBtn.Width + 2*VarList.BorderSpacing.Right + 2*RelList.BorderSpacing.Right]);

  ParamsPanel.Constraints.MinHeight := OutBtn.Top + 4*OutBtn.Height + 3*OutBtn.BorderSpacing.Bottom +
    VarList.BorderSpacing.Bottom + GroupBox1.Height +
    ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
end;


procedure TCompRelForm.AllBtnClick(Sender: TObject);
var
  i: integer;
  cellstring : string;
begin
  cellstring := '1.0';
  for i := 1 to VarList.Items.Count do
  begin
    ItemList.Items.Add(VarList.Items[i-1]);
    RelList.Items.Add(cellstring);
    WeightList.Items.Add(cellstring);
  end;
  VarList.Clear;
  UpdateBtnStates;
end;


procedure TCompRelForm.Compute;
var
  errorcode: boolean = false;
  Rmat: DblDyneMat = nil;
  RelMat: DblDyneMat = nil;
  Weights: DblDyneVec = nil;
  Reliabilities: DblDyneVec = nil;
  VectProd: DblDyneVec = nil;
  means: DblDyneVec = nil;
  variances: DblDyneVec = nil;
  stddevs: DblDyneVec = nil;
  ColNoSelected: IntDyneVec = nil;
  RowLabels: StrDyneVec = nil;
  cellstring: string;
  title: string;
  i, j, NoVars, count, col: integer;
  CompRel, numerator, denominator, compscore: double;
  lReport: TStrings;
begin
  SetLength(Rmat, NoVariables+1,NoVariables+1);
  SetLength(RelMat, NoVariables+1, NoVariables+1);
  SetLength(Weights, NoVariables);
  SetLength(Reliabilities, NoVariables);
  SetLength(VectProd, NoVariables);
  SetLength(means, NoVariables);
  SetLength(variances, NoVariables);
  SetLength(stddevs, NoVariables);

  // Get selected variables' column numbers
  NoVars := ItemList.Items.Count;
  SetLength(RowLabels, NoVars);
  Setlength(ColNoSelected, NoVars);
  for i := 0 to NoVars-1 do
  begin
    RowLabels[i] := ItemList.Items[i];
    ColNoSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, RowLabels[i]);
  end;
  count := NoCases;

  lReport := TStringList.Create;
  try
    lReport.Add('COMPOSITE TEST RELIABILITY');
    lReport.Add('');
    lReport.Add('File analyzed: ' + OS3MainFrm.FileNameEdit.Text);
    lReport.Add('');

    // get correlation matrix
    Correlations(NoVars, ColNoSelected, Rmat, means, variances, stddevs, errorcode, count);

    if errorcode then
    begin
      ErrorMsg('Zero variance found for a variable.');
      exit;
    end;

    if RmatChk.Checked then
    begin
      title := 'Correlations Among Tests';
      MatPrint(Rmat, NoVars, NoVars, title, RowLabels, RowLabels, count, lReport);
      title := 'Means';
      DynVectorPrint(means, NoVars, title, RowLabels, count, lReport);
      title := 'Variances';
      DynVectorPrint(variances, NoVars, title, RowLabels, count, lReport);
      title := 'Standard Deviations';
      DynVectorPrint(stddevs, NoVars, title, RowLabels, count, lReport);
    end;

    for i := 0 to NoVars do
      for j := 0 to NoVars do
        RelMat[i, j] := Rmat[i, j];

    for i := 0 to NoVars-1 do
    begin
      Reliabilities[i] := StrToFloat(RelList.Items[i]);
      RelMat[i, i] := Reliabilities[i];
      Weights[i] := StrToFloat(WeightList.Items[i]);
    end;

    // get numerator and denominator of composite reliability
    for i := 0 to NoVars-1 do
      VectProd[i] := 0.0;
    numerator := 0.0;
    denominator := 0.0;
    for i := 0 to NoVars-1 do
      for j := 0 to NoVars-1 do
        VectProd[i] := VectProd[i] + (Weights[i] * RelMat[j, i]);
    for i := 0 to NoVars-1 do
      numerator := numerator + (VectProd[i] * Weights[i]);

    for i := 0 to NoVars-1 do
      VectProd[i] := 0.0;
    for i := 0 to NoVars-1 do
      for j := 0 to NoVars-1 do
        VectProd[i] := VectProd[i] + (Weights[i] * Rmat[j, i]);
    for i := 0 to NoVars-1 do
      denominator := denominator + VectProd[i] * Weights[i];
    CompRel := numerator / denominator;

    title := 'Test Weights';
    DynVectorPrint(Weights, NoVars, title, RowLabels, count, lReport);
    title := 'Test Reliabilities';
    DynVectorPrint(Reliabilities, NoVars, title, RowLabels, count, lReport);
    lReport.Add('Composite reliability: %6.3f', [CompRel]);

    FReportFrame.DisplayReport(lReport);

    if GridScrChk.Checked then
    begin
      cellstring := 'Composite';
      col := GetVariableIndex(OS3MainFrm.DataGrid, cellString);
      if col = -1 then
      begin
        col := NoVariables + 1;
        DictionaryFrm.NewVar(col);
        DictionaryFrm.DictGrid.Cells[1,col] := cellstring;
        col := NoVariables;
        OS3MainFrm.DataGrid.Cells[col,0] := cellstring;
        col := NoVariables;
      end else
      begin
        if MessageDlg('Overwrite variable "' + cellstring + '"?', mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
          exit;
      end;
      for i := 1 to NoCases do
      begin
        if not GoodRecord(OS3MainFrm.DataGrid, i, ColNoSelected) then
          continue;
        compscore := 0.0;
        for j := 0 to NoVars-1 do
          compscore := compscore + (Weights[j] * StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[ColNoSelected[j],i])));
        OS3MainFrm.DataGrid.Cells[col,i] := FloatToStr(compscore);
      end;
      GridScrChk.Checked := false;
    end;

  finally
    lReport.Free;
  end;
end;


procedure TCompRelForm.InBtnClick(Sender: TObject);
var
  i: integer;
  cellstring: string;
begin
  cellstring := '1.0';
  i := 0;
  while i < VarList.Items.Count do
  begin
    if VarList.Selected[i] then
    begin
      ItemList.Items.Add(VarList.Items[i]);
      RelList.Items.Add(cellstring);
      WeightList.Items.Add(cellstring);
      VarList.Items.Delete(i);
      i := 0;
    end
    else
      inc(i);
  end;
  UpdateBtnStates;
end;


procedure TCompRelForm.ItemListSelectionChange(Sender: TObject; User: boolean);
begin
  UpdateBtnStates;
end;


procedure TCompRelForm.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);
      RelList.Items.Delete(i);
      WeightList.Items.Delete(i);
      i := 0;
    end else
      inc(i);
  end;
  UpdateBtnStates;
end;


procedure TCompRelForm.RelListClick(Sender: TObject);
var
  response: string;
  index: integer;
begin
  response := InputBox('Reliability', 'Reliability estimate: ', '1.0');
  index := RelList.ItemIndex;
  RelList.Items[index] := response;
end;


procedure TCompRelForm.Reset;
begin
  inherited;

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


procedure TCompRelForm.UpdateBtnStates;
begin
  inherited;
  InBtn.Enabled := AnySelected(VarList);
  OutBtn.Enabled := AnySelected(ItemList);
  AllBtn.Enabled := VarList.Items.Count > 0;
end;


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

  if ItemList.Count = 0 then
  begin
    AMsg := 'No items selected.';
    AControl := VarList;
    exit;
  end;

  Result := true;
end;


procedure TCompRelForm.WeightListClick(Sender: TObject);
var
  response: string;
  index: integer;
begin
  response := InputBox('Test Weight', 'Test weight:', '1.0');
  index := WeightList.ItemIndex;
  WeightList.Items.Strings[index] := response;
end;


end.