Category : Science and Education
Archive   : CHEMBAL.ZIP
Filename : CHEMBAL.PAS

Program ChemBal;

TYPE
LOW = SET OF 'a' .. 'z';
UP = SET OF 'A' .. 'Z';
DMA = SET OF '0' .. '9';
ERTYPE = STRING[40];
ELTYPE = STRING[2];

CONST
UPPERCASE: UP = ['A' .. 'Z'];
LOWERCASE: LOW = ['a' .. 'z'];
NUMERALS : DMA = ['0' .. '9'];
LEGALCHAR: SET OF CHAR = [' ','+','>'];

VAR L,R:ARRAY [0..5,0..5] OF REAL;
AL,AR:ARRAY [0..5,0..1] OF INTEGER;
ELEM: ARRAY[1..5] OF STRING[2];
ELEMENT: ARRAY [1..103] OF STRING[2];
SUML,SUMR:REAL;
NE,NL,NR,CHEMNO,P:INTEGER;
EQN,ERMSG: STRING[80];
LEFT,ERR:BOOLEAN;
EL:STRING[2];
CH:CHAR;

PROCEDURE GETELEM; FORWARD;
PROCEDURE TESTIT(ELMNT:ELTYPE); FORWARD;
PROCEDURE PUTINLEFT(V:INTEGER); FORWARD;
PROCEDURE PUTINRIGHT(V:INTEGER); FORWARD;
PROCEDURE PROCERROR(ERMSG:ERTYPE; POSNO:INTEGER); FORWARD;

Procedure ReadIn;
VAR FVAR: TEXT; I:INTEGER; OK:BOOLEAN;
BEGIN
ASSIGN (FVAR,'ELEMENTS.DAT');
{$I-} RESET (FVAR); {$I+}
OK := (IORESULT = 0);
IF NOT OK THEN
BEGIN
WRITELN ('CAN NOT FIND FILE "ELEMENTS.DAT" ON LOGGED DRIVE');
WRITELN ('OPERATION ABORTED');
HALT
END
ELSE
BEGIN
FOR I:=1 TO 103 DO
READLN (FVAR,ELEMENT[I]);
CLOSE (FVAR)
END
END;

Procedure SortAlone;
VAR A,I,J,CN:INTEGER;
BEGIN
FOR J:=1 TO NE DO
BEGIN
A:=0;
FOR I:=1 TO NL DO
IF L[I,J]<>0 THEN
BEGIN
A:=A+1; CN:=I
END;
IF A=1 THEN
BEGIN
AL[J,0]:=1; AL[J,1]:=CN
END;
A:=0;
FOR I:=1 TO NR DO
IF R[I,J]<>0 THEN
BEGIN
A:=A+1; CN:=I
END;
IF A=1 THEN
BEGIN
AR[J,0]:=1; AR[J,1]:=CN
END
END
END;

Procedure Sumem (I:Integer);
VAR J:INTEGER;
BEGIN
SUML:=0; SUMR:=0;
FOR J:=1 TO NL DO
SUML:=SUML+L[J,0]*L[J,I];
FOR J:=1 TO NR DO
SUMR:=SUMR+R[J,0]*R[J,I];
END;

Procedure Balance;
VAR I,IT:INTEGER; BAL:BOOLEAN; CH:CHAR;
BEGIN
REPEAT
FOR I:=1 TO NE DO
BEGIN
Sumem(I);
IF AL[I,0]=1 THEN
IF SUML
L[AL[I,1],0]:=SUMR/L[AL[I,1],I];
IF AR[I,0]=1 THEN
IF SUMR R[AR[I,1],0]:=SUML/R[AR[I,1],I];
END;
I:=0; BAL:=TRUE;
REPEAT
I:=I+1; Sumem(I);
IF SUMR<>SUML THEN BAL:=FALSE
UNTIL (NOT BAL) OR (I=NE);
IT:=IT+1;
IF IT>500 THEN
BEGIN
WRITELN;
WRITELN ('Formula too complex error');
HALT
END;
UNTIL BAL
END;

Procedure InitCooef;
VAR I:INTEGER;
BEGIN
FOR I:=1 TO NL DO L[I,0]:=1;
FOR I:=1 TO NR DO R[I,0]:=1
END;

PROCEDURE SETZEROS;
VAR I,J:INTEGER;
BEGIN
FOR J:=0 TO 5 DO
FOR I:=0 TO 5 DO
BEGIN
L[I,J]:=0; R[I,J]:=0;
AL[J,0]:=0; AL[J,1]:=0;
ELEM[J]:=' '
END
END;

Procedure Printem;
VAR I:INTEGER;
BEGIN
WRITELN;
WRITELN ('The corresponding Coefficients are: ');
FOR I:=1 TO NL DO
WRITE (L[I,0]:3:2,' ');
WRITE (' --> ');
FOR I:=1 TO NR DO
WRITE (R[I,0]:3:2,' ');
WRITELN;
WRITELN;
END;

PROCEDURE GETIN;

VAR LEN:INTEGER;
BEGIN
WRITELN;
WRITELN ('Enter the equation to be balanced');
WRITELN;
READLN (EQN); EQN:=EQN + ' '; LEN:=LENGTH (EQN);
LEFT:=TRUE; CHEMNO:=1; NE:=0; P:=1; ERR:=FALSE;
REPEAT
GETELEM;
IF NOT ERR THEN
BEGIN
IF NOT (EQN[P] IN [' ','+','>']) THEN PROCERROR ('IlLegal Character',P);
IF NOT ERR THEN
BEGIN
WHILE (EQN[P]=' ') AND (P IF EQN[P]='>' THEN
BEGIN
LEFT:=FALSE;
NL:=CHEMNO;
CHEMNO :=0
END;
P:=P+1;
WHILE (EQN[P]=' ') AND (P CHEMNO:=CHEMNO+1;
END
END
UNTIL (P>=LEN) OR ERR;
NR:=CHEMNO-1
END;

PROCEDURE GETELEM;
VAR ER,V:INTEGER; SV:STRING[4];
BEGIN
REPEAT
EL:=EQN[P];
IF NOT (EQN[P] IN UPPERCASE) THEN
PROCERROR('Illegal Character',P)
ELSE
BEGIN
P:=P+1;
IF EQN[P] IN LOWERCASE THEN
BEGIN
EL:=EL + EQN[P];
P:=P+1
END;
SV:='';
IF EQN[P] IN NUMERALS THEN
REPEAT
SV:=SV+EQN[P];
P:=P+1
UNTIL NOT (EQN[P] IN NUMERALS)
ELSE
SV:='1';
VAL (SV,V,ER);
IF ER<>0 THEN
PROCERROR('Illegal Character ',P)
ELSE
BEGIN
TESTIT(EL);
IF NOT ERR THEN
IF LEFT THEN PUTINLEFT(V) ELSE PUTINRIGHT(V);
END
END
UNTIL NOT(EQN[P] IN UPPERCASE) OR ERR
END;

PROCEDURE PUTINLEFT;
VAR K:INTEGER; FOUND:BOOLEAN;
BEGIN
K:=0; FOUND:=FALSE;
REPEAT
K:=K+1;
IF ELEM[K]=EL THEN FOUND:=TRUE
UNTIL FOUND OR (K>=NE);
IF FOUND THEN L[CHEMNO,K]:=V
ELSE BEGIN
NE:=NE+1;
ELEM[NE]:=EL;
L[CHEMNO,NE]:=V
END;
END;

PROCEDURE PUTINRIGHT;
VAR K:INTEGER; FOUND:BOOLEAN;
BEGIN
K:=0; FOUND:=FALSE;
REPEAT
K:=K+1;
IF ELEM[K]=EL THEN FOUND:=TRUE
UNTIL FOUND OR (K>=NE);
IF NOT FOUND THEN
PROCERROR('Element not found on the left',P-1)
ELSE
R[CHEMNO,K]:=V;
END;

PROCEDURE TESTIT;
VAR I:INTEGER; FOUND:BOOLEAN;
BEGIN
I:=0; FOUND:=FALSE;
REPEAT
I:=I+1;
IF ELEMENT[I]=ELMNT THEN FOUND:=TRUE
UNTIL FOUND OR (I=103);
IF I=103 THEN PROCERROR('Unknown element',P-1);
END;

PROCEDURE PROCERROR;
BEGIN
WRITELN ('^':POSNO);
WRITELN; WRITELN (ERMSG);
ERR:=TRUE
END;

PROCEDURE PRINTVALUES;
VAR C,D:INTEGER;
BEGIN
FOR C:=1 TO NL DO
BEGIN
WRITELN (' CHEMICAL # ',C);
FOR D:=1 TO NE DO WRITELN (L[C,D])
END;
WRITELN;
FOR C:=1 TO NR DO
BEGIN
WRITELN ('CHEMICAL # ',C);
FOR D:=1 TO NE DO WRITELN (R[C,D])
END
END;

PROCEDURE INTRO;
BEGIN
CLRSCR;
writeln ('Chemical Equation Balancer'); writeln;
writeln ('Enter the equation in the form:');
writeln; writeln (' Mg + O2 > MgO');
writeln;
writeln ('Using upper and lower case is a necesity, ie. MG will not work');
end;

BEGIN
REPEAT
ReadIn;
Intro;
SetZeros;
Getin;
IF NOT ERR THEN
BEGIN
InitCooef;
SortAlone;
Balance;
Printem
END;
WRITELN;
WRITELN ('Press RETURN for another or to try again.');
WRITE ('(`Q` to quit):');
READLN (CH)
UNTIL (CH='Q') OR (CH='q')
END.