ac1038.pas

同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料

program tju1038;
const
  maxunknowns=100;
  maxelements=100;
  error='No solution';
var
  element:array[1..maxelements]of string[2];
  e:array[1..maxelements,1..maxunknowns]of int64;{equations}
  anse:array[2..maxunknowns]of byte;{which equation to ure to find each unknown}
  ans:array[1..maxunknowns]of int64;
  t,u,es,us,ur,p:longint;
  g:int64;
  s:string;
procedure formula(mul:longint);
  var
    x,m:longint;
    el:string[2];
  begin
    repeat
      x:=0;m:=1;
      while s[p] in ['0'..'9'] do begin
        inc(x,(ord(s[p])-48)*m);m:=m*10;dec(p);
      end;
      if x=0 then x:=1;
      if s[p]=')' then begin
        dec(p);formula(mul*x);dec(p);
      end
      else begin
        if s[p] in ['a'..'z'] then begin el:=copy(s,p-1,2);dec(p,2);end
                              else begin el:=copy(s,p,1);dec(p);end;
        m:=1;while (m<=es) and (element[m]<>el) do inc(m);
        if m>es then inc(es);element[m]:=el;
        inc(e[m,us],mul*x);
      end;
    until s[p] in ['(','+','='];
  end;
procedure build;
  var
    flag:shortint;
  begin
    fillchar(e,sizeof(e),0);
    readln(s);s:='+'+s;
    es:=0;us:=0;flag:=-1;p:=length(s);
    repeat
      inc(us);
      formula(flag);
      if s[p]='=' then flag:=1;
      dec(p);
    until p=0;
  end;
procedure swap(x,y:byte);
  var
    t:int64;
    i:byte;
  begin
    for i:=1 to ur do begin
      t:=e[x,i];e[x,i]:=e[y,i];e[y,i]:=t;
    end;
  end;
function gcd(a,b:int64):int64;
  var
    t:int64;
  begin
    if a<b then begin t:=a;a:=b;b:=t;end;
    repeat
      t:=a mod b;a:=b;b:=t;
    until b=0;
    gcd:=a;
  end;
procedure gauss(x,y:byte);
  var
    i:byte;
  begin
    g:=0;
    for i:=1 to ur do begin
      e[x,i]:=e[x,i]*e[y,ur]-e[y,i]*e[x,ur];
      if g=0 then g:=abs(e[x,i]) else if e[x,i]<>0 then g:=gcd(g,abs(e[x,i]));
    end;
    if g>0 then
      for i:=1 to ur do
        e[x,i]:=e[x,i] div g;
  end;
procedure print;
  var
    i,j:byte;
    s,f,m:int64;
  begin
    ans[1]:=1;
    for i:=2 to us do begin
      s:=0;
      for j:=1 to i-1 do
        s:=s-ans[j]*e[anse[i],j];
      if s=0 then begin writeln(error);exit;end;
      if s>0 then f:=e[anse[i],i] else begin s:=-s;f:=-e[anse[i],i];end;
      if (s>0)<>(f>0) then begin writeln(error);exit;end;
      m:=f div gcd(s,abs(f));
      ans[i]:=s*m div f;
      for j:=1 to i-1 do
        ans[j]:=ans[j]*m;
    end;
    for i:=us downto 2 do
      write(ans[i],' ');
    writeln(ans[1]);
  end;
procedure solve;
  begin
    ur:=us;
    while (ur-es<2) and (ur>1) do begin
      p:=es;while (p>0) and (e[p,ur]=0) do dec(p);
      if p=0 then begin writeln(error);exit;end;
      if p<es then swap(p,es);anse[ur]:=es;
      p:=1;dec(es);
      while p<=es do begin
        gauss(p,anse[ur]);
        if g=0 then begin e[p]:=e[es];dec(es);end else inc(p);
      end;
      dec(ur);
    end;
    if (ur=1) and (es=0) then print else begin writeln(error);exit;end;
  end;
begin
  readln(t);
  for u:=1 to t do begin
    build;
    solve;
  end;
end.