Cod sursa(job #127483)

Utilizator MihaiBunBunget Mihai MihaiBun Data 24 ianuarie 2008 01:10:20
Problema Restante Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.57 kb
program alex;
type vector=array[1..36000]of string[16];
     sirscurt=string[16];
var f:text;
    s:vector;
    n,m,nr,k,p:longint;
    sir:sirscurt;
procedure poz(li,ls:longint;var k:longint; var a:vector);
var i,j,i1,j1,c1:longint;
    c:sirscurt;
begin
  i1:=0;
  j1:=-1;
  i:=li;
  j:=ls;
  while i<j do
  begin
  if a[i]>a[j] then
    begin
    c:=a[j];
    a[j]:=a[i];
    a[i]:=c;
    c1:=i1;
    i1:=-j1;
    j1:=-c1
    end;
    i:=i+i1;
    j:=j+j1;
  end;
  k:=i;
  end;
 procedure quick(li,ls:longint);
 begin
   if li<ls then
     begin
     poz(li,ls,k,s);
     quick(li,k-1);
     quick(k+1,ls)
     end;
 end;
procedure poz1(li,ls:longint;var k:longint; var a:sirscurt);
var i2,j2,i1,j1,c1:longint;
    c:char;
begin
  i1:=0;
  j1:=-1;
  i2:=li;
  j2:=ls;
  while i2<j2 do
  begin
  if a[i2]>a[j2] then
    begin
    c:=a[j2];
    a[j2]:=a[i2];
    a[i2]:=c;
    c1:=i1;
    i1:=-j1;
    j1:=-c1
    end;
    i2:=i2+i1;
    j2:=j2+j1;
  end;
  k:=i2;
  end;
procedure quick1(li,ls:longint);
 begin
   if li<ls then
     begin
     poz1(li,ls,k,sir);
     quick1(li,k-1);
     quick1(k+1,ls)
     end;
 end;
begin
assign(f,'restante.in');reset(f);
readln(f,n);
nr:=0;
for p:=1 to n do
    begin
    readln(f,s[p]);
    m:=length(s[p]);
    sir:=s[p];
    quick1(1,m);
    s[p]:=sir;
    end;
quick(1,n);
p:=0;
repeat
p:=p+1;
if s[p]<>s[p+1] then nr:=nr+1
                else
while s[p]=s[p+1] do
      p:=p+1;
until p=n;
close(f);
assign(f,'restante.out');rewrite(f);
writeln(f,nr);
close(f);
end.