Cod sursa(job #305218)

Utilizator FllorynMitu Florin Danut Flloryn Data 16 aprilie 2009 17:59:32
Problema Restante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.48 kb
program pascal;
var f,g:text;    x:array[0..40000] of string;    i,n,nr:longint;
  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
 if (x[i]<>x[i-1]) and (x[i]<>x[i+1]) then nr:=nr+1;

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