Common Board @ Timus Online Judge

Please, give me any hints to solve problem 1065!

Posted by Nazarov Denis (nsc2001@rambler.ru) 10 Feb 2002 16:52

Use dynamic programming (-)

Posted by Michael_Rybak 10 Feb 2002 19:16

I use dynamic programming and get WA. Now I use Full Search and also WA(+)

Posted by Nazarov Denis (nsc2001@rambler.ru) 10 Feb 2002 20:29

Program t1065;{$N+}

Const MaxN = 50;
      MaxM = 1000;

Type Cor = record X,Y : longint end;

Var   Mon       : array[1..MaxM]of Cor;
      G         : array[1..MaxN]of Cor;
      CP        : array[1..MaxN,1..MaxN]of extended;
      EP        : array[1..MaxN,1..MaxN]of byte;
      Min       : array[1..MaxN]of record D : extended; V : byte; end;
      Pred,Use : array[1..MaxN+1]of byte;
      N,M,i,j,k : integer;
      b,step    : byte;
      D,Ans     : extended;
      AnsS      : string[20];

Function Dist(A,B : Cor) : extended;
begin
Dist:=sqrt(sqr(A.X-B.X)+sqr(A.Y-B.Y));
end;

Function Higher(Num1,Num2,Num3 : Cor) : byte;
Var w1,w2     : longint;
    x1,x2,x3 : longint;
    y1,y2,y3 : longint;
Begin
if abs(Num1.X-Num2.X)=0 then begin
    if Num1.X-Num3.X>0 then Higher:=0 else
    if Num1.X-Num3.X<0 then Higher:=1 else
    Higher:=2;
    exit;
   end;
if abs(Num1.Y-Num2.Y)=0 then begin
    if Num1.Y-Num3.Y>0 then Higher:=0 else
    if Num1.Y-Num3.Y<0 then Higher:=1 else
    Higher:=2;
    exit;
   end;
x1:=num1.x;
x2:=num2.x;
x3:=num3.x;       {1-higher line Num1-Num2}
y1:=num1.y;       {0-lower line Num1-Num2}
y2:=num2.y;       {2-on     line Num1-Num2}
y3:=num3.y;
w1:=(x1-x2)*(y3-y1);
w2:=(x3-x1)*(y1-y2);
if w1-w2>0 then Higher:=1 else
if w1-w2<0 then Higher:=0 else
Higher:=2;
end;

Function GetS(a,b,c : cor) : longint;
begin
GetS:=abs((a.x-b.x)*(a.y+b.y)+(b.x-c.x)*(b.y+c.y)+(c.x-a.x)*
(c.y+a.y));
end;

Function CheckEm2(ki : integer) : boolean;
var prd,k1,k2     : integer;
    i,j           : integer;
    s1,s2         : longint;
begin
CheckEm2:=false;
pred[ki+1]:=pred[1];
s1:=0;
for i:=1 to ki do s1:=s1+(g[pred[i]].x-g[pred[i+1]].x)*(g[pred
[i]].y+g[pred[i+1]].y);
s1:=abs(s1);
for j:=1 to m do begin
   s2:=0;
   for i:=1 to ki do s2:=s2+GetS(g[pred[i]],g[pred[i+1]],mon[j]);
   if s1<>s2 then exit;
end;
CheckEm2:=true;
end;

Function CheckEm(ki,kj : integer) : boolean;
var pi,pj         : array[1..MaxN]of byte;
    prd,k1,k2     : integer;
    i,j           : integer;
    s1,s2         : longint;
begin
prd:=ki;
k1:=0;
while prd>0 do begin
    inc(k1);
    pi[k1]:=prd;
    prd:=pred[prd];
   end;
prd:=kj;
k2:=0;
while prd>0 do begin
    inc(k2);
    pj[k2]:=prd;
    prd:=pred[prd];
   end;
CheckEm:=false;
for i:=1 to k1-1 do
   for j:=1 to k2-1 do begin
    if (pi[i]=pj[j])and(pi[i+1]=pj[j+1]) then exit;
    if (pi[i+1]=pj[j])and(pi[i]=pj[j+1]) then exit;
   end;
for i:=1 to k1-1 do begin
    if (pi[i]=ki)and(pi[i+1]=kj) then exit;
    if (pi[i]=kj)and(pi[i+1]=ki) then exit;
   end;
for i:=1 to k2-1 do begin
    if (pj[i]=ki)and(pj[i+1]=kj) then exit;
    if (pj[i]=kj)and(pj[i+1]=ki) then exit;
   end;
s1:=0;
for i:=1 to k1-1 do s1:=s1+(g[pi[i]].x-g[pi[i+1]].x)*(g[pi[i]].y+g
[pi[i+1]].y);
for i:=k2-1 downto 1 do s1:=s1+(g[pj[i+1]].x-g[pj[i]].x)*(g[pj
[i]].y+g[pj[i+1]].y);
s1:=s1+(g[kj].x-g[ki].x)*(g[kj].y+g[ki].y);
s1:=abs(s1);
for j:=1 to m do begin
   s2:=0;
   for i:=1 to k1-1 do s2:=s2+GetS(g[pi[i]],g[pi[i+1]],mon[j]);
   for i:=1 to k2-1 do s2:=s2+GetS(g[pj[i]],g[pj[i+1]],mon[j]);
   s2:=s2+GetS(g[ki],g[kj],mon[j]);
   if s1<>s2 then exit;
end;
CheckEm:=true;
end;

Procedure MakeMinDist(Num : integer);
Var Use      : array[1..MaxN]of byte;
     i,j,mi,k : integer;
     minv     : extended;
begin
fillchar(Use,SizeOf(Use),0);
Pred[Num]:=0;
for i:=1 to N do Min[i].D:=1E20;
Use[Num]:=1;
Min[Num].D:=0.0;
for i:=1 to N do
   if EP[Num,i]<2 then begin
    Min[i].D:=CP[Num,i];
    Min[i].V:=EP[Num,i];
    Pred[i]:=Num;
   end;
for k:=2 to N do begin
   minv:=1E30;
   for i:=1 to N do if Use[i]=0 then
    if Min[i].D<Minv then begin
     Minv:=Min[i].D;
     mi:=i;

Here's the problem (+)

Posted by Michael_Rybak 10 Feb 2002 22:31

Some vertexes may lay on the same straight line. I had a lot of
troubles with this.

Good luck!

Re: Well for this prob, I use Dijkstra !

Posted by Tran Nam Trung (trungduck@yahoo.com) 11 Feb 2002 08:25

> Some vertexes may lay on the same straight line. I had a lot of
> troubles with this.
>
> Good luck!

Can you find where my code wrong?(+)

Posted by Nazarov Denis (nsc2001@rambler.ru) 11 Feb 2002 18:59

Program t1065;{$N+}

Const MaxN = 50;
      MaxM = 1000;

Type Cor = record X,Y : longint end;

Var   Mon       : array[1..MaxM]of Cor;
      G         : array[1..MaxN]of Cor;
      CP        : array[1..MaxN,1..MaxN]of extended;
      EP        : array[1..MaxN,1..MaxN]of byte;
      Min       : array[1..MaxN]of record D : extended; V : byte; end;
      Pred      : array[1..MaxN]of byte;
      N,M,i,j,k : integer;
      b         : byte;
      D,Ans     : extended;

Function Dist(A,B : Cor) : extended;
begin
Dist:=sqrt(sqr(A.X-B.X)+sqr(A.Y-B.Y));
end;

Function Higher(Num1,Num2,Num3 : Cor) : byte;
Var w1,w2     : longint;
    x1,x2,x3 : longint;
    y1,y2,y3 : longint;
Begin
if Num1.X-Num2.X=0 then begin
    if Num1.X-Num3.X>0 then Higher:=0 else
    if Num1.X-Num3.X<0 then Higher:=1 else
    Higher:=2;
    exit;
   end;
if Num1.Y-Num2.Y=0 then begin
    if Num1.Y-Num3.Y>0 then Higher:=0 else
    if Num1.Y-Num3.Y<0 then Higher:=1 else
    Higher:=2;
    exit;
   end;
x1:=num1.x;
x2:=num2.x;
x3:=num3.x;       {1-higher line Num1-Num2}
y1:=num1.y;       {0-lower line Num1-Num2}
y2:=num2.y;       {2-on     line Num1-Num2}
y3:=num3.y;
w1:=(x1-x2)*(y3-y1);
w2:=(x3-x1)*(y1-y2);
if w1-w2>0 then Higher:=1 else
if w1-w2<0 then Higher:=0 else
Higher:=2;
end;

Procedure MakeMinDist(Num : integer);
Var Use      : array[1..MaxN]of byte;
     i,j,mi,k : integer;
     minv     : extended;
begin
fillchar(Use,SizeOf(Use),0);
Pred[Num]:=0;
for i:=1 to N do Min[i].D:=1E20;
Use[Num]:=1;
Min[Num].D:=0.0;
for i:=1 to N do
   if EP[Num,i]<2 then begin
    Min[i].D:=CP[Num,i];
    Min[i].V:=EP[Num,i];
    Pred[i]:=Num;
   end;
for k:=2 to N do begin
   minv:=1E30;
   for i:=1 to N do if Use[i]=0 then
    if Min[i].D<Minv then begin
     Minv:=Min[i].D;
     mi:=i;
    end;
   Use[mi]:=1;
   for i:=1 to N do
    if (i<>mi)and(Use[i]=0) then
     if EP[i,mi]<2 then
      if Min[i].D>Min[mi].D+CP[i,mi] then begin
       Min[i].D:=Min[mi].D+CP[i,mi];
       Min[i].V:=Min[mi].V;
       Pred[i]:=mi;
      end;
end;
end;

Function GetS(a,b,c : cor) : longint;
begin
GetS:=abs((a.x-b.x)*(a.y+b.y)+(b.x-c.x)*(b.y+c.y)+(c.x-a.x)*
(c.y+a.y));
end;

Function CheckEm(ki,kj : integer) : boolean;
var pi,pj         : array[1..MaxN]of byte;
    prd,k1,k2     : integer;
    i,j           : integer;
    s1,s2         : longint;
begin
prd:=ki;
k1:=0;
while prd>0 do begin
    inc(k1);
    pi[k1]:=prd;
    prd:=pred[prd];
   end;
prd:=kj;
k2:=0;
while prd>0 do begin
    inc(k2);
    pj[k2]:=prd;
    prd:=pred[prd];
   end;
CheckEm:=false;
for i:=1 to k1-1 do
   for j:=1 to k2-1 do begin
    if (pi[i]=pj[j])and(pi[i+1]=pj[j+1]) then exit;
    if (pi[i+1]=pj[j])and(pi[i]=pj[j+1]) then exit;
   end;
for i:=1 to k1-1 do begin
    if (pi[i]=ki)and(pi[i+1]=kj) then exit;
    if (pi[i]=kj)and(pi[i+1]=ki) then exit;
   end;
for i:=1 to k2-1 do begin
    if (pj[i]=ki)and(pj[i+1]=kj) then exit;
    if (pj[i]=kj)and(pj[i+1]=ki) then exit;
   end;
s1:=0;
for i:=1 to k1-1 do s1:=s1+(g[pi[i]].x-g[pi[i+1]].x)*(g[pi[i]].y+g
[pi[i+1]].y);
for i:=k2-1 downto 1 do s1:=s1+(g[pj[i+1]].x-g[pj[i]].x)*(g[pj
[i]].y+g[pj[i+1]].y);
s1:=s1+(g[kj].x-g[ki].x)*(g[kj].y+g[ki].y);
s1:=abs(s1);
for j:=1 to m do begin
   s2:=0;
   for i:=1 to k1-1 do s2:=s2+GetS(g[pi[i]],g[pi[i+1]],mon[j]);
   for i:=1 to k2-1 do s2:=s2+GetS(g[pj[i]],g[pj[i+1]],mon[j]);
   s2:=s2+GetS(g[ki],g[kj],mon[j]);
   if s1<>s2 then exit;
end;
CheckEm:=true;
end;

Function GetDist(Ni : integer) : boolean;
Var minv : extended;
    i,j : integer;
begin
minv:=1E50;
MakeMinDist(Ni);
for i:=1 to N-1 do if i<>Ni then
   for j:=i+1 to N do if j<>Ni then

Sorry for my message Tran Nam Trung and many thanks to Rybak Michael ! ! !

Posted by Nazarov Denis (nsc2001@rambler.ru) 11 Feb 2002 19:33