BARIC - Bò Ba-ri

Tác giả: flashmt

Ngôn ngữ: Pascal

const maxn=101;
      maxc=1000000000;
var n,re,e:longint;
    a,l,r:array[1..maxn] of longint;
    m:array[1..maxn,1..maxn] of longint;
    f:array[1..maxn,1..maxn] of longint;

procedure rf;
var i,j,k:longint;
begin
     read(n,e);
     for i:=1 to n do readln(a[i]);
     for i:=2 to n do
         for j:=1 to i-1 do
             l[i]:=l[i]+2*abs(a[i]-a[j]);
     for i:=n-1 downto 1 do
         for j:=n downto i+1 do
             r[i]:=r[i]+2*abs(a[i]-a[j]);
     for i:=1 to n-1 do
         for j:=1 to n do
             for k:=i+1 to j-1 do
                 m[i,j]:=m[i,j]+abs(2*a[k]-a[i]-a[j]);
end;

function min(x,y:longint):longint;
begin
     if x<y then min:=x else min:=y;
end;

procedure pr;
var i,j,k:longint;
begin
     for i:=2 to n do
         for j:=2 to n do
             f[i,j]:=maxc;
     for i:=1 to n do
         f[1,i]:=l[i];
     for i:=2 to n do
         for j:=i to n do
             for k:=1 to j-1 do
                 f[i,j]:=min(f[i,j],f[i-1,k]+m[k,j]);
     for i:=1 to n do
     begin
          for j:=i to n do
              if f[i,j]+r[j]<=e then break;
          if f[i,j]+r[j]<=e then break;
     end;
     re:=i;
     for j:=i to n do
         if f[i,j]+r[j]<e then e:=f[i,j]+r[j];
end;

procedure wf;
begin
     writeln(re,' ',e);
end;

begin
     rf;
     pr;
     wf;
end.

Download