Cod sursa(job #479931)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 25 august 2010 17:38:36
Problema Restante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.4 kb
program restante;
type vector=array[1..36000]of string[16];
var ch:char; p,i,n,x,k1,j,af,k:longint;
   a,allc:vector;cuv:string[16];  f,g:text;

procedure poz(li,ls:longint;var k:longint;var a:vector);
var i,j,i1,j1,c1:longint;c:string;
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,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; }
      quick(1,x);
       for i:=2 to x-1 do
        if (allc[i]<>allc[i-1])and(allc[i]<>allc[i+1])then af:=af+1;
        if allc[1]<>allc[2] then af:=af+1;
        if allc[n-2]<>allc[n-1] then af:=af+1;
       write(g,af+1);
      close(f);close(g);
      end.