(***********************************
*  Pezykład demonstrujący          *
*  Eliminację Gaussa               *
*  www.algorytm.org                *
*  Andrzej Borucki                 *
*  Kontakt:                        *
*  borucki_andrzej (małpka) wp.pl  *
************************************)
{$J+} // Assignable typed constants
unit GaussUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, ComCtrls, Spin, Menus,
  Recording;

const
  WM_CALLRECORDING = WM_USER + 1;

type
  TRestoreKind = (rkNone, rkCell, rkTwoRows, rkTwoColumns);

  TRestore = class
    Kind: TRestoreKind;
    Col, Row: integer;
    WholeRow1, WholeRow2: integer;
    WholeCol1, WholeCol2: integer;
  end;

  TGaussForm = class(TForm)
    StringGrid: TStringGrid;
    Memo: TMemo;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label3: TLabel;
    Label1: TLabel;
    btnCalculate: TButton;
    spinSize: TSpinEdit;
    btnClear: TButton;
    btnGenerate: TButton;
    btnInteresting: TButton;
    TabSheet2: TTabSheet;
    btnPrior: TBitBtn;
    btnNext: TBitBtn;
    btnLast: TBitBtn;
    TrackBar1: TTrackBar;
    spinCommand: TSpinEdit;
    MainMenu1: TMainMenu;
    Goto1: TMenuItem;
    miFirst: TMenuItem;
    miPrior: TMenuItem;
    miNext: TMenuItem;
    miLast: TMenuItem;
    comboMode: TComboBox;
    TabSheet3: TTabSheet;
    btnBreak: TButton;
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    btnFirst: TBitBtn;
    cbAutoShiftBack: TCheckBox;
    miOptions: TMenuItem;
    Label5: TLabel;
    edMemory: TEdit;
    btnNumberEqAsInit: TSpeedButton;
    btnModeAsInit: TSpeedButton;
    miAbout: TMenuItem;
    procedure btnCalculateClick(Sender: TObject);
    procedure btnGenerateClick(Sender: TObject);
    procedure StringGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnClearClick(Sender: TObject);
    procedure StringGridSetEditText(Sender: TObject; ACol, ARow: integer;
      const Value: String);
    procedure ListView1Edited(Sender: TObject; Item: TListItem; var S: String);
    procedure btnInterestingClick(Sender: TObject);
    procedure TabSheet2Resize(Sender: TObject);
    procedure comboModeChange(Sender: TObject);
    procedure btnPriorClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure miPriorClick(Sender: TObject);
    procedure miNextClick(Sender: TObject);
    procedure TabSheet2Show(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure spinCommandChange(Sender: TObject);
    procedure spinCommandKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnFirstClick(Sender: TObject);
    procedure miFirstClick(Sender: TObject);
    procedure miLastClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGridDrawCell(Sender: TObject; ACol, ARow: integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormDestroy(Sender: TObject);
    procedure spinSizeChange(Sender: TObject);
    procedure spinSizeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TabSheet1Show(Sender: TObject);
    procedure spinSizeExit(Sender: TObject);
    procedure spinCommandExit(Sender: TObject);
    procedure miOptionsClick(Sender: TObject);
    procedure cbAutoShiftBackClick(Sender: TObject);
    procedure btnBreakClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure spinCommandKeyPress(Sender: TObject; var Key: Char);
    procedure spinSizeKeyPress(Sender: TObject; var Key: Char);
    procedure btnNumberEqAsInitClick(Sender: TObject);
    procedure btnModeAsInitClick(Sender: TObject);
    procedure miAboutClick(Sender: TObject);
  private
    computation_time: real;
    spinCommandKey: Word;
    spinCommandSav: integer;
    spinDimKey: Word;
    spinSizeSav: integer;
    TrackBarSav: integer;
    LastComboIndex: integer;
    Restore: TRestore;
    procedure WMCallRecording(var Message: TMessage);
    message WM_CALLRECORDING;
    procedure time_measurement(mode: TCalcMode);
    procedure print_results(mode: TCalcMode);
    procedure EnableDisableCommands;
    function trackStride: integer;
    procedure UpdateTrack;
    procedure RealChangeSpinCommand;
    procedure UpdateSpin;
    procedure CallRecording;
    procedure Colorize;
    procedure CheckBigEps();
  public
    bBreak: boolean;
    procedure SetGridSize;
    procedure ArraysToGrid;
    procedure GridToArrays;
    procedure Calculate(mode: TCalcMode);
    procedure CalculateAndRecord(mode: TCalcMode);
  end;

var
  GaussForm: TGaussForm;

implementation

uses
  Math,
{$IFDEF FPC}
  JwaPsApi, JwaTlHelp32,
{$ELSE}
  PsAPI, TlHelp32,
{$ENDIF}
  listUnit, addUnit, OptionsUnit, AboutUnit;
{$R *.dfm}

procedure TGaussForm.GridToArrays;
var
  i, j: integer;
begin
  with model do
    for i := 0 to Size - 1 do
      for j := 0 to Size - 1 do
        A[i, j] := StrToFloatDef(pdsep(StringGrid.Cells[j + 1, i + 1]), 0);
  with model do
    for i := 0 to Size - 1 do
      b[i] := StrToFloatDef(pdsep(StringGrid.Cells[Size + 1, i + 1]), 0);
end;

procedure swap_rows(first, second: integer);
var
  tmp: float;
  i: integer;
begin
  with model do
  begin
    for i := 0 to Size - 1 do
    begin
      tmp := A[first, i];
      A[first, i] := A[second, i];
      A[second, i] := tmp;
    end;
    tmp := b[first];
    b[first] := b[second];
    b[second] := tmp;
  end;
end;

procedure swap_columns(first, second: integer);
var
  tmp: float;
  i: integer;
begin
  with model do
    for i := 0 to Size - 1 do
    begin
      tmp := A[i, first];
      A[i, first] := A[i, second];
      A[i, second] := tmp;
    end;
end;

function CheckRank(model: TModel): boolean;
var
  i: integer;
begin
  result := true;
  for i := model.Size - 1 downto 0 do
    if Abs(model.A[model.Size - 1, i]) > Opt.Eps then
      exit;
  result := false;
  model.isRankLess := not result;
end;

procedure TGaussForm.Calculate(mode: TCalcMode);
var
  r, S: integer;
  i, j: integer;
  start: integer;
  found: boolean;
  l: float;
  k: integer;
  sum: float;
  AbsV, Max_i1, Max_ij: float;
begin
  model.otherException := false;
  model.isRankLess := false;
  model.isSingular := false;
  model.hasZeroOnDiagonal := false;
  model.Results.is_calculated := false;
  with model do
    for start := 0 to Size - 2 do
    begin
      S := start;
      r := start;
      found := false;
      case mode of
        cmSimple:
          found := A[start, start] <> 0;
        cmZero:
          for r := start to Size - 1 do
            if A[r, start] <> 0 then
            begin
              found := true;
              break;
            end;
        cmEps:
          for r := start to Size - 1 do
            if Abs(A[r, start]) > Opt.Eps then
            begin
              found := true;
              break;
            end;
        cmPartialPivot:
          begin
            Max_i1 := NegInfinity;
            for i := start to Size - 1 do
            begin
              AbsV := Abs(A[i, start]);
              if AbsV > Max_i1 then
              begin
                Max_i1 := AbsV;
                r := i;
              end;
            end;
            if Max_i1 > Opt.Eps then
              found := true;
          end;
        cmCompletePivot:
          begin
            Max_ij := NegInfinity;
            for i := start to Size - 1 do
              for j := start to Size - 1 do
              begin
                AbsV := Abs(A[i, j]);
                if AbsV > Max_ij then
                begin
                  Max_ij := AbsV;
                  r := i;
                  S := j;
                end;
              end;
            if Max_ij > Opt.Eps then
              found := true;
          end;
      end;
      if not found then
      begin
        if mode = cmSimple then
          hasZeroOnDiagonal := true
        else
          isSingular := true;
        exit;
      end;
      if r <> start then
        swap_rows(start, r);
      if S <> start then
      begin
        swap_columns(start, S);
        Assert(model.Results.swaps[start] = 0);
        model.Results.swaps[start] := S;
      end;
      // it is called n-1 times
      for i := start + 1 to Size - 1 do
      begin
        // it is called n(n-1)/2 times
        l := A[i, start] / A[start, start];
        for j := start to Size - 1 do
        begin
          // it is called n(n*n-1)/3 times
          A[i, j] := A[i, j] - l * A[start, j];
        end;
        b[i] := b[i] - l * b[start];
      end;
    end;
  { results calculation }
  if not CheckRank(model) then
    exit;
  try
    with model, model.Results do
      for i := Size - 1 downto 0 do
      begin
        sum := 0;
        for k := i + 1 to Size - 1 do
          sum := sum + A[i, k] * calculated[k];
        calculated[i] := (b[i] - sum) / A[i, i];
      end;
  except
    model.otherException := true;
  end;
  model.Results.is_calculated := true;
end;

function GetCurrentProcessMemory: Dword;
var
  PMC: _PROCESS_MEMORY_COUNTERS;
begin
  PMC.cb := sizeof(PMC);
  if not GetProcessMemoryInfo(GetCurrentProcess, {$IFNDEF FPC}@
    {$ENDIF} PMC, sizeof(PMC)) then
    raise Exception.Create('Error GetProcessMemoryInfo');
  result := PMC.WorkingSetSize;
end;

procedure TGaussForm.CalculateAndRecord(mode: TCalcMode);
var
  start: integer;
  r, S: integer;
  i, j: integer;
  l: float;
  found: boolean;
  AbsV, Max_i1, Max_ij: float;
  counter: integer;
  CountAll: int64;
  ticks, prevticks: Dword;
begin
  edMemory.Text := Format('%.2n', [GetCurrentProcessMemory() / (1024 * 1024)]);
  prevticks := GetTickCount();
  counter := 0;
  model.CommandProcessor.Clear;
  CountAll := model.Size * (model.Size * model.Size - 1) div 3;
  ProgressBar1.Max := CountAll div (256 * 256);
  with model do
    for start := 0 to Size - 2 do
    begin
      S := start;
      r := start;
      found := false;
      case mode of
        cmSimple:
          found := A[start, start] <> 0;
        cmZero:
          for r := start to Size - 1 do
            if A[r, start] <> 0 then
            begin
              found := true;
              break;
            end;
        cmEps:
          for r := start to Size - 1 do
            if Abs(A[r, start]) > Opt.Eps then
            begin
              found := true;
              break;
            end;
        cmPartialPivot:
          begin
            Max_i1 := NegInfinity;
            for i := start to Size - 1 do
            begin
              AbsV := Abs(A[i, start]);
              if AbsV > Max_i1 then
              begin
                Max_i1 := AbsV;
                r := i;
              end;
            end;
            if Max_i1 > Opt.Eps then
              found := true;
          end;
        cmCompletePivot:
          begin
            Max_ij := NegInfinity;
            for i := start to Size - 1 do
              for j := start to Size - 1 do
              begin
                AbsV := Abs(A[i, j]);
                if AbsV > Max_ij then
                begin
                  Max_ij := AbsV;
                  r := i;
                  S := j;
                end;
              end;
            if Max_ij > Opt.Eps then
              found := true;
          end;
      end;
      if not found then
      begin
        if mode = cmSimple then
          hasZeroOnDiagonal := true
        else
          isSingular := true;
        exit;
      end;
      if r <> start then
        CommandProcessor.Execute(TSwapRows.Create(model, start, r));
      if S <> start then
        CommandProcessor.Execute(TSwapColumns.Create(model, start, S));
      for i := start + 1 to Size - 1 do
      begin
        l := A[i, start] / A[start, start];
        for j := start to Size - 1 do
        begin
          inc(counter);
          if counter and (256 * 256 - 1) = 0 then
          begin
            ticks := GetTickCount();
            if ticks - prevticks >= 100 then
            begin
              edMemory.Text := Format
                ('%.2n', [GetCurrentProcessMemory() / (1024 * 1024)]);
              edMemory.Repaint();
              ProgressBar1.Position := counter div (256 * 256);
              Application.ProcessMessages();
              if bBreak then
                exit;
              prevticks := ticks;
            end;
          end;
          // model.FA[i,j]:=model.FA[i,j]-l*model.FA[start,j];
          CommandProcessor.Execute
            (TSetA.Create(model, i, j, A[i, j] - l * A[start, j]));
        end;
        // model.Fb[i]:=model.Fb[i]-l*model.Fb[start];
        CommandProcessor.Execute(TSetB.Create(model, i, b[i] - l * b[start]));
      end;
    end;
end;

procedure TGaussForm.SetGridSize;
var
  i, j: integer;
begin
  StringGrid.ColCount := model.Size + 2;
  StringGrid.RowCount := model.Size + 1;
  StringGrid.Col := 1;
  StringGrid.Row := 1;
  for j := 0 to model.Size - 1 do
    StringGrid.Cells[j + 1, 0] := 'x' + IntToStr(j);
  for i := 0 to model.Size - 1 do
    StringGrid.Cells[0, i + 1] := 'equation ' + IntToStr(i);
  StringGrid.Cells[model.Size + 1, 0] := 'b';
end;

procedure TGaussForm.btnNumberEqAsInitClick(Sender: TObject);
begin
  Opt.InitSize := spinSize.Value;
  btnNumberEqAsInit.Enabled := false;
end;

procedure TGaussForm.btnModeAsInitClick(Sender: TObject);
begin
  Opt.InitMode := comboMode.ItemIndex+1;
  btnModeAsInit.Enabled := false;
end;

procedure TGaussForm.RealChangeSpinCommand;
begin
  spinCommand.OnChange := nil;
  if spinCommand.Value < spinCommand.MinValue then
    spinCommand.Value := spinCommand.MinValue;
  if spinCommand.Value > spinCommand.MaxValue then
    spinCommand.Value := spinCommand.MaxValue;
  model.CommandProcessor.Seek(spinCommand.Value - 1);
  ArraysToGrid;
  Memo.Lines.Add(model.CommandProcessor.Describe());
  EnableDisableCommands;
  UpdateTrack;
  spinCommand.OnChange := spinCommandChange;
end;

procedure TGaussForm.spinCommandChange(Sender: TObject);
var
  n: integer;
begin
  if not TryStrToInt(spinCommand.Text, n) then
    exit;
  if (spinCommandKey = 0) and (Abs(spinCommandSav - spinCommand.Value) = 1) then
    RealChangeSpinCommand;
  spinCommandSav := spinCommand.Value;
  spinCommandKey := 0;
end;

procedure TGaussForm.spinCommandExit(Sender: TObject);
begin
  RealChangeSpinCommand;
end;

// I want to distinguish between click up/down and edit
// is not perfect if select text
procedure TGaussForm.spinCommandKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then
  begin
    Key := 0;
    RealChangeSpinCommand;
    spinCommandKey := 0;
  end
  else
    spinCommandKey := Key;
end;

procedure TGaussForm.spinCommandKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    Key := #0;
end;

procedure TGaussForm.spinSizeChange(Sender: TObject);
var
  n: integer;
begin
  if not TryStrToInt(spinSize.Text, n) then
    exit;
  if (spinDimKey = 0) and (Abs(spinSizeSav - spinSize.Value) = 1) then
    btnClearClick(Sender);
  spinSizeSav := spinSize.Value;
  spinDimKey := 0;
end;

procedure TGaussForm.spinSizeExit(Sender: TObject);
begin
  btnClearClick(Sender);
end;

procedure TGaussForm.spinSizeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then
  begin
    Key := 0;
    btnClearClick(Sender);
    spinDimKey := 0;
  end
  else
    spinDimKey := Key;
end;

procedure TGaussForm.spinSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    Key := #0;
end;

procedure TGaussForm.CallRecording;
var
  count: integer;
begin
  TabSheet2.OnShow := nil;
  if model.Changed then
    model.Save;
  TabSheet3.Enabled := true;
  PageControl1.ActivePageIndex := 2;
  TabSheet1.Enabled := false;
  TabSheet2.Enabled := false;
  StringGrid.Enabled := false;
  try
    model.Reset;
    bBreak := false;
    CalculateAndRecord(TCalcMode(comboMode.ItemIndex));
  finally
    StringGrid.Enabled := true;
    TabSheet1.Enabled := true;
    TabSheet2.Enabled := true;
    PageControl1.ActivePageIndex := 1;
    TabSheet3.Enabled := false;
  end;
  count := model.CommandProcessor.CommandCount;
  Label2.Caption := Format('/%d', [count]);
  spinCommand.MaxValue := count;
  if cbAutoShiftBack.Checked then
    model.CommandProcessor.Seek(-1);
  ArraysToGrid;
  Memo.Lines.Add(model.CommandProcessor.Describe());
  EnableDisableCommands;
  UpdateSpin;
  UpdateTrack;
  TabSheet2.OnShow := TabSheet2Show;
end;

procedure TGaussForm.cbAutoShiftBackClick(Sender: TObject);
begin
  Opt.AutoShiftBack := cbAutoShiftBack.Checked;
end;

procedure TGaussForm.Colorize;
var
  idx1, idx2: integer;
  val1, val2: float;
  CommandClass: TClass;
  i: integer;
begin
  if Restore.Kind = rkCell then
    StringGrid.Objects[Restore.Col, Restore.Row] := TObject(0)
  else if Restore.Kind = rkTwoRows then
    for i := 0 to StringGrid.ColCount - 1 do
    begin
      StringGrid.Objects[i, Restore.WholeRow1] := TObject(0);
      StringGrid.Objects[i, Restore.WholeRow2] := TObject(0);
    end
    else if Restore.Kind = rkTwoColumns then
      for i := 0 to StringGrid.RowCount - 1 do
      begin
        StringGrid.Objects[Restore.WholeCol1, i] := TObject(0);
        StringGrid.Objects[Restore.WholeCol2, i] := TObject(0);
      end;

  CommandClass := model.CommandProcessor.GetPosition(idx1, idx2);
  if CommandClass = nil then
    exit;

  if CommandClass = TSetA then
  begin
    Restore.Kind := rkCell;
    Restore.Col := idx2 + 1;
    Restore.Row := idx1 + 1;
  end
  else if CommandClass = TSetB then
  begin
    Restore.Kind := rkCell;
    Restore.Col := model.Size + 1;
    Restore.Row := idx1 + 1;
  end
  else if CommandClass = TSwapRows then
  begin
    Restore.Kind := rkTwoRows;
    Restore.WholeRow1 := idx1 + 1;
    Restore.WholeRow2 := idx2 + 1;
  end
  else if CommandClass = TSwapColumns then
  begin
    Restore.Kind := rkTwoColumns;
    Restore.WholeCol1 := idx1 + 1;
    Restore.WholeCol2 := idx2 + 1;
  end;
  if (CommandClass = TSetA) or (CommandClass = TSetB) then
  begin
    model.CommandProcessor.GetValues(val1, val2);
    if Abs(val2 - val1) > Opt.Eps then
      StringGrid.Objects[Restore.Col, Restore.Row] := TObject(1)
    else
      StringGrid.Objects[Restore.Col, Restore.Row] := TObject(2);
  end
  else if CommandClass = TSwapRows then
    for i := 0 to StringGrid.ColCount - 1 do
    begin
      StringGrid.Objects[i, Restore.WholeRow1] := TObject(3);
      StringGrid.Objects[i, Restore.WholeRow2] := TObject(3);
    end
    else if CommandClass = TSwapColumns then
      for i := 0 to StringGrid.RowCount - 1 do
      begin
        StringGrid.Objects[Restore.WholeCol1, i] := TObject(4);
        StringGrid.Objects[Restore.WholeCol2, i] := TObject(4);
      end
end;

procedure TGaussForm.comboModeChange(Sender: TObject);
begin
  if (model.Size>0) and ((comboMode.ItemIndex <> LastComboIndex) or model.Changed) then
    CallRecording;
  LastComboIndex := comboMode.ItemIndex;
end;

procedure TGaussForm.btnClearClick(Sender: TObject);
var
  i, j: integer;
begin
  model.Size := StrToInt(spinSize.Text);
  spinSize.Text := IntToStr(model.Size);
  spinSize.Value := model.Size;
  try
    btnClear.Enabled := false;
    btnClear.Repaint;
    btnGenerate.Enabled := false;
    btnGenerate.Repaint;
    btnInteresting.Enabled := false;
    btnInteresting.Repaint;
    SetGridSize;
    StringGrid.SetFocus;
    model.Clear;
    with model do
      for i := 1 to Size do
        for j := 1 to Size + 1 do
          StringGrid.Cells[j, i] := '';
    with model do
      for i := 0 to Size do
        for j := 0 to Size + 1 do
          StringGrid.Objects[j, i] := nil;
  finally
    btnClear.Enabled := true;
    btnGenerate.Enabled := true;
    btnInteresting.Enabled := true;
  end;
  btnNumberEqAsInit.Enabled := spinSize.Value <> Opt.InitSize;
end;

procedure TGaussForm.CheckBigEps();
  function NumberVisible: boolean;
  var
    i, j: integer;
    rowVisible, colVisible: integer;
    H, W: integer;
  begin
    H := 0;
    rowVisible := 0;
    while rowVisible < StringGrid.RowCount do
    begin
      inc(H, StringGrid.RowHeights[rowVisible] + 1);
      inc(rowVisible);
      if H >= StringGrid.Height then
      begin
        if rowVisible > 2 then
          dec(rowVisible);
        break;
      end;
    end;
    W := 0;
    colVisible := 0;
    while colVisible < StringGrid.ColCount do
    begin
      inc(W, StringGrid.ColWidths[colVisible] + 1);
      inc(colVisible);
      if W >= StringGrid.Height then
      begin
        if colVisible > 2 then
          dec(colVisible);
        break;
      end;
    end;
    result := true;
    for i := 1 to rowVisible - 1 do
      for j := 1 to colVisible - 1 do
        if StringGrid.Cells[j, i] <> '' then
          exit;
    result := false;
  end;

begin
  if (Opt.Eps >= 0.01) and Opt.HideZero and Opt.AlsoEps and not NumberVisible()
    then
  begin
    MessageDlg('Cells empty because hide elems<=Eps; Eps=' + FloatToStr(Opt.Eps)
        , mtWarning, [mbOK], 0);
    OptionsForm.ShowModal;
  end;
end;

procedure TGaussForm.btnGenerateClick(Sender: TObject);
var
  i, j: integer;
begin
  btnGenerate.Enabled := false;
  try
    model.Size := StrToInt(spinSize.Text);
    SetGridSize;
    StringGrid.SetFocus;
    model.Generate();
    ArraysToGrid;
    with model do
      for i := 0 to Size do
        for j := 0 to Size + 1 do
          StringGrid.Objects[j, i] := nil;
    CheckBigEps();
  finally
    btnGenerate.Enabled := true;
  end;
end;

procedure TGaussForm.btnFirstClick(Sender: TObject);
begin
  model.CommandProcessor.Seek(-1);
  Colorize();
  ArraysToGrid;
  Memo.Lines.Add(model.CommandProcessor.Describe());
  EnableDisableCommands;
  UpdateSpin;
  UpdateTrack;
end;

function MeanSquareError(): real;
var
  i: integer;
begin
  result := 0;
  for i := 0 to model.Size - 1 do
    result := result + Sqr(model.Results.calculated[i] - model.Results.exact[i]
      );
  result := sqrt(result / model.Size);
end;

function format_computation_time(computation_time: real): string;
begin
  if computation_time < 0.001 then
    result := Format('czas= %.4g us', [computation_time * 1E6])
  else if computation_time < 1 then
    result := Format('czas= %.4g ms', [computation_time * 1000])
  else
    result := Format('czas= %.4g s', [computation_time])
end;

procedure TGaussForm.print_results(mode: TCalcMode);
var
  i: integer;
begin
  model.Results.RestoreOrder;
  if (mode = cmSimple) and model.hasZeroOnDiagonal then
  begin
    Memo.Lines.Add('Matrix has a zero on diagonal - no results');
    Memo.Lines.Add('mean squared error = ???');
  end
  else if model.isSingular then
  begin
    Memo.Lines.Add('Matrix is singular - no results');
    Memo.Lines.Add('mean squared error = ???');
  end
  else if model.isRankLess then
  begin
    Memo.Lines.Add('Matrix rank is < n - no results');
    Memo.Lines.Add('mean squared error = ???');
  end
  else if model.otherException then
  begin
    Memo.Lines.Add('Other exception during computing results');
    Memo.Lines.Add('mean squared error = ???');
  end
  else
  begin
    for i := 0 to model.Size - 1 do
      Memo.Lines.Add(Format('%d: %g', [i, model.Results.calculated[i]]));
    if model.Results.existsExact then
      Memo.Lines.Add(Format('mean squared error = %g', [MeanSquareError()]))
  end;
  Memo.Lines.Add(format_computation_time(computation_time));
end;

procedure TGaussForm.miPriorClick(Sender: TObject);
begin
  btnPriorClick(Sender);
end;

procedure TGaussForm.time_measurement(mode: TCalcMode);
  procedure Reset;
  var
    i: integer;
  begin
    model.Reset;
    FillChar(model.Results.swaps[0], Length(model.Results.swaps) * sizeof
        (model.Results.swaps[0]), 0)
  end;

var
  i64a, i64b, i64f: int64;
  queryTime, time: int64;
  i, ilosc_petli: integer;
begin
  QueryPerformanceCounter(i64a);
  Reset;
  QueryPerformanceCounter(i64b);
  queryTime := i64b - i64a;
  QueryPerformanceCounter(i64a);
  Reset;
  Calculate(mode);
  QueryPerformanceCounter(i64b);
  time := i64b - i64a - queryTime;
  if time < 10 * 1000 then
  begin
    ilosc_petli := 10 * 1000 div Max(time, 1);
    QueryPerformanceCounter(i64a);
    for i := 1 to ilosc_petli do
      Reset;
    QueryPerformanceCounter(i64b);
    queryTime := i64b - i64a;
    QueryPerformanceCounter(i64a);
    for i := 1 to ilosc_petli do
    begin
      Reset;
      Calculate(mode);
    end;
    QueryPerformanceCounter(i64b);
    time := i64b - i64a - queryTime;
  end
  else
    ilosc_petli := 1;
  QueryPerformanceFrequency(i64f);
  computation_time := time / i64f / ilosc_petli;
end;

procedure TGaussForm.btnBreakClick(Sender: TObject);
begin
  bBreak := true;
end;

procedure TGaussForm.btnCalculateClick(Sender: TObject);
var
  tryb: TCalcMode;
begin
  if Length(model.A) = 0 then
    exit;
  if model.Changed then
    model.Save;
  Memo.Clear;
  for tryb := cmSimple to cmCompletePivot do
  begin
    case tryb of
      cmSimple:
        Memo.Lines.Add('mode: without exchange lines');
      cmZero:
        Memo.Lines.Add('mode: exchange when zero');
      cmEps:
        Memo.Lines.Add('mode: exchange when <=eps');
      cmPartialPivot:
        Memo.Lines.Add('partial pivoting');
      cmCompletePivot:
        Memo.Lines.Add('complete pivoting');
    end;
    time_measurement(tryb);
    print_results(tryb);
    Memo.Lines.Add('');
  end;
  if AddForm.EmptyResults then
    AddForm.FillGrid(model.Size, model.Results.calculated);
end;

procedure TGaussForm.ArraysToGrid;
var
  i, j: integer;
  EpsZero: float;
begin
  if Opt.AlsoEps then
    EpsZero := Opt.Eps
  else
    EpsZero := 0;
  with model do
    for i := 0 to Size - 1 do
      for j := 0 to Size - 1 do
        if Opt.HideZero and (Abs(A[i, j]) <= EpsZero) then
          StringGrid.Cells[j + 1, i + 1] := ''
        else
          StringGrid.Cells[j + 1, i + 1] := Format(Opt.FormatStr, [A[i, j]]);
  with model do
    for i := 0 to Size - 1 do
      if Opt.HideZero and (Abs(b[i]) <= EpsZero) then
        StringGrid.Cells[Size + 1, i + 1] := ''
      else
        StringGrid.Cells[Size + 1, i + 1] := Format(Opt.FormatStr, [b[i]]);
end;

procedure TGaussForm.StringGridDrawCell(Sender: TObject; ACol, ARow: integer;
  Rect: TRect; State: TGridDrawState);
begin
  with (Sender as TStringGrid) do
    with Canvas do
    begin
      if gdFixed in State then
      begin
        case integer(StringGrid.Objects[ACol, ARow]) of
          0, 1, 2:
            Brush.Color := clBtnFace;
          3:
            Brush.Color := TColor($9090D0);
          4:
            Brush.Color := TColor($90D0D0);
        end;
      end
      else
        case integer(StringGrid.Objects[ACol, ARow]) of
          0:
            Brush.Color := clWindow;
          1:
            Brush.Color := clLime;
          2:
            Brush.Color := clAqua;
          3:
            Brush.Color := TColor($A0A0FF);
          4:
            Brush.Color := TColor($90FFFF);
        end;
      FillRect(Rect);
      if gdFocused in State then
        Rectangle(Rect);
      Font.Color := clWindowText;
      TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
    end;
end;

procedure TGaussForm.StringGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    spinSize.SetFocus;
end;

procedure TGaussForm.StringGridSetEditText
  (Sender: TObject; ACol, ARow: integer; const Value: String);
begin
  model.Results.existsExact := false;
  model.Results.is_calculated := false;
  GridToArrays();
  model.Change();
end;

function TGaussForm.trackStride: integer;
begin
  result := Max(8 * model.CommandProcessor.CommandCount div TrackBar1.Width, 1);
end;

procedure TGaussForm.UpdateTrack;
var
  t: integer;
begin
  t := trackStride();
  TrackBar1.OnChange := nil;
  TrackBar1.Max := (model.CommandProcessor.CommandCount + t - 1) div t;
  TrackBar1.Position := (model.CommandProcessor.CurrentCommand + t - 1)
    div t + 1;
  TrackBarSav := TrackBar1.Position;
  TrackBar1.OnChange := TrackBar1Change;
end;

procedure TGaussForm.WMCallRecording(var Message: TMessage);
begin
  CallRecording;
end;

procedure TGaussForm.UpdateSpin;
begin
  spinCommand.OnChange := nil;
  spinCommand.Value := model.CommandProcessor.CurrentCommand + 1;
  spinCommand.OnChange := spinCommandChange;
end;

procedure TGaussForm.TrackBar1Change(Sender: TObject);
var
  CommandPos: integer;
begin
  if TrackBar1.Position = TrackBarSav then
    exit;
  TrackBarSav := TrackBar1.Position;
  CommandPos := Min(TrackBar1.Position * trackStride(),
    model.CommandProcessor.CommandCount) - 1;
  model.CommandProcessor.Seek(CommandPos);
  Memo.Lines.Add(model.CommandProcessor.Describe());
  ArraysToGrid;
  EnableDisableCommands;
  UpdateSpin;
end;

procedure TGaussForm.TabSheet1Show(Sender: TObject);
begin
  if spinSizeSav = 0 then
  begin
    spinSizeSav := spinSize.Value;
    btnClearClick(Sender);
  end;
end;

procedure TGaussForm.TabSheet2Resize(Sender: TObject);
begin
  UpdateTrack;
end;

procedure TGaussForm.TabSheet2Show(Sender: TObject);
begin
  spinCommandSav := spinCommand.Value;
  if (comboMode.ItemIndex >= 0) and ((comboMode.ItemIndex <> LastComboIndex)
      or model.Changed) then
    PostMessage(Handle, WM_CALLRECORDING, 0, 0);
  UpdateTrack;
end;

procedure TGaussForm.ListView1Edited(Sender: TObject; Item: TListItem;
  var S: String);
var
  equation: TEquation;
begin
  Assert(Item.Data <> nil);
  equation := Item.Data;
  equation.Title := S;
end;

procedure TGaussForm.miFirstClick(Sender: TObject);
begin
  btnFirstClick(Sender);
end;

procedure TGaussForm.miLastClick(Sender: TObject);
begin
  btnLastClick(Sender);
end;

procedure TGaussForm.miNextClick(Sender: TObject);
begin
  btnNextClick(Sender);
end;

procedure TGaussForm.miOptionsClick(Sender: TObject);
begin
  OptionsForm.ShowModal;
end;

procedure TGaussForm.btnInterestingClick(Sender: TObject);
begin
  ListForm.Show;
  if not ListForm.Loaded then
    ListForm.btnLoadClick(Sender);
end;

procedure TGaussForm.btnLastClick(Sender: TObject);
begin
  model.CommandProcessor.Seek(model.CommandProcessor.CommandCount - 1);
  Colorize();
  ArraysToGrid;
  Memo.Lines.Add(model.CommandProcessor.Describe());
  EnableDisableCommands;
  UpdateSpin;
  UpdateTrack;
end;

procedure TGaussForm.EnableDisableCommands;
begin
  btnPrior.Enabled := model.CommandProcessor.CanUndo;
  miPrior.Enabled := btnPrior.Enabled;
  btnFirst.Enabled := miPrior.Enabled;
  miFirst.Enabled := btnFirst.Enabled;

  btnNext.Enabled := model.CommandProcessor.CanRedo;
  miNext.Enabled := btnNext.Enabled;
  btnLast.Enabled := btnNext.Enabled;
  miLast.Enabled := btnLast.Enabled;
end;

procedure TGaussForm.FormActivate(Sender: TObject);
const
  Activated: boolean = false;
begin
  if not Activated then
    spinSize.Value := Opt.InitSize;
  Activated := true;
  comboMode.ItemIndex := Opt.InitMode-1;
end;

procedure TGaussForm.FormCreate(Sender: TObject);
begin
  LastComboIndex := -1;
  Restore := TRestore.Create;
end;

procedure TGaussForm.FormDestroy(Sender: TObject);
begin
  Restore.Free;
end;

procedure TGaussForm.btnNextClick(Sender: TObject);
begin
  model.CommandProcessor.Redo();
  Memo.Lines.Add(model.CommandProcessor.Describe());
  Colorize();
  ArraysToGrid;
  EnableDisableCommands;
  UpdateSpin;
  UpdateTrack;
end;

procedure TGaussForm.btnPriorClick(Sender: TObject);
begin
  model.CommandProcessor.Undo();
  Colorize();
  ArraysToGrid;
  Memo.Lines.Add(model.CommandProcessor.Describe());
  EnableDisableCommands;
  UpdateSpin;
  UpdateTrack;
end;

procedure TGaussForm.miAboutClick(Sender: TObject);
begin
  AboutForm.ShowModal;
end;

end.