Cod sursa(job #1089077)

Utilizator Vasile_Catananoname Vasile_Catana Data 21 ianuarie 2014 14:46:13
Problema Text Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.77 kb
program p1;
var s,s1:string;
    a:array[0..256] of integer;
   i,j,i1,i2,k,n,t,r:integer;
    f,g:text;
    aux:char;

begin
assign(f,'text.in');reset(F);
assign(g,'text.out');rewrite(G);
k:=0;
while not eof(F) do begin
                readln(f,s);
                a[0]:=1;
                for i:=1 to length(S) do
                        if s[i]=' 'then begin
                                        inc(k);
                                        a[k]:=i;
                                        end;
                i1:=0;t:=a[i1];n:=a[i1+1]-1;
                while i1<=k do begin
                                while t<=n do
                                        if s[t]=s[n] then  begin
                                                        if n=a[i1] then begin
                                                                        inc(i1);
                                                                        n:=a[i1+1]-1;
                                                                        t:=a[i1];
                                                                        end
                                                                   else begin
                                                                        inc(t);
                                                                        dec(n);
                                                                        end;
                                                         s[n]:='1';
                                                         inc(i1);
                                                         end;



                                inc(i1);
                                end;
                writeln(g,s);
                end;
close(F);
close(G);
end.