Cod sursa(job #187195)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 1 mai 2008 18:12:12
Problema Restante Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
program restante;
var f,g:Text;
    v:array[0..40000]of string;
    n,y,i,cont,l:longint;

function part1 (p,r:longint):longint;
var i,j:longint;
    x,aux:char;
begin
  x:=v[y,p];
  i:=p-1;
  j:=r+1;
  while true do
    begin
      repeat dec(j);
        until v[y,j]<=x;
      repeat inc(i);
        until v[y,i]>=x;
      if (i<j)then
        begin
          aux:=v[y,i];
          v[y,i]:=v[y,j];
          v[y,j]:=aux;
        end else
        begin
          part1:=j;
          break;
        end;
    end;
end;

procedure quick1(p,r:longint);
var q,i:longint;
begin
  if (p<r)then
    begin
      q:=part1(p,r);
      quick1(p,q);
      quick1(q+1,r);
    end;
end;

function part2(p,r:longint):longint;
var i,j:longint;
    x,aux:string;
begin
  x:=v[p];
  i:=p-1;
  j:=r+1;
  while true do
    begin
      repeat dec(j);
        until v[j]<=x;
      repeat inc(i);
        until v[i]>=x;
      if (i<j)then
        begin
          aux:=v[i];
          v[i]:=v[j];
          v[j]:=aux;
        end else
        begin
          part2:=j;
          break;
        end;
    end;
end;

procedure quick2(p,r:longint);
var q,i:longint;
begin
  if (p<r)then
    begin
      q:=part2(p,r);
      quick2(p,q);
      quick2(q+1,r);
    end;
end;


begin
assign(f,'restante.in');
assign(g,'restante.out');
reset(f);
rewrite(g);
readln(f,n);
for y:=1 to n do
  begin
    readln(f,v[y]);
    l:=length(v[y]);
    quick1(1,l);
  end;
quick2(1,n);
for i:=1 to n do
  if (v[i]<>v[i+1])and(v[i]<>v[i-1])then inc(cont);
writeln(g,cont);
close(f);
closE(g);
end.