Cod sursa(job #305197)

Utilizator FllorynMitu Florin Danut Flloryn Data 16 aprilie 2009 17:17:27
Problema Restante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.76 kb
program pascal;
var f,g:text;    x:array[1..36000] of string;    i,n,nr:longint;
                 v:array[1..36000] of byte;
  procedure citire;
  begin
  assign(f,'restante.in'); reset(f); assign(g,'restante.out'); rewrite(g);
  readln(f,n);
  for i:=1 to n do readln(f,x[i]);
  end;

  procedure quick(s,d:integer);
  var a,b,ia:integer; aux:char;
  begin
  a:=s; b:=d;
    repeat
    while x[i][a]<x[i][b] do b:=b-1;
    aux:=x[i][a]; x[i][a]:=x[i][b]; x[i][b]:=aux; ia:=1; a:=a+1;
    if a<b then
           begin
           while x[i][a]<x[i][b] do a:=a+1;
           if a<>b then
               begin
               aux:=x[i][a]; x[i][a]:=x[i][b]; x[i][b]:=aux; ia:=0; b:=b-1;
               end;
            end;
    until b<=a;
    if a-ia>s then quick(s,a-ia);
    if a-ia+1<d then quick(a-ia+1,d);
  end;

  procedure quick2(s,d:integer);
  var a,b,ia:integer; aux:string;
  begin
  a:=s; b:=d;
    repeat
    while x[a]<x[b] do b:=b-1;
    aux:=x[a]; x[a]:=x[b]; x[b]:=aux; ia:=1; a:=a+1;
    if a<b then
           begin
           while x[a]<x[b] do a:=a+1;
           if a<>b then
               begin
               aux:=x[a]; x[a]:=x[b]; x[b]:=aux; ia:=0; b:=b-1;
               end;
            end;
    until b<=a;
    if a-ia>s then quick(s,a-ia);
    if a-ia+1<d then quick(a-ia+1,d);
  end;

begin
citire;
for i:=1 to n do quick(1,length(x[i]));
quick2(1,n);
nr:=0;
for i:=1 to n-1 do
  begin
  if (x[i]<>x[i+1]) and (v[i]=0) then nr:=nr+1
                    else
                     begin
                     v[i]:=1;
                     v[i+1]:=1;
                     if (x[i]<>x[i+1]) and (v[i]=1) then v[i+1]:=0;
                     end;
  end;
if v[n]=0 then inc(nr);
write(g,nr);
close(f);
close(g);
end.