Cod sursa(job #37882)

Utilizator M@2Te4iMatei Misarca M@2Te4i Data 25 martie 2007 12:58:32
Problema Elimin 2 Scor 10
Compilator fpc Status done
Runda preONI 2007, Runda 4, Clasa a 10-a Marime 1.13 kb
type sir=array[1..2002]of char;

var a:sir;
    n:integer;

procedure citire;
var c:char;
begin
assign(input,'elimin2.in');
reset(input);
n:=0;
while true do
      begin
      read(c);
      if c in ['0'..'9'] then
         begin
         inc(n);
         a[n]:=c;
         end
         else
         break;
      end;
close(input);
end;

procedure eliminare(w:integer);
var i:integer;
begin
for i:=w+1 to n do
    a[w-1]:=a[w];
n:=n-1;
end;

procedure afisare;
var i:integer;
begin
assign(output,'elimin2.out');
rewrite(output);
for i:=1 to n do
    write(a[i]);
close(output);
end;

procedure verif;
var i,j:integer;
begin
i:=1;
j:=n;
while (i<>j) and (i<j) do
      begin
      if (a[i]<>a[j]) and (a[i]=a[j-i]) then
         begin
         eliminare(j);
         j:=j-1;
         end
         else if (a[i]<>a[j]) and (a[i+1]=a[j]) then
                 begin
                 eliminare(i);
                 j:=j-1;
                 end
              else begin
                   inc(i);
                   j:=j-1;
              end
      end;
afisare;
end;

begin
citire;
verif;
end.