solvepoc.pas

化学方程配平软件

                      getkey(c^);
                      if (done[0]) then begin
                                             for j:=1 to xn do
                                                 a[0,j]:=c^[0,j];
                                             err:=0;
                                             exit;
                                        end;
                      if err=0 then stepon;
                      if g>max then begin
                                    err:=no_answer;
                                    exit;
                                    end;
                      done:=done1;
                until false;
       end;


   procedure easy(var a:equationtype);
   var i,j,h,lp,sp,m:integer;
   begin
        mainlast:=xn;
        temp:=0;
        while (temp<2) and (mainlast>0) do
        begin
             temp:=0;
             for i:=1 to ln do if a[i,mainlast]<>0 then inc(temp);
             if temp<2 then dec(mainlast);
        end;
        for lp:=1 to ln do
            begin
                 m:=maxpublic(a[lp,0],a[lp,1]);
                 for h:=2 to xn do
                     m:=maxpublic(m,a[lp,h]);
                 if a[lp,0]<0 then m:=-m;
                 if m<>0 then for h:= 0 to xn do
                                      a[lp,h]:=a[lp,h] div m;
            end;
        for i:=1 to ln do
            begin
                 temp:=xn;
                 for j:=1 to xn do
                     if a[i,j]=0 then dec(temp);
                 nz[i]:=temp;
                 j:=xn;
                 while (a[i,j]=0) and (j>0) do dec(j);
                 if j=0 then if a[i,0]=0 then begin
                                                   done[i]:=true
                                              end     
                                         else begin
                                              err:=no_answer;
                                              exit;
                                              end;
                 last[i]:=j;

            end;


     if mainlast>0 then
     begin
        changed:=true;
        while changed do
           begin
                changed:=false;
                for lp:=1 to ln do
                  if not done[lp] then
                  {for sp:=1 to ln do
                    if (not done[lp]) and (lp<>sp) then}
                       {for i:=xn downto 1 do}
                           begin
                                temp:=0;spt:=0;
                                for sp:=1 to ln do
                                    begin
                                         m:=mainlast;
                                         while a[lp,m]=0 do dec(m);
               fit[sp]:=(lp<>sp) and (not done[sp]) and ((last[lp]=last[sp]) or ((last[lp]>mainlast) and (m=last[sp])));
                                         if fit[sp] then begin
                                                         if last[lp]=last[sp] then
                                                            begin
                                                                 temp2:=minpublic(a[lp,last[lp]],a[sp,last[sp]]);
                                                                 if (temp=0) or ((temp2>0)and(temp2<temp)) then
                                                                    begin
                                                                         spt:=sp;
                                                                         temp:=temp2;
                                                                    end;
                                                            end
                                                            else begin
                                                                      m:=mainlast;
                                                                      while a[lp,m]=0 do dec(m);
                                                                      temp2:=minpublic(a[lp,m],a[sp,m]);
                                                                      if (temp=0) or ((temp2>0)and(temp2<temp)) then
                                                                         begin
                                                                              spt:=sp;
                                                                              temp:=temp2;
                                                                         end;
                                                            end;
                                                         end;
                                    end;
                                if spt>0 then
                                  begin
                                       sp:=spt;
                                       if last[lp]<=mainlast then i:=last[lp]
                                                             else begin
                                                                  i:=mainlast;
                                                                  while a[lp,i]=0 do dec(i);
                                                                  end;

                                       {if (a[lp,i]<>0) and (a[sp,i]<>0) then}
                                          begin
                                               for j:=0 to xn do
                                                   begin
                                                        line1[j]:=a[lp,j];
                                                        line2[j]:=a[sp,j];
                                                   end;
                                               m:=minpublic(line1[i],line2[i]);
                                               k1:=m div line1[i];
                                               k2:=m div line2[i];
                                               for h:=0 to xn do
                                                   begin
                                                        line1[h]:=k1*line1[h];
                                                        line2[h]:=k2*line2[h];
                                                        line2[h]:=line1[h]-line2[h];
                                                   end;
                                               temp:=xn;
                                               for h:=1 to xn do
                                                   if line2[h]=0 then dec(temp);
                                               {if temp<nz[lp] then
                                                  begin
                                                       changed:=true;
                                                       for h:=0 to xn do
                                                          a[lp,h]:=line2[h];
                                                       nz[lp]:=temp;
                                                       if temp=0 then if line2[0]=0 then done[lp]:=true
                                                                                    else begin
                                                                                         err:=no_answer;
                                                                                         exit;
                                                                                         end;
                                                  end
                                                  else} begin
                                                            h:=mainlast+1;
                                                            repeat
                                                                  dec(h);
                                                            until (line1[h]=0) xor (line2[h]=0);
                                                            if line2[h]=0 then
                                                               begin
                                                                    changed:=true;
                                                                    for h:=0 to xn do
                                                                       a[lp,h]:=line2[h];
                                                                    nz[lp]:=temp;
                                                                    if temp=0 then if line2[0]=0 then done[lp]:=true
                                                                                                 else begin
                                                                                                      err:=no_answer;
                                                                                                      exit;
                                                                                                      end;
                                                                    h:=last[lp];
                                                                    while (a[lp,h]=0) and (h>0) do dec(h);
                                                                    last[lp]:=h;
                                                                    m:=maxpublic(a[lp,0],a[lp,1]);
                                                                    for h:=2 to xn do
                                                                        m:=maxpublic(m,a[lp,h]);
                                                                    if a[lp,0]<0 then m:=-m;
                                                                    if m<>0 then for h:= 0 to xn do
                                                                                    a[lp,h]:=a[lp,h] div m;
                                                                    temp:=0;
                                                                    while (temp<2) and (mainlast>0) do
                                                                    begin
                                                                         temp:=0;
                                                                         for h:=1 to ln do if a[h,mainlast]<>0 then inc(temp);
                                                                         if temp<2 then dec(mainlast);
                                                                    end;
                                                                    if mainlast=0 then begin
                                                                                       err:=0;
                                                                                       exit;
                                                                                       end;
                                                               end;
                                                  end;
                                          end;
                                  end;
                           end;
           end;
     end;
     err:=0;
     end;

   begin
   step2:
        for i:=1 to ln do done[i]:=false;
        for i:=1 to xn do known[i]:=false;
         easy(a);
         getkey(a);
         if (done[0]) or (err<>0) then exit;
         new(c);
         c^:=a;
         stepon;
         exit;
         dispose(c);
     
   end;

BEGIN
     sett;
     err:=0;
     SOLVE(equation,enum,mnum);
     if err>0 then writeLN('Error ',err);
     b:=true;
     for err:=1 to matnumber do
         b:=b and (equation[0,err]=0);
     if b then begin
               SOLVE(EQUATION,ENUM,MNUM);
               for err:=1 to matnumber do
                   b:=b and (equation[0,err]=0);
               if b then writeln(' I can''t work it out!');
               end;
END;