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

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

Convert Input to handsome Data structure
----------------------------------------
}
INTERFACE

Uses Algemeen;

function krimpen(lang : string; var kort : string) : boolean;
procedure ontleden(kort : string; var data : blok);

IMPLEMENTATION

function spelling(kort : string) : boolean;
{
  Syntax checking
}
var
  OK,goed : boolean;
  k,L,tel,soort : integer;
{ memo : integer; }
begin
  kort := '^'+kort+'$';
{ Equals sign only once }
  L := Length(kort);
  tel := 0;
  for k := 2 to L-1 do
    if kort[k] = '=' then tel := tel + 1;
  goed := (tel = 1);
  if (tel = 0) then
    Write(' no ..=..');
  if (tel > 1) then
    Write(' ..=..=..');
{ Parentheses in pairs 
  and left paren first }
  tel := 0;
  for k := 2 to L-1 do
  begin
    if kort[k] = '(' then tel := tel + 1;
    if kort[k] = ')' then tel := tel - 1;
    if tel < 0 then Break;
  end;
  if not (tel = 0) then
    Write(' no (..)');
  goed := goed and (tel = 0);

{ memo := 0 }
  OK := true;
  if goed then
  for k := 2 to L-1 do
  begin
  { if (kort[k] in ['A'..'Z']) then } soort := 0; { upper case }
    if (kort[k] in ['a'..'z']) then soort := 1; { lower case }
    if (kort[k] in ['0'..'9']) then soort := 2; { ciphers }
    if (kort[k] = '+') then soort := 3; { plus sign }
    if (kort[k] = '=') then soort := 4; { equals sign }
    if (kort[k] = '(') then soort := 5; { left parenthesis }
    if (kort[k] = ')') then soort := 6; { right parenthesis }

    case soort of
    0 : OK := not (kort[k-1] = ')');
    1 : OK := (kort[k-1] in ['A'..'Z'])
          and not (kort[k+1] in ['a'..'z']);
    2 : OK := not (kort[k-1] in ['(','+','=','^'])
          and not (kort[k+1] in ['a'..'z']);
    3,4 : OK := not (kort[k-1] in ['+','=','(',')','^'])
          and (kort[k+1] in ['A'..'Z','(']);
    5 : OK := not (kort[k-1] in ['(',')'])
          and (kort[k+1] in ['A'..'Z']);
    6 : OK := not (kort[k-1] in ['+','=','(',')','^'])
          and (kort[k+1] in ['0'..'9']);
    end;
    if not OK then Write(' '+Copy(kort,k-1,3));

  { memo := k; }
    if not OK then Break;
  end;

{ Writeln(kort);
  Writeln(memo:4,soort:4,OK); }
  Spelling := goed and OK;
end;

function krimpen(lang : string; var kort : string) : boolean;
{
  Crop input formula
  to bare essentials
}
var
  k,L : integer;
  c : char;
  OK : boolean;
begin
  lang := vervang(lang,'==','=');
  L := Length(lang);
  kort := '';
  for k := 1 to L do
  begin
    c := lang[k];
    OK := c in ['A'..'Z','a'..'z','0'..'9','+','=','(',')'];
    if not OK then Continue;
    kort := kort + c;
  end;
  krimpen := Spelling(kort);
end;
{
  data.
  e : name of chemical element
  p : position in short formula string
  L : length of element name (1 or 2)
  r : numbering of matrix rows
  m : numbering of matrix columns
  g : number of atoms in molecule
}
procedure volgorde(data : blok; var lok : vektor);
{
  Order elements
  alphabetically
}
var
  i,k : integer;
  hulp : element;
  let : vektor;
begin
  i := Length(data);
  SetLength(hulp,i+1);
  SetLength(lok,i);
  for k := 0 to i-1 do
    hulp[k+1] := data[k].e;
  TelSort(hulp,let);
  for k := 0 to i-1 do
    lok[k] := let[k+1]-1;
end;

procedure ontleden(kort : string; var data : blok);
{
  Analyse cropped formula string
  and convert it to handsome data
}
var
  L,k,i,p,q,r,j : integer;
  ng,waarde : integer;
  mol,haak,lok : vektor;
  getal : dubbel;
  vullen : boolean;
  vgl : string[2];
begin
  L := Length(kort);
  Setlength(data,L);
{ Avoid end of line }
  kort := kort + '$';

{ Where are the molecules }
  SetLength(mol,L);
  i := 1;
  for k := 1 to L do
  begin
    mol[k-1] := i;
    if (kort[k] in ['+','=']) then
      i := i + 1;
  end;
  for k := 1 to L do
    if (kort[k] in ['+','=']) then
      mol[k-1] := 0;

  i := 0;
{ Names of chemical elements }
  for k := 1 to L do
  begin
    vgl := Copy(kort,k,2);
    if not (vgl[1] in ['A'..'Z']) then Continue;
  { consisting of one upper case letter }
    if not (vgl[2] in ['a'..'z']) then
    begin
      data[i].e := vgl[1] + ' '; { Name }
      data[i].L := 1; { Name length }
  { consisting of upper case and lower case }
    end else if (vgl[2] in ['a'..'z']) then
    begin
      data[i].e := vgl; { Name }
      data[i].L := 2; { Name length }
    end;
    data[i].p := k; { Position }
    data[i].m := mol[k-1]-1; { Molecule }
    i := i + 1;
  end;
  SetLength(data,i);

{ Sort element names }
  volgorde(data,lok);
{ Distinguish atoms for
  matrix rows numbering }
  vgl := data[lok[0]].e;
  p := 0;
  for k := 0 to i-1 do
  begin
    if not (data[lok[k]].e = vgl)
      then p := p + 1;
    data[lok[k]].r := p;
    vgl := data[lok[k]].e;
  end;

{ Default # atoms in molecule = 1
  and negative when on the right }
  for k := 0 to i-1 do
    if data[k].p < Pos('=',kort)
    then data[k].g := +1
    else data[k].g := -1;

{ Find true # atoms in molecule }
  Parse_Numbers(kort,getal);
{ Store them in data structure
  negative when on the right }   
  ng := Length(getal);
  r := Pos('=',kort);
  for k := 0 to ng-1 do
  begin
    p := getal[k].p;
    for j := 0 to i-1 do
    begin
      q := data[j].p + data[j].L;
      if p = q then
      if data[j].p < r then data[j].g := getal[k].g 
                       else data[j].g := - getal[k].g;
    end;
  end;

{ Processing parentheses }
  SetLength(haak,L);
  vullen := false;
  for k := 0 to L-1 do
    haak[k] := 1;
  waarde := 1;
  for k := L downto 1 do
  begin
    if kort[k] = ')' then
    begin
      vullen := true;
      for i := 0 to ng-1 do
        if getal[i].p = k+1
        then waarde := getal[i].g;
      Continue;
    end;
    if kort[k] = '(' then
    begin
      vullen := false;
      waarde := 1;
      Continue;
    end;
    if vullen then
      haak[k-1] := waarde;
  end;
{ Store in data structure }
  i := Length(data);
  for j := 0 to i-1 do
  begin
    data[j].g := data[j].g * haak[data[j].p-1];
  end;
end;

END.