Cod sursa(job #125419)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 20 ianuarie 2008 12:50:53
Problema Restante Scor 60
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasele 5-8 Marime 1.85 kb
var v,x,y:array[0..36002]of string;
    n,i,j,k:longint;
    f:text;
procedure merge1(p,r:longint);
var q,d,e,c:longint;
    u,w:array[1..20]of char;
begin
   q:=(p+r)div 2;
   if p<q then merge1(p,q);
   if q+1<r then merge1(q+1,r);
   for j:=p to q do
   u[j]:=v[i,j];
   for j:=q+1 to r do
   w[j]:=v[i,j];
   d:=p;
   e:=q+1;
   c:=p-1;
   while(d<=q)and(e<=r)do
   if u[d]<w[e] then begin c:=c+1;
                           v[i,c]:=u[d];
                           d:=d+1;
                     end
                else begin c:=c+1;
                           v[i,c]:=w[e];
                           e:=e+1;
                     end;
   while(d<=q)do
   begin
   c:=c+1;
   v[i,c]:=u[d];
   d:=d+1;
   end;
   while(e<=r)do
   begin
   c:=c+1;
   v[i,c]:=w[e];
   e:=e+1;
   end;
end;
procedure merge2(p,r:longint);
var q,d,e,c:longint;
begin
   q:=(p+r)div 2;
   if p<q then merge2(p,q);
   if q+1<r then merge2(q+1,r);
   for j:=p to q do
   x[j]:=v[j];
   for j:=q+1 to r do
   y[j]:=v[j];
   d:=p;
   e:=q+1;
   c:=p-1;
   while(d<=q)and(e<=r)do
   if x[d]<y[e] then begin c:=c+1;
                           v[c]:=x[d];
                           d:=d+1;
                     end
                else begin c:=c+1;
                           v[c]:=y[e];
                           e:=e+1;
                     end;
   while(d<=q)do
   begin
   c:=c+1;
   v[c]:=x[d];
   d:=d+1;
   end;
   while(e<=r)do
   begin
   c:=c+1;
   v[c]:=y[e];
   e:=e+1;
   end;
end;
begin
   assign(f,'restante.in');
   reset(f);
   readln(f,n);
   for i:=1 to n do
   begin
   readln(f,v[i]);
   merge1(1,length(v[i]));
   end;
   close(f);
   merge2(1,n);
   k:=0;
   for i:=1 to n do
   if(v[i]<>v[i-1])and(v[i]<>v[i+1])then k:=k+1;
   assign(f,'restante.out');
   rewrite(f);
   writeln(f,k);
   close(f);
end.