Cod sursa(job #636733)

Utilizator SpiritGanea Dinu Spirit Data 19 noiembrie 2011 22:58:45
Problema PalM Scor 20
Compilator fpc Status done
Runda .com 2011 Marime 1.7 kb
var S:array[1..500] of char;
    nr:array[1..500] of 0..500;
    max,i,j,n,x,y,i1:integer;
    x1,y1:char;
    f1,f2:text;

Procedure Citire;
 begin
  assign(f1,'palm.in');
  reset(f1);
  i:=1;
  while not(EOF(f1)) do
   begin
    read(f1,s[i]);
    inc(i);
   end;
  close(f1);
  n:=i;
 end;

Procedure Palindrom;
 begin
  i:=1; j:=1;
  while i<=n do
   begin
    if s[i+1]=s[i] then
                     begin
                      y:=i;
                      for i1:=i to n do
                       if s[i1]=s[i] then inc(y);
                      x:=i-1;
                     end
                    else
                     begin
                      x:=i-1;
                      y:=i+1;
                     end;
    while (x>=0) and (y<=n) do
     begin
      x1:=s[x+1]; y1:=s[y-1];
      if (s[x]=s[y]) and(s[x]<x1) and (s[y]<y1) then
                                                   begin
                                                    dec(x);
                                                    inc(y);
                                                   end
                                                  else
                                                   begin
                                                    nr[j]:=y-x;
                                                    inc(j);
                                                    break;
                                                   end;

     end;
    inc(i);
   end;
end;


Procedure result;
 begin
  assign(f2,'palm.out');
  rewrite(f2);
  write(f2,max-1);
  close(f2);
 end;

begin
citire;
palindrom;
max:=nr[1];
for i:=1 to j do
 if nr[i]>max then max:=nr[i];
result;
end.