Cod sursa(job #127477)

Utilizator MihaiBunBunget Mihai MihaiBun Data 24 ianuarie 2008 00:31:54
Problema Restante Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.59 kb
program alex;
type vector=array[1..36000]of string[16];
     sirscurt=string[16];
var f:text;
    s:vector;
    j,i,n,k,m,nr:integer;
    h:string[16];
    z:char;
    sir:sirscurt;
    e:boolean;
procedure poz(li,ls:integer;var k:integer; var a:vector);
var i,j,i1,j1,c1:integer;
    c:string[16];
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:integer);
 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:integer;var k:integer; var a:sirscurt);
var i,j,i1,j1,c1:integer;
    c:char;
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 quick1(li,ls:integer);
 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 i:=1 to n do
    begin
    readln(f,s[i]);
    m:=length(s[i]);
    sir:=s[i];
    quick1(1,m);
    end;
quick(1,n);
i:=0;
repeat
i:=i+1;
if s[i]<>s[i+1] then nr:=nr+1
                else
while s[i]=s[i+1] do
      i:=i+1;
until i=n;
close(f);
assign(f,'restante.out');rewrite(f);
writeln(f,nr);
close(f);
end.