Cod sursa(job #305211)

Utilizator FllorynMitu Florin Danut Flloryn Data 16 aprilie 2009 17:51:08
Problema Restante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.67 kb
program pascal;
var f,g:text;    x:array[1..40000] of string;    i,n,nr,j:longint;
                 v:array[1..40000] of byte; ok:boolean;
  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:longint);
  var a,b,ia:longint; 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 do
 for j:=i+1 to n do
 if x[j]>x[i] then break
 else
 if x[i]=x[j] then
           begin
           v[i]:=1;
           v[j]:=1;
           end;

for i:=1 to n do
if v[i]=0 then nr:=nr+1;

write(g,nr);
close(f);
close(g);
end.