Cod sursa(job #57126)

Utilizator cezar305Mr. Noname cezar305 Data 1 mai 2007 11:08:18
Problema Bool Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
var v:array[1..1000]of char;
    stiva:array[1..260]of byte;
    valoare:array['A'..'z']of byte;
    j,i,n,p:integer;s,a,b:string;c:char;
begin
assign(input,'bool.in');reset(input);
assign(output,'bool.out'); rewrite(output);
valoare['t']:=1;
while not eoln do begin inc(i);read(v[i]);end;n:=i;
i:=1;
while i<=n do begin
    if (v[i]='A')and(v[i+1]='N')then begin s:=s+'&';inc(i,2);end
    else if (v[i]='O')and(v[i+1]='R') then begin s:=s+'|';inc(i,1);end
    else if (v[i]='N')and(v[i+1]='O')then begin s:=s+'!';inc(i,2);end
    else if (v[i]='T')and(v[i+1]='R') then begin s:=s+'t';inc(i,3);end
    else if (v[i]='F')and(v[i+1]='A') then begin s:=s+'f';inc(i,4);end
    else if (v[i]<>' ')then s:=s+v[i];
inc(i);
end;
s:='('+s+')';
while s<>'' do begin
  case s[1] of
    'A'..'Z','t','f': begin a:=a+s[1];delete(s,1,1); end;
     '(': begin b:='('+b; delete(s,1,1);end;
     ')': begin
            while b[1]<>'(' do begin a:=a+b[1];delete(b,1,1);end;
            delete(s,1,1);delete(b,1,1);
          end;
     '!': begin b:='!'+b; delete(s,1,1); end;
     '&': begin
            while b[1]='!' do begin a:=a+'!'; delete(b,1,1);end;
            b:='&'+b; delete(s,1,1);
          end;
     '|': begin
            while b[1] in ['!','&'] do begin a:=a+b[1]; delete(b,1,1);end;
            b:='|'+b; delete(s,1,1);
          end;
  end;
end;
readln(n);
for i:=1 to n do begin
    read(c);
    valoare[c]:=1-valoare[c]; p:=0;
    for j:=1 to length(a) do
        if a[j] in ['A'..'Z','t','f']then begin inc(p);stiva[p]:=valoare[a[j]];end
        else if a[j]='!' then stiva[p]:=1-stiva[p]
        else if a[j]='&' then begin stiva[p-1]:=stiva[p]*stiva[p-1];dec(p);end
        else begin stiva[p-1]:=ord(stiva[p]+stiva[p-1]>0);dec(p);end;
    write(stiva[1]);
end;
close(input); close(output);
end.