it is ac in 0.03s, but maybe it is a little diffcult to understand.
because my program are usually very bad :)
i hope it could give you some help.

var f:array[1..10000] of longint;
    r:array[1..10000,1..3] of integer;
    l,c:array[1..3] of longint;
    s:array[1..10000] of longint;
    i,j,n,x,a,b:longint;

function dis(i,j:integer):longint;
begin
  dis:=abs(s[j]-s[i]);
end;

begin
  readln(l[1],l[2],l[3],c[1],c[2],c[3]);
  readln(n);
  readln(a,b);
  if a>b then
  begin
    i:=a;
    a:=b;
    b:=i;
  end;
  fillchar(s,sizeof(s),0);
  for i:=2 to n do readln(s[i]);
  fillchar(r,sizeof(r),0);
  for i:=1 to 3 do
  begin
    x:=b;
    for j:=b downto a do
    begin
      while (x>a) and (dis(x-1,j)<=l[i]) do dec(x);
        r[j,i]:=x;
    end;
  end;
  f[a]:=0;
  for i:=a+1 to b do
  begin
    f[i]:=maxlongint;
    for j:=1 to 3 do
      if (f[r[i,j]]<>maxlongint) and (f[r[i,j]]+c[j]<f[i]) then
        f[i]:=f[r[i,j]]+c[j];
  end;
  writeln(f[b]);
end.

Wellcome to make friends with me!
My msn :  simon25hk@msn.com


program ural1031;
const
    maxn=10000;
    INFTY=1000000000;
var
    A        :array[1..maxn,1..3] of integer;
    L,C        :array[1..3] of longint;
    F,D        :array[1..maxn] of longint;
    N,S,E    :integer;
procedure swapit(var a,b:integer);
var
    c    :integer;
begin
    c:=a;
    a:=b;
    b:=c;
end;
procedure init;
var
    i,j        :integer;
begin
    fillchar(A,sizeof(A),0);

    readln(L[1],L[2],L[3],C[1],C[2],C[3]);
    readln(N);
    readln(S,E);
    if S>E then swapit(S,E);
    for i:=2 to N do
      readln(D[i]);

    for i:=1 to N do
      F[i]:=INFTY;
    D[1]:=0;
    F[1]:=0;
end; {init}

procedure precal;
var
    i,j,k    :integer;
Begin
    A[S,1]:=S;
    A[S,2]:=S;
    A[S,3]:=S;
    for i:=S+1 to E do
      begin
        for j:=1 to 3 do
          begin
               k:=A[i-1,j];
             while (D[i]-D[k]>L[j]) do
                 inc(k);
            A[i,j]:=k;
          end;
      end;
end; {precal}

function min(a,b:longint):longint;
begin
    if a<b then min:=a else min:=b;
end; {min}
procedure main;
var
    i,j        :integer;
    tmp        :longint;
begin
    F[S]:=0;
    for i:=S+1 to E do
      begin
         tmp:=INFTY;
         for j:=1 to 3 do
           tmp:=Min(tmp,F[ A[i,j] ]+C[j]);
         F[i]:=tmp;
      end;
end; {main}
Begin
    init;
    precal;
    main;
    writeln(F[E]);
end.





Edited by author 20.06.2004 16:02

Edited by author 20.06.2004 16:03

I do not think that posting here your AC-sources is the best way to make friends with anyone. Just stop doing it, please!

It's really a good idea!

Edited by author 08.07.2004 17:36