Cod sursa(job #27652)

Utilizator izso88istvan zsolt izso88 Data 6 martie 2007 22:14:58
Problema Magazin Scor 25
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.97 kb
var t:text;
    ad:array[0..500,1..2] of integer;
    tomb:array[1..500,1..500] of integer;
    i,j,k,l,P,M,N,D:integer;
    dont:array[0..500] of integer;
    mine,minp,u:longint;

function min(a,b:integer):integer;
         begin if a<b then min:=a else min:=b; end;

function kdist(y,x:integer):integer;
         begin
          kdist:=d*(y-1)+x;
         end;

function vdist(y,x:integer):integer;
         begin
          vdist:=d*(abs(n-y))+x;
         end;

function osszeg:longint;
         var w:integer;
             o:longint;
         begin
         w:=dont[0];
         o:=kdist(ad[dont[1],1],ad[dont[1],2]);
         o:=o+vdist(ad[dont[w],1],ad[dont[w],2]);
         for w:=1 to dont[0] do
          if w<dont[0] then
          o:=o+(tomb[dont[w],dont[w+1]]);
          osszeg:=o;
         end;


procedure sort;
          var jump,a,b,r:integer;
              done:boolean;
          begin
           jump:=p;
           while jump>1 do begin
            jump:=jump div 2;
             repeat
             done:=true;
              for a:=1 to p-jump do begin
              b:=a+jump;
              if ad[b,1]<ad[a,1] then
               begin
                ad[0]:=ad[b];
                ad[b]:=ad[a];
                ad[a]:=ad[0];
               end
               else
               if ad[b,1]=ad[a,1] then
                if ad[b,2]<ad[a,2] then
                               begin
                                               ad[0]:=ad[b];
                                               ad[b]:=ad[a];
                                               ad[a]:=ad[0];
                                               end;


              end;
             until done;
           end;


          end;

begin
     randomize;
     assign(t,'magazin.in');
     reset(T);
      read(t,p,n,m,d);
      for i:=1 to p do read(t,ad[i,1],ad[i,2]);
     close(T);
     for i:=1 to p do for j:=1 to p do tomb[i,j]:=-1;
     sort;
     for i:=1 to p do for j:=1 to p do
      if tomb[i,j]=-1 then begin

        tomb[i,j]:=d*abs(ad[i,1]-ad[j,1]);
        if ad[i,1]=ad[j,1] then tomb[i,j]:=tomb[i,j]+(abs(ad[i,2]-ad[j,2]))
        else
        tomb[i,j]:=tomb[i,j]+min(ad[i,2]+ad[j,2],m-ad[i,2]+m-ad[j,2]+2);

        tomb[j,i]:=tomb[i,j];
     end;

     dont[0]:=0;

     for i:=1 to p do
         begin
         inc(dont[0]);
         dont[dont[0]]:=i;
         mine:=osszeg;
         minp:=i;
         for j:=i downto 2 do begin
          u:=dont[j];
          dont[j]:=dont[j-1];
          dont[j-1]:=u;
          u:=osszeg;
          if u<mine then begin
                         mine:=u;
                         minp:=j-1;
                        end;
          end;

         for j:=1 to minp-1 do
          begin
          u:=dont[j];
          dont[j]:=dont[j+1];
          dont[j+1]:=u;
          end;

      end;

     assign(t,'magazin.out');
     rewrite(T);
     writeln(t,osszeg);
     closE(T);


end.