Cod sursa(job #7173)

Utilizator floringh06Florin Ghesu floringh06 Data 21 ianuarie 2007 12:57:28
Problema Pachete Scor 10
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasa a 10-a Marime 2.47 kb
{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 65520,0,655360}

type pozitie = record  lin,col:longint; end;
     status = record lin,col,dist:longint; ok:boolean; end;

  var n,i,j                 :longint;
      first,last,pu,pc,pin  :pozitie;
    {  q:array[0..100] of pozitie;  }
      a:array[0..60000] of status;
      fi,fo:text;

  function part(st,dr:longint):longint;
   var p,i,j:longint;
       aux:status;
       sens:integer;
    begin

      p := st + random(dr-st+1);
      aux:=a[st];
      a[st]:=a[p];
      a[p]:=aux;

      i:=st; j:=dr; sens:=-1;
      while i<j do
        begin
          if a[i].dist>a[j].dist then
           begin
            aux:=a[i];
            a[i]:=a[j];
            a[j]:=aux;
            sens:=-sens;
           end;
           if sens=1 then inc(i)
               else dec(j);
        end;
      part:=i;
   end;
 procedure qsort(st,dr:longint);
   var p:longint;
   begin
     if st<dr then
       begin
        p:=part(st,dr);
        qsort(st,p-1);
        qsort(p+1,dr);
       end;
   end;

  function ndrum:longint;
    var i,j,aux:longint;
          bol:boolean;
          poscrt:longint;
          ct,int,ies:longint;
          crt,crt1:longint;
    begin
    crt:=1;  poscrt:=0;  crt1:=1;
    ies:=0;  ct:=0;
    while ies<n do
     begin
        for i:=crt1 to n do
          if a[i].ok=false then
           begin
             inc(ct);
             a[i].ok:=true;
             poscrt:=a[i].dist;
             crt1:=i;
             crt:=i;
             inc(ies);
             break;
           end;
        inc(i);
        while i<=n do
          begin
            int:=(abs(a[i].lin-a[crt].lin) + abs(a[i].col-a[crt].col));
            if (a[i].dist=int+poscrt) and (a[i].ok=false) then
              begin
                a[i].ok:=true;
                poscrt:=a[i].dist;
                crt:=i;
                inc(ies);
              end;
            inc(i);
          end;
      end;
   ndrum:=ct;
   end;

 begin
    assign(fi,'pachete.in'); reset(fi);
    assign(fo,'pachete.out'); rewrite(fo);
    readln(fi,n);
    readln(fi,a[0].lin,a[0].col);
    for i:=1 to n do
     begin
      readln(fi,a[i].lin,a[i].col);
      a[i].ok:=false;
      a[i].dist:=(abs(a[i].lin-a[0].lin) + abs(a[i].col-a[0].col));
     end;
    qsort(1,n);
   { for i:=1 to n do
      writeln(fo,a[i].dist);  }
    writeln(fo,ndrum);
  close(fo);
  close(fi);
 end.