lazarus-ccr/applications/lazstats/source/forms/analysis/multivariate/medianpolishunit.pas

// wp: Unit not tested due to missing documentation
//     Tried to reproduce https://www.youtube.com/watch?v=RtC9ZMOYgk8
//     --> does not work...

// wp: a file with reasonable output is LesMaySmoothin.laz with x -> dep,
//     row --> Factor 1, col --> Factor2.

unit MedianPolishUnit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Buttons, ExtCtrls,
  MainUnit, Globals, FunctionsLib, OutputUnit, GraphLib;

type

  { TMedianPolishForm }

  TMedianPolishForm = class(TForm)
    Bevel1: TBevel;
    NormChk: TCheckBox;
    MaxEdit: TEdit;
    Label4: TLabel;
    ItersBtn: TRadioButton;
    Panel1: TPanel;
    ResetBtn: TButton;
    ComputeBtn: TButton;
    CloseBtn: TButton;
    DepIn: TBitBtn;
    DepOut: TBitBtn;
    DepVar: TEdit;
    Fact1In: TBitBtn;
    Fact1Out: TBitBtn;
    Fact2In: TBitBtn;
    Fact2Out: TBitBtn;
    Factor1: TEdit;
    Factor2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StaticText1: TStaticText;
    VarList: TListBox;
    procedure ComputeBtnClick(Sender: TObject);
    procedure DepInClick(Sender: TObject);
    procedure DepOutClick(Sender: TObject);
    procedure Fact1InClick(Sender: TObject);
    procedure Fact1OutClick(Sender: TObject);
    procedure Fact2InClick(Sender: TObject);
    procedure Fact2OutClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ResetBtnClick(Sender: TObject);
    procedure VarListSelectionChange(Sender: TObject; User: boolean);

  private
    { private declarations }
    FAutoSized: boolean;
    CumRowResiduals: DblDyneVec;
    CumColResiduals: DblDyneVec;
    function Median(const X: DblDyneVec; ASize: integer): double;
    procedure PrintObsTable(const ObsTable: DblDyneMat; NRows, NCols: integer;
      AReport: TStrings);
    procedure PrintResults(const ObsTable: DblDyneMat; const
      RowMedian, RowResid, ColMedian, ColResid: DblDyneVec;
      NRows, NCols: integer; AReport: TStrings);
    procedure SortValues(const X: DblDyneVec; ASize: integer);
    procedure TwoWayPlot(NF1cells: integer; const RowSums: DblDyneVec;
      const AGraphTitle, AHeading: string);
    procedure InteractPlot(NF1cells, NF2Cells: integer; const ObsTable: DblDyneMat;
      const AGraphTitle, AHeading: string);
    procedure UpdateBtnStates;
  public
    { public declarations }
  end; 

var
  MedianPolishForm: TMedianPolishForm;

implementation

uses
  Math, Utils;

{ TMedianPolishForm }

procedure TMedianPolishForm.ResetBtnClick(Sender: TObject);
var
  i: integer;
begin
  VarList.Clear;
  for i := 1 to NoVariables do
    VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
  DepVar.Text := '';
  Factor1.Text := '';
  Factor2.Text := '';
  ItersBtn.Checked := false;
  NormChk.Checked := false;
  UpdateBtnStates;
end;

procedure TMedianPolishForm.ComputeBtnClick(Sender: TObject);
var
  DepVarCol, F1Col, F2Col, i, j, k : integer;
  minrow, maxrow, mincol, maxcol : integer;
  intvalue, xrange, yrange, row, col, N, count, iteration : integer;
  X, M, sumrowmedians, sumcolmedians, GrandMedian, scale, TotResid : double;
  SumAbsRows, SumAbsCols, SumAbsTable, TableSum, explained : double;
  Q1, Q3, Qrange1, Qrange2, total : double;
  ColNoSelected : IntDyneVec;
  Observed : DblDyneCube;
  Residuals : DblDyneCube;
  RowResiduals : DblDyneVec;
  ColResiduals : DblDyneVec;
  RowMedian : DblDyneVec;
  ColMedian : DblDyneVec;
  CellCount : IntDyneMat;
  GroupScores : DblDyneVec;
  ObsTable : DblDyneMat;
  cellstring : string;
  single : boolean;
  NoIterations : integer;
  done : boolean;
  WholeTable : DblDyneVec;
  RowEffects : DblDyneVec;
  ColEffects : DblDyneVec;
  floatValue: Double;
  lReport: TStrings;
begin
  if DepVar.Text = '' then
  begin
     MessageDlg('No dependant variable selected.', mtError, [mbOK], 0);
     exit;
  end;
  if Factor1.Text = '' then
  begin
     MessageDlg('No Factor 1 variable selected.', mtError, [mbOK], 0);
     exit;
  end;
  if Factor2.Text = '' then
  begin
     MessageDlg('No Factor 2 variable selected.', mtError, [mbOK], 0);
     exit;
  end;
  if MaxEdit.Text = '' then
  begin
     MaxEdit.SetFocus;
     MessageDlg('Max. iterations not specified.', mtError, [mbOK], 0);
     exit;
  end;
  if not TryStrToInt(MaxEdit.Text, NoIterations) or (NoIterations < 0) then
  begin
    MaxEdit.SetFocus;
    MessageDlg('Invalid input for Max iterations.', mtError, [mbOk], 0);
    exit;
  end;

  lReport := TStringList.Create;
  try
    for i := 1 to NoVariables do
    begin
      cellstring := Trim(OS3MainFrm.DataGrid.Cells[i,0]);
      if cellstring = DepVar.Text then DepVarCol := i;
      if cellstring = Factor1.Text then F1Col := i;
      if cellstring = Factor2.Text then F2Col := i;
    end;
    SetLength(ColNoSelected, 3);
    ColNoSelected[0] := DepVarCol;
    ColNoSelected[1] := F1Col;
    ColNoSelected[2] := F2Col;

    // get no. of rows and columns (Factor 1 and Factor 2)
    mincol := 10000;
    maxcol := 0;
    minrow := 10000;
    maxrow := 0;
    for i := 1 to NoCases do
    begin
      if TryStrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]), floatValue) and
         (Frac(floatValue) = 0) then
      begin
        intValue := trunc(floatValue);
        if intvalue > maxrow then maxrow := intvalue;
        if intvalue < minrow then minrow := intvalue;
      end else
      begin
        MessageDlg(Format('Integer value expected in cell at column %d and cell %d', [F1Col, i]), mtError, [mbOK], 0);
        exit;
      end;

      if TryStrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]), floatValue) and
        (Frac(floatvalue) = 0) then
      begin
        intValue := trunc(floatValue);
        if intvalue > maxcol then maxcol := intvalue;
        if intvalue < mincol then mincol := intvalue;
      end else
      begin
        MessageDlg(Format('Integer value expected in cell at column %d and cell %d', [F2Col, i]), mtError, [mbOK], 0);
        exit;
      end;
    end;

    xrange := maxrow - minrow + 1;
    yrange := maxcol - mincol + 1;

    // get no. of observations in each cell
    SetLength(CellCount,xrange,yrange);
    for i := 0 to xrange-1 do
      for j := 0 to yrange-1 do
        CellCount[i,j] := 0;

    count := 0;
    for i := 1 to NoCases do
    begin
      row := trunc(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i])));
      row := row - minrow;
      col := trunc(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i])));
      col := col - mincol;
      CellCount[row,col] := CellCount[row,col] + 1;
      count := count + 1;
    end;
    single := (count = (xrange * yrange));

    SetLength(Observed, NoCases, xrange, yrange);
    SetLength(Residuals, NoCases, xrange, yrange);
    SetLength(RowResiduals, xrange);
    SetLength(ColResiduals, yrange);
    SetLength(GroupScores, NoCases);
    SetLength(RowMedian, xrange);
    SetLength(ColMedian, yrange);
    SetLength(CumRowResiduals, xrange);
    SetLength(CumColResiduals, yrange);
    SetLength(WholeTable, xrange * yrange);
    SetLength(RowEffects, xrange);
    SetLength(ColEffects, yrange);

    for i := 0 to NoCases-1 do
    begin
      for j := 0 to xrange-1 do
        for k := 0 to yrange-1 do
        begin
          Observed[i,j,k] := 0.0;
          Residuals[i,j,k] := 0.0;
        end;
    end;

    for j := 0 to xrange-1 do
    begin
      RowResiduals[j] := 0.0;
      CumRowResiduals[j] := 0.0;
    end;

    for j := 0 to yrange-1 do
    begin
      ColResiduals[j] := 0.0;
      CumColResiduals[j] := 0.0;
    end;

    // Get observed scores
    for i := 0 to xrange-1 do
      for j := 0 to yrange-1 do
        CellCount[i,j] := 0;
    for i := 1 to NoCases do
    begin
      row := trunc(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F1Col,i]))) - minrow;
      col := trunc(StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[F2Col,i]))) - minCol;
      X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[DepVarCol,i]));
      CellCount[row, col] := CellCount[row, col] + 1;
      N := CellCount[row, col];
      Observed[N-1, row, col] := X;
    end;

    // if not single case in each cell, obtain median for each cell
    if not single then
    begin
      for i := 0 to xrange-1 do
      begin
        for j := 0 to yrange-1 do
        begin
          for k := 0 to CellCount[i,j]-1 do
            GroupScores[k] := Observed[k,i,j];
          M := Median(GroupScores,CellCount[i,j]);
          Observed[0,i,j] := M;
        end;
      end;
    end;

    SetLength(ObsTable, xrange, yrange);
    k := 0;
    for i := 0 to xrange-1 do
    begin
      for j := 0 to yrange-1 do
      begin
        ObsTable[i,j] := Observed[0,i,j];
        WholeTable[k] := Observed[0,i,j];
        k := k + 1;
      end;
    end;

    SortValues(WholeTable, xrange * yrange);
    Q1 := Quartiles(2, 0.25, xrange*yrange, WholeTable);
    Q3 := Quartiles(2, 0.75, xrange*yrange, WholeTable);
    QRange1 := Q3 - Q1;
    lReport.Add('Quartiles of original data: %8.3f and %.3f', [Q1,Q3]);
    lReport.Add('');
    lReport.Add(DIVIDER);
    lReport.Add('');

    // Bill Miller's solution

    if NormChk.Checked then
    begin
      lReport.Add('BILL MILLER''s SOLUTION');
      lReport.Add('');
      // get deviations of each cell from the grand mean, row and column residuals
      // and row and column absolute deviations
      k := 0;
      for i := 0 to xrange-1 do
        for j := 0 to yrange-1 do
        begin
          ObsTable[i,j] := Observed[0,i,j];
          WholeTable[k] := Observed[0,i,j];
          k := k + 1;
        end;

      SortValues(WholeTable, xrange * yrange);
      GrandMedian := Median(WholeTable, xrange * yrange);

      lReport.Add('Grand Median: %9.3f', [GrandMedian]);
      lReport.Add('');

      PrintObsTable(ObsTable, xrange, yrange, lReport);

      lReport.Add('');
      lReport.Add(DIVIDER);
      lReport.Add('');

      for i := 0 to xrange-1 do
      begin
        RowMedian[i] := 0.0;
        RowResiduals[i] := 0.0;
        CumRowResiduals[i] := 0.0;
      end;
      for j := 0 to yrange-1 do
      begin
        ColMedian[j] := 0.0;
        ColResiduals[j] := 0.0;
        CumColResiduals[j] := 0.0;
      end;

      for i := 0 to xrange-1 do
      begin
        for j := 0 to yrange-1 do
          GroupScores[j] := ObsTable[i,j];
        SortValues(GroupScores, yrange);
        RowMedian[i] := Median(GroupScores, yrange);
      end;

      for i := 0 to xrange-1 do
      begin
        for j := 0 to yrange-1 do
          RowResiduals[i] := RowResiduals[i] + (ObsTable[i,j] - RowMedian[i]);
        CumRowResiduals[i] := CumRowResiduals[i] + abs(RowResiduals[i]);
      end;

      for j := 0 to yrange-1 do
      begin
        for i := 0 to xrange-1 do
          GroupScores[i] := ObsTable[i,j];
        SortValues(GroupScores, xrange);
        ColMedian[j] := Median(GroupScores, xrange);
      end;

      for j := 0 to yrange-1 do
      begin
        for i := 0 to xrange-1 do
          ColResiduals[j] := ColResiduals[j] + (ObsTable[i,j] - ColMedian[j]);
        CumColResiduals[j] := CumColResiduals[j] + abs(ColResiduals[j]);
      end;

      PrintResults(ObsTable, RowMedian, RowResiduals, ColMedian, ColResiduals, xrange, yrange, lReport);

      lReport.Add('');
      lReport.Add(DIVIDER);
      lReport.Add('');

      //     TwoWayPlot(xrange, RowMedian,'Rows','ROW MEDIANS');
      //     TwoWayPlot(yrange, ColMedian,'Columns','COL. MEDIANS');

      // Normalize medians and raw data
      // This will result in the sum of column, row and table residuals all
      // summing to zero.  The model is X = Total Median + Row effects +
      // col. effects + interaction effects and the row, col and interaction
      // effects each sum to zero (as in ANOVA)
      TableSum := 0.0;
      scale := 0;
      for i := 0 to xrange-1 do
        for j := 0 to yrange-1 do
          scale := scale + ObsTable[i,j];
      scale := scale / (xrange * yrange);
      for i := 0 to xrange-1 do
        for j := 0 to yrange-1 do
        begin
          ObsTable[i,j] := ObsTable[i,j] - scale;
          TableSum := TableSum + abs(ObsTable[i,j]);
        end;

      lReport.Add('Normalized Data');
      PrintObsTable(ObsTable, xrange, yrange, lReport);
      lReport.Add('');

      scale := 0;
      for i := 0 to xrange-1 do scale := scale + RowMedian[i];
      scale := scale / xrange;
      for i := 0 to xrange-1 do RowMedian[i] := RowMedian[i] - scale;
      scale := 0;
      for j := 0 to yrange-1 do scale := scale + ColMedian[j];
      scale := scale / yrange;
      for j := 0 to yrange-1 do ColMedian[j] := ColMedian[j] - scale;

      lReport.Add('Normalized  Adjusted Data');
      PrintResults(ObsTable, RowMedian, RowResiduals, ColMedian, ColResiduals, xrange, yrange, lReport);
      lReport.Add('');

      for i := 0 to xrange-1 do
        for j := 0 to yrange-1 do
          ObsTable[i,j] := ObsTable[i,j] - (RowMedian[i] + ColMedian[j]);

      lReport.Add('Normalized Table minus Row and Column Medians');
      PrintObsTable(ObsTable, xrange, yrange, lReport);
      lReport.Add('');

      for i := 0 to xrange-1 do RowResiduals[i] := 0.0;
      for j := 0 to yrange-1 do ColResiduals[j] := 0.0;
      TotResid := 0.0;
      for i := 0 to xrange-1 do
        for j := 0 to yrange-1 do
        begin
          RowResiduals[i] := RowResiduals[i] + ObsTable[i,j];
          ColResiduals[j] := ColResiduals[j] + ObsTable[i,j];
          TotResid := TotResid + ObsTable[i,j];
        end;

      lReport.Add('Normalized  Adjusted Data');
      PrintResults(ObsTable, RowMedian, RowResiduals, ColMedian, ColResiduals, xrange, yrange, lReport);
      lReport.Add('');
      lReport.Add('Total Table Residuals:         %8.3f', [TotResid]);
      lReport.Add('');

      SumAbsRows := 0.0;
      SumAbsCols := 0.0;
      SumAbsTable := 0.0;
      for i := 0 to xrange-1 do
        SumAbsRows := SumAbsRows + abs(RowMedian[i]);
      for j := 0 to yrange-1 do
        SumAbsCols := SumAbsCols + abs(ColMedian[j]);
      for i := 0 to xrange - 1 do
        for j := 0 to yrange - 1 do
          SumAbsTable := SumAbsTable + abs(ObsTable[i,j]);
      lReport.Add('Absolute Sums of Row:          %8.3f', [SumAbsRows]);
      lReport.Add('              of Col:          %8.3f', [SumAbsCols]);
      lReport.Add('              of Interactions: %8.3f', [SumAbsTable]);
      total := SumAbsRows + SumAbsCols + SumAbsTable;
      lReport.Add('Absolute Sums of Table Values prior to Extracting Row and Col.: %8.3f', [TableSum]);
      lReport.Add('Percentages explained by rows:                                  %8.3f %%', [100.0 * SumAbsRows / total]);
      lReport.Add('                         cols:                                  %8.3f %%', [100.0 * SumAbscols / total]);
      lReport.Add('                         interactions plus error:               %8.3f %%', [100*SumAbsTable/total]);

      explained := 100*SumAbsRows/total + 100*SumAbsCols/total + 100*SumAbsTable/total;
      lReport.Add('Percentage explained:                                           %8.3f %%', [explained]);

      lReport.Add('');
      lReport.Add(DIVIDER);
      lReport.Add('');

      TwoWayPlot(xrange, RowMedian, 'Rows', 'ROW MEDIANS');
      TwoWayPlot(yrange, ColMedian, 'Columns', 'COL. MEDIANS');
    end; // Bills method

    // Now do traditional median smoothing
    lReport.Add('TUKEY ITERATIVE MEDIAN SMOOTHING METHOD');
    lReport.Add('');

    done := false;
    iteration := 1;
    for i := 0 to xrange-1 do
      RowEffects[i] := 0.0;
    for j := 0 to yrange-1 do
      ColEffects[j] := 0.0;
    while not done do
    begin
      // Get residuals from the median for each row
      count := 0;
      for i := 0 to xrange-1 do
      begin
        count := 0;
        for j := 0 to yrange-1 do
        begin
          GroupScores[count] := Observed[0,i,j];
          count := count + 1;
        end;
        SortValues(GroupScores, count);
        M := Median(GroupScores, count);
        RowMedian[i] := M;
        for j := 0 to yrange-1 do Observed[0,i,j] := Observed[0,i,j] - M;
        for j := 0 to yrange-1 do RowResiduals[i] := RowResiduals[i] + Observed[0,i,j];
        CumRowResiduals[i] := CumRowResiduals[i] + abs(RowResiduals[i]);
      end;

      // get sum of residuals for cols
      count := 0;
      for i := 0 to yrange-1 do
      begin
        count := 0;
        for j := 0 to xrange-1 do
        begin
          GroupScores[count] := Observed[0,j,i];
          count := count + 1;
        end;
        SortValues(GroupScores, count);
        M := Median(GroupScores, count);
        ColMedian[i] := M;
        for j := 0 to xrange-1 do Observed[0,j,i] := Observed[0,j,i] - M;
        for j := 0 to xrange-1 do ColResiduals[i] := ColResiduals[i] + Observed[0,j,i];
        CumColResiduals[i] := CumColResiduals[i] + abs(ColResiduals[i]);
      end;

      // build table of results
      for i := 0 to xrange-1 do
        for j := 0 to yrange-1 do
          ObsTable[i,j] := Observed[0,i,j]; // Residuals[0,i,j];

//        if ItersBtn.Checked then
//        begin
      lReport.Add('Iteration %d', [iteration]);
      PrintResults(ObsTable, RowMedian, RowResiduals, ColMedian, ColResiduals, xrange, yrange, lReport);
      lReport.Add('');

      lReport.Add('Row Effects');
      for i := 0 to xrange-1 do
        GroupScores[i] := RowMedian[i];

      SortValues(GroupScores, xrange);
      M := Median(GroupScores, xrange);
      lReport.Add('Overall Median: %8.3f', [M]);
      lReport.Add('');

      for i := 0 to xrange-1 do
      begin
        RowEffects[i] := RowEffects[i] + (RowMedian[i] - M);
        lReport.Add('Row %3d Effect: %8.3f', [i+1, RowEffects[i]]);
      end;
      lReport.Add('');

      lReport.Add('Column Effects');
      for j := 0 to yrange-1 do
      begin
        ColEffects[j] := ColEffects[j] + ColMedian[j];
        lReport.Add('Col. %3d Effect: %8.3f', [j+1, ColEffects[j]]);
      end;
      lReport.Add('');
//             OutputFrm.ShowModal;
//             OutputFrm.RichEdit.Clear;
//        end;

      for i := 0 to xrange-1 do RowResiduals[i] := 0.0;
      for j := 0 to yrange-1 do ColResiduals[j] := 0.0;
      NoIterations := NoIterations - 1;
      iteration := iteration + 1;
      if NoIterations = 0 then done := true;
      sumrowmedians := 0.0;
      sumcolmedians := 0.0;
      for i := 0 to xrange-1 do sumrowmedians := sumrowmedians + RowMedian[i];
      for i := 0 to yrange-1 do sumcolmedians := sumcolmedians + ColMedian[i];
      if (sumrowmedians + sumcolmedians) = 0.0 then done := true;
      if done then
      begin
        lReport.Add('SUMMARY OF THE ANALYSIS');
        PrintResults(ObsTable, RowMedian, RowResiduals, ColMedian, ColResiduals, xrange, yrange, lReport);
        for i := 0 to xrange-1 do
        begin
          RowEffects[i] := RowEffects[i] + (RowMedian[i] - M);
          lReport.Add('Row %3d Effect: %8.3f', [i+1, RowEffects[i]]);
        end;
        lReport.Add('');
        lReport.Add('Column Effects');
        for j := 0 to yrange-1 do
        begin
          ColEffects[j] := ColEffects[j] + ColMedian[j];
          lReport.Add('Col. %3d Effect: %8.3f', [j+1, ColEffects[j]]);
        end;
        lReport.Add('');

        k := 0;
        for i := 0 to xrange-1 do
          for j := 0 to yrange-1 do
          begin
            WholeTable[k] := ObsTable[i,j];
            k := k + 1;
          end;

        SortValues(WholeTable, xrange * yrange);
        M := Median(WholeTable, xrange * yrange);
        Q1 := Quartiles(2, 0.25, xrange * yrange, WholeTable);
        Q3 := Quartiles(2, 0.75, xrange * yrange, WholeTable);
        lReport.Add('Quartiles of the residuals: %8.3f and %.3f', [Q1, Q3]);
        Qrange2 := Q3 - Q1;
        lReport.Add('Original interquartile and final interquartile ranges: %8.3f and %.3f', [Qrange1, Qrange2]);
        if QRange1 <> 0 then
          lReport.Add('Quality of the additive fit: %8.3f %%', [100 * (QRange1 - QRange2) / QRange1]);
      end;
    end; // while not done

    DisplayReport(lReport);

//   if ItersBtn.Checked then
//   begin
    TwoWayPlot(xrange, RowEffects,'Rows','CUMULATIVE ROW EFFECTS');
    TwoWayPlot(yrange, ColEffects,'Columns','CUMULATIVE COL. EFFECTS');
    InteractPlot(xrange, yrange, ObsTable, 'Interaction', 'RESIDUALS OF ROWS AND COLUMNS');
//   end;
  finally
    lReport.Free;
    ColEffects := nil;
    RowEffects := nil;
    WholeTable := nil;
    CumColResiduals := nil;
    CumRowResiduals := nil;
    ObsTable := nil;
    ColMedian := nil;
    RowMedian := nil;
    GroupScores := nil;
    CellCount := nil;
    ColResiduals := nil;
    RowResiduals := nil;
    Residuals := nil;
    Observed := nil;
    ColNoSelected := nil;
  end;
end;

procedure TMedianPolishForm.DepInClick(Sender: TObject);
var
  index: integer;
begin
  index := VarList.ItemIndex;
  if (index > -1) and (DepVar.Text = '') then
  begin
     DepVar.Text := VarList.Items[index];
     VarList.Items.Delete(index);
     UpdateBtnStates;
  end;
end;

procedure TMedianPolishForm.DepOutClick(Sender: TObject);
begin
  if DepVar.Text <> '' then
  begin
    VarList.Items.Add(DepVar.Text);
    DepVar.Text := '';
    UpdateBtnStates;
  end;
end;

procedure TMedianPolishForm.Fact1InClick(Sender: TObject);
var
  index: integer;
begin
  index := VarList.ItemIndex;
  if (index > -1) and (Factor1.Text = '') then
  begin
    Factor1.Text := VarList.Items[index];
    VarList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;

procedure TMedianPolishForm.Fact1OutClick(Sender: TObject);
begin
  if Factor1.Text <> '' then
  begin
    VarList.Items.Add(Factor1.Text);
    Factor1.Text := '';
    UpdateBtnStates;
  end;
end;

procedure TMedianPolishForm.Fact2InClick(Sender: TObject);
var
  index: integer;
begin
  index := VarList.ItemIndex;
  if (index > -1) and (Factor2.Text = '') then
  begin
    Factor2.Text := VarList.Items[index];
    VarList.Items.Delete(index);
    UpdateBtnStates;
  end;
end;

procedure TMedianPolishForm.Fact2OutClick(Sender: TObject);
begin
  if Factor2.Text <> '' then
  begin
    VarList.Items.Add(Factor2.Text);
    Factor2.Text := '';
    UpdateBtnStates;
  end;
end;

procedure TMedianPolishForm.FormActivate(Sender: TObject);
var
  w: Integer;
begin
  if FAutoSized then
    exit;

  w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
  ResetBtn.Constraints.MinWidth := w;
  ComputeBtn.Constraints.MinWidth := w;
  CloseBtn.Constraints.MinWidth := w;

  Panel1.Constraints.MinWidth := NormChk.Width * 2 - DepIn.Width div 2;
  Constraints.MinWidth := Width;
  Constraints.MinHeight := Height;

  FAutoSized := true;
end;

procedure TMedianPolishForm.FormCreate(Sender: TObject);
begin
  Assert(OS3MainFrm <> nil);
  if GraphFrm = nil then
    Application.CreateForm(TGraphFrm, GraphFrm);
end;

function TMedianPolishForm.Median(const X: DblDyneVec; ASize: integer): double;
var
  midpt: integer;
begin
  if ASize > 2 then
  begin
    midpt := ASize div 2;
    if odd(ASize) then
      Result := X[midPt]
    else
      Result := (X[midPt-1] + x[midPt]) / 2;
    {
    if 2 * midpt = ASize then  // even no. of values
      Result := (X[midpt-1] + X[midpt]) / 2
    else
      Result := X[midpt];  // odd no. of values
      }
  end
  else if ASize = 2 then
    Result := (X[0] + X[1]) / 2;
end;

procedure TMedianPolishForm.PrintObsTable(const ObsTable: DblDyneMat;
  NRows, NCols: integer; AReport: TStrings);
var
  outline: string;
  i, j: integer;
begin
  AReport.Add('Observed Data');
  AReport.Add('ROW            COLUMNS');

  outline := '  ';
  for i := 1 to NCols do
    outline := outline + Format('%10d', [i]);
  AReport.Add(outline);

  for i := 1 to NRows do
  begin
    outline := Format('%3d ', [i]);
    for j := 1 to ncols do
      outline := outline + Format('%9.3f ', [ObsTable[i-1, j-1]]);
    AReport.Add(outline);
  end;
end;

procedure TMedianPolishForm.PrintResults(const ObsTable: DblDyneMat;
  const RowMedian, RowResid, ColMedian, ColResid: DblDyneVec;
  NRows, NCols: integer; AReport: TStrings);
var
  i, j: integer;
  outline: string;
begin
  AReport.Add('Adjusted Data');
  outline := 'MEDIAN';
  for i := 1 to NCols do
    outline := outline + Format('%10d',[i]);
  outline := outline + '     Residuals';
  AReport.Add(outline);

  AReport.Add('---------------------------------------------------------');

  for i := 0 to NRows-1 do
  begin
    outline := Format('%9.3f ', [rowmedian[i]]);
    for j := 0 to NCols-1 do
      outline := outline + Format('%9.3f ', [ObsTable[i,j]]);
    AReport.Add(outline + Format('%9.3f ', [RowResid[i]]));
  end;

  AReport.Add('---------------------------------------------------------');

  outline := 'Col.Resid.';
  for j := 0 to NCols-1 do
    outline := outline + Format('%9.3f ', [ColResid[j]]);
  AReport.Add(outline);

  outline := 'Col.Median';
  for j := 0 to NCols-1 do
    outline := outline + Format('%9.3f ', [ColMedian[j]]);
  AReport.Add(outline);
  AReport.Add('');

  AReport.Add('Cumulative absolute value of Row Residuals');
  for j := 0 to NRows-1 do
    AReport.Add('Row %3d:  Cum.Residuals: %9.3f', [j+1, CumRowResiduals[j]]);
  AReport.Add('');

  AReport.Add('Cumulative absolute value of Column Residuals');
  for j := 0 to NCols-1 do
    AReport.Add('Column %3d:  Cum.Residuals: %9.3f', [j+1, CumColResiduals[j]]);
end;

procedure TMedianPolishForm.SortValues(const X: DblDyneVec; ASize: integer);
var
  i, j: integer;
begin
  for i := 0 to ASize-2 do
    for j := i+1 to ASize-1 do
      if X[i] > X[j] then // swap
        Exchange(X[i], X[j]);
end;

procedure TMedianPolishForm.TwoWayPlot(NF1cells: integer;
  const RowSums: DblDyneVec; const AGraphTitle, AHeading: string);
var
  i: integer;
  minmean, maxmean: double;
begin
  GraphFrm.SetLabels[1] := 'Group';

  SetLength(GraphFrm.Xpoints, 1, NF1cells);
  SetLength(GraphFrm.Ypoints, 1, NF1cells);
  maxmean := -1E308;
  minmean := 1E308;
  for i := 0 to NF1cells - 1 do
  begin
    GraphFrm.XPoints[0, i] := i + 1;
    GraphFrm.YPoints[0, i] := RowSums[i];
    if RowSums[i] > maxMean then maxMean := RowSums[i];
    if RowSums[i] < minMean then minMean := RowSums[i];
  end;
  {
  for i := 1 to NF1cells do
  begin
    GraphFrm.Xpoints[0,i-1] := i;
    GraphFrm.Ypoints[0,i-1] := RowSums[i-1];
    if RowSums[i-1] > maxmean then maxmean := RowSums[i-1];
    if RowSums[i-1] < minmean then minmean := RowSums[i-1];
  end;
  }

  GraphFrm.NoSets := 1;
  GraphFrm.NBars := NF1cells;
  GraphFrm.Heading := AHeading;
  GraphFrm.XTitle := AGraphTitle;
  GraphFrm.YTitle := 'Y Values';
  GraphFrm.BarWideProp := 0.5;
  GraphFrm.AutoScaled := false;
  GraphFrm.miny := minmean;
  GraphFrm.maxy := maxmean;
  GraphFrm.GraphType := 2;
  GraphFrm.BackColor := GRAPH_BACK_COLOR;
  GraphFrm.WallColor := GRAPH_WALL_COLOR;
  GraphFrm.FloorColor := GRAPH_WALL_COLOR;
  GraphFrm.ShowBackWall := true;

  GraphFrm.ShowModal;

  GraphFrm.Xpoints := nil;
  GraphFrm.Ypoints := nil;
end;

procedure TMedianPolishForm.InteractPlot(NF1cells, NF2Cells: integer;
  const ObsTable: DblDyneMat; const AGraphTitle, AHeading: string);
var
  i, j: integer;
  minmean, maxmean, XBar: double;
begin
  SetLength(GraphFrm.Ypoints, NF1cells, NF2cells);
  SetLength(GraphFrm.Xpoints,1, NF2cells);

  maxmean := -1e308;
  minmean := 1e308;
  for i := 0 to NF1Cells-1 do
  begin
    GraphFrm.SetLabels[i+1] := 'Row ' + IntToStr(i+1);
    for j := 0 to NF2Cells - 1 do
    begin
      xbar := ObsTable[i, j];
      if xbar > maxMean then maxMean := xbar;
      if xbar < minMean then minMean := xbar;
      GraphFrm.YPoints[i, j] := xbar;
    end;
  end;
  for j := 0 to NF2cells-1 do
    GraphFrm.XPoints[0, j] := j+1;

  {
  for i := 1 to NF1cells do
  begin
    GraphFrm.SetLabels[i] := 'Row ' + IntToStr(i);
    for j := 1 to NF2cells do
    begin
      XBar := ObsTable[i-1,j-1];
      if XBar > maxmean then maxmean := XBar;
      if XBar < minmean then minmean := XBar;
      GraphFrm.Ypoints[i-1,j-1] := XBar;
    end;
  end;
  for j := 1 to NF2cells do
  begin
    XValue[j-1] := j;
    GraphFrm.Xpoints[0,j-1] := XValue[j-1];
  end;
  }

  GraphFrm.nosets := NF1cells;
  GraphFrm.nbars := NF2cells;
  GraphFrm.Heading := 'Factor X x Factor Y';
  GraphFrm.XTitle := 'Column Codes';
  GraphFrm.YTitle := 'Mean';
  GraphFrm.barwideprop := 0.5;
  GraphFrm.AutoScaled := false;
  GraphFrm.miny := minmean;
  GraphFrm.maxy := maxmean;
  GraphFrm.GraphType := 2;
  GraphFrm.BackColor := GRAPH_BACK_COLOR;
  GraphFrm.WallColor := GRAPH_WALL_COLOR;
  GraphFrm.FloorColor := GRAPH_FLOOR_COLOR;
  GraphFrm.ShowBackWall := true;

  GraphFrm.ShowModal;

  GraphFrm.Xpoints := nil;
  GraphFrm.Ypoints := nil;
end;

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

procedure TMedianPolishForm.UpdateBtnStates;
begin
  DepIn.Enabled := (VarList.ItemIndex > -1) and (DepVar.Text = '');
  Fact1In.Enabled := (VarList.itemIndex > -1) and (Factor1.Text = '');
  Fact2In.Enabled := (VarList.ItemIndex > -1) and (Factor2.Text = '');
  DepOut.Enabled := (DepVar.Text <> '');
  Fact1Out.Enabled := (Factor1.Text <> '');
  Fact2Out.Enabled := (Factor2.Text <> '');
end;


initialization
  {$I medianpolishunit.lrs}

end.