ac1219.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

program tju1219;
const
  maxl=1001;
  move2small='236  0  0';
  move2big=  '359  6  9';
  move1s=7;
  move1less='0135569';
  move1more='8796988';
  e:array[1..9]of longint=(1,10,100,1000,10000,100000,1000000,10000000,100000000);
var
  c:array[1..maxl]of char;
  sign,weight:array[1..maxl]of shortint;
  where:array[boolean,-9..9,1..7]of word;
  how:array[boolean,-9..9,1..7]of char;
  l,i,j,t,sum,head,len,sumlen:longint;
  right,minus:boolean;
begin
  repeat
    l:=0;right:=false;minus:=false;
    repeat
      inc(l);read(c[l]);
      if c[l] in ['0'..'9'] then
        if right=minus then sign[l]:=1 else sign[l]:=-1
      else begin
        sign[l]:=0;
        case c[l] of
          '=':begin right:=true;minus:=false;end;
          '+':minus:=false;
          '-':minus:=true;
        end;
      end;
    until c[l]='#';
    readln;

    sum:=0;
    for i:=l downto 1 do
      if sign[i]=0 then
        weight[i]:=0
      else begin
        weight[i]:=weight[i+1]+1;
        dec(sum,sign[i]*(ord(c[i])-48)*e[weight[i]]);
      end;
    dec(l);

    //Try removing and adding a stick on the same digit
    right:=false;
    head:=sum;sumlen:=1;
    while head mod 10=0 do begin head:=head div 10;inc(sumlen);end;
    if abs(head)<=9 then
      for i:=1 to l do
        if (weight[i]=sumlen) then
          if (sign[i]*head>0) and (c[i]=move2small[abs(head)]) then begin
            c[i]:=move2big[abs(head)];right:=true;break;
          end
          else if (sign[i]*head<0) and (c[i]=move2big[abs(head)]) then begin
            c[i]:=move2small[abs(head)];right:=true;break;
          end;

    //Try removing a stick and placing it on another digit
    if not right then begin
      fillchar(where,sizeof(where),0);
      for i:=l downto 1 do begin
        if weight[i]<sumlen then continue;
        for j:=1 to move1s do
          //Remove
          if c[i]=move1more[j] then begin
            t:=(ord(move1less[j])-ord(move1more[j]))*sign[i];
            head:=sum-t*e[weight[i]];len:=1;
            while (head<>0) and (head mod 10=0) do begin head:=head div 10;inc(len);end;
            if (abs(head)<=9) and (where[true,head,len]>i) then begin
              c[where[true,head,len]]:=how[true,head,len];
              c[i]:=move1less[j];
              right:=true;break;
            end;
            if where[false,t,weight[i]]=0 then begin
              where[false,t,weight[i]]:=i;
              how[false,t,weight[i]]:=move1less[j];
            end;
          end
          //Add
          else if c[i]=move1less[j] then begin
            t:=(ord(move1more[j])-ord(move1less[j]))*sign[i];
            head:=sum-t*e[weight[i]];len:=1;
            while (head<>0) and (head mod 10=0) do begin head:=head div 10;inc(len);end;
            if (abs(head)<=9) and (where[false,head,len]>i) then begin
              c[where[false,head,len]]:=how[false,head,len];
              c[i]:=move1more[j];
              right:=true;break;
            end;
            if where[true,t,weight[i]]=0 then begin
              where[true,t,weight[i]]:=i;
              how[true,t,weight[i]]:=move1more[j];
            end;
          end;
        if right then break;
      end;
    end;

    if right then begin for i:=1 to l do write(c[i]);writeln('#');end
             else writeln('No');
  until seekeof;
end.