Unit Algemeen;
{
Automated Balancing of Chemical Equations
=========================================
This software has been designed and it is
CopyLefted by Han de Bruijn:

                          (===)
                         @-O^O-@
                          #/_\#
                           ###

General purpose functions and structures
----------------------------------------
}
INTERFACE

Uses Breuken;

type
  matrix = array of array of integer;
  vektor = array of integer;
  Dmatrix = array of array of double;
  Dvektor = array of double;
  Bmatrix = array of array of breuk;
  Bvektor = array of breuk;

  onthou = record
    e : string[2]; { name of chemical element }
    L : integer; { length of element name (1 or 2) }
    p : integer; { position in short formula string }
    r : integer; { numbering of matrix rows }
    m : integer; { numbering of matrix columns }
    g : integer; { number of atoms in molecule }
  end;
  blok = array of onthou;

  twee = record
    p : integer; g : integer;
  end;
  dubbel = array of twee;
  element = array of string[2];

procedure Afdrukken(A : matrix; b : vektor);
procedure Parse_Numbers(regel : string; var getal : dubbel);
function Letterlijk(nr : integer) : string;
function vervang(S,deze,door : string) : string;
procedure TelSort(rij : element; var let :vektor);

function Faculteit(n : integer) : integer;
function Dijkstra(waarde : vektor; var teken : integer) : vektor;
procedure Edsger(N : integer);

IMPLEMENTATION

procedure Afdrukken(A : matrix; b : vektor);
{
  Printout
}
var
  i,j,N : integer;
begin
  N := Length(b);
  for i := 0 to N-1 do
  begin
    for j := 0 to N-1 do
    begin
      Write(' ',A[i,j]:4);
    end;
    Writeln(' | ',b[i]:4);
  end;
  Writeln;
end;

procedure Parse_Numbers(regel : string; var getal : dubbel);
{
  Find all natural numbers
  and positions in a string
}
var
  L,i,ng : integer;
  sep : boolean;
begin
  ng := -1;
  sep := true;
  L := Length(regel);
  SetLength(getal,L);
{ Main loop }
  for i := 1 to L do
  begin
  { No number information: }
    if not (regel[i] in ['0'..'9']) then
    begin
      sep := true ; Continue ;
    end;
  { Separate: }
    if sep then
    begin
      sep := false ; ng := ng + 1;
      getal[ng].g := 0; getal[ng].p := i;
    end;
  { Numbers: }
    getal[ng].g := 10*getal[ng].g + byte(regel[i]) - 48;
  end;
  SetLength(getal,ng+1);
end;

function Letterlijk(nr : integer) : string;
{
  Number to String
}
const
  cijfer : string = '0123456789';
var
  no,t,tel,wel : integer;
  vgl : string;
  c : char;
  min : boolean;
begin
  no := nr;
  min := false;
  if no < 0 then
  begin
    min := true;
    no := - nr;
  end;
  tel := 0;
{ Analysis }
  vgl := '';
  while no > 0 do
  begin
    c := cijfer[(no mod 10) + 1];
    vgl := vgl + c;
    no := no div 10;
    tel := tel + 1;
  end;
  wel := tel div 2;
  for t := 0 to wel-1 do
  begin
    c := vgl[t+1];
    vgl[t+1] := vgl[tel-t];
    vgl[tel-t] := c;
  end;
  if min then vgl := '-' + vgl;
  if vgl = '' then vgl := '0';
  Letterlijk := vgl;
end;

function vervang(S,deze,door : string) : string;
{
  Replace in string 'S'
  all 'deze' by 'door'
}
var
  i,L : integer;
  T : string;
begin
  T := S;
  while Pos(deze,T) > 0 do
  begin
    i := Pos(deze,T);
    L := length(deze);
    Delete(T,i,L);
    if Length(door) > 0 then
      Insert(door,T,i);
  end;
  vervang := T;
end;

procedure TelSort(rij : element; var let :vektor);
{
  Sorting by counting.
  Algorithm C on page 76 of "The Art of Computer Programming"
  volume 3 / "Sorting and Searching" by Donald E. Knuth
}
var
  veel, i,j,k,L : integer;
  tel : vektor;
begin
  veel := Length(rij)-1;
  SetLength(tel,veel+1);
  for k := 1 to veel do
    tel[k] := 0;

  for k := 0 to (veel-2) do
  begin
    i := veel - k;
    for L := 1 to (i-1) do
    begin
      j := i - L;
      if rij[i] < rij[j] then
         tel[j] := tel[j] + 1
      else
         tel[i] := tel[i] + 1;
    end;
  end;

  SetLength(let,veel+1);
  for k := 1 to veel do
    let[tel[k]+1] := k;
end;

function Dijkstra(waarde : vektor; var teken : integer) : vektor;
{
  Should produce a Permutation (waarde)
  in alphabetical (lexicographic) order.
  Start with the identical permutation.

  According to: E.W.Dijkstra,
  "A discipline of Programming",
  Prentice Hall, 1976
}
var
  i,j,N : integer;

  procedure Wissel(k,L : integer);
  var
    h : integer;
  begin
    h := waarde[L];
    waarde[L] := waarde[k];
    waarde[k] := h;
    teken := - teken;
  end;

begin
  N := Length(waarde);

  i := N-1;
  while (waarde[i-1] >= waarde[i]) do i := i-1;
  j := N;
  while (waarde[j-1] <= waarde[i-1]) do j := j-1;

  Wissel(i-1,j-1);
  i := i+1; j := N;

  while (i < j) do
  begin
    Wissel(i-1,j-1);
    i := i+1;
    j := j-1;
  end;

  Dijkstra := waarde;
end;

function Faculteit(n : integer) : integer;
{
  Factorial n!
}
var
  k,m : integer;
begin
  m := 1;
  for k := 2 to n do
    m := m*k;
  Faculteit := m;
end;

procedure Edsger(N : integer);
{
  Test Permutations
}
var
  orde,F,k,i,teken : integer;
  rij : vektor;

  function Extra : string;
  var
    s : string;
  begin
    s := '+ ';
    if teken < 0 then s := '- ';
    Extra := s;
  end;

begin
  orde := N;
  SetLength(rij,orde);
  F := Faculteit(orde);
  for i := 0 to orde-1 do
    rij[i] := i+1;
  teken := +1;
  for k := 1 to F do
  begin
    if k > 1 then
      rij := Dijkstra(rij,teken);
    Write(Extra);
    for i := 0 to orde-1 do
      Write(rij[i]:3);
    Writeln;
  end;
end;

END.