Cod sursa(job #479876)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 25 august 2010 15:25:43
Problema Restante Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 kb
program restante;
type vector=array[1..16]of char;
var i,n,k1,p,x,j,af,k:integer;ch:char;
   a:vector;cuv:string[16];  f,g:text;
   allc:array[1..36000]of string[16];
procedure poz(li,ls:integer;var k:integer;var a:vector);
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 quick(li,ls:integer);
begin
  if li<ls then begin
   poz(li,ls,k,a);
   quick(li,k-1);
   quick(k+1,ls);
    end;
  end;
begin
   assign(f,'restante.in');reset(f);
   assign(g,'restante.out');rewrite(g);
     readln(f,x);
     for i:=1 to x do begin
      p:=0;
       while  not eoln(f) do begin
       read(f,ch);
       p:=p+1;
       a[p]:=ch;end;
       quick(1,p);cuv:='';
       for j:=1 to p do cuv:=cuv+a[j];
       allc[i]:=cuv;
       readln(f);
      end;
      for i:=1 to x do begin
       k1:=0;cuv:=allc[i];
       for j:=1 to x do
       if cuv=allc[j] then k1:=k1+1;
      if k1=1 then af:=af+1;
      end;
       write(g,af);
      close(f);close(g);
      end.