usaco 3.3 fence 2008.11.7

最新推荐文章于 2016-04-11 13:03:35 发布

原创最新推荐文章于 2016-04-11 13:03:35 发布 · 386 阅读

0 ·

本内容遵循CC 4.0 BY-SA版权协议

USACO 专栏收录该内容

47 篇文章

订阅专栏

本文探讨USACO竞赛中围栏问题的两种Pascal程序解决方案，涉及寻找欧拉回路、处理奇偶节点及优化算法以通过所有测试案例的技术细节。

usaco 3.3 fence 2008.11.7

program1:过六组，超时两组

{

ID:

PROG: fence

LANG: PASCAL

}

program p_fence;
const fin='fence.in';fout='fence.out';
var f1,f2:text;
      map:array[1..500,1..500]of longint;
      b,c,a:array[1..500]of longint;
      m1,n,m,i,j,od,t,r,p:longint;
      flag:boolean;
procedure init;
var i,j,x,y:longint;
begin
      assign(f1,fin);reset(f1);assign(f2,fout);rewrite(f2);
      fillchar(map,sizeof(map),0);
      fillchar(a,sizeof(a),0);
      read(f1,n);od:=0;m:=0;m1:=maxlongint;
      for i:=1 to n do
        begin
          read(f1,x,y);inc(a[x]);inc(a[y]);
          inc(map[x,y]);inc(map[y,x]);
          if x<m1 then m1:=x;if y<m1 then m1:=y;
          if x>m then m:=x;if y>m then m:=y;
        end;
      for i:=1 to n do
             if a[i] mod 2=1 then begin inc(od);b[od]:=i;end;

end;
procedure print;
var i:longint;
begin writeln(f2,r);for i:=1 to p-1 do writeln(f2,c[i]);
      if od=0 then writeln(f2,r);end;
procedure deal(s,k:longint);
var i:longint;
begin
      if (k=p) then begin print;close(f2);halt;end
      else
      for i:=1 to m do
            if (map[s,i]>0) then begin dec(map[s,i]);dec(map[i,s]);c[k]:=i;deal(i,k+1);
                                 inc(map[s,i]);inc(map[i,s]);end;
end;
procedure doit;
var j:longint;
begin
   if n=1 then begin writeln(f2,m1);writeln(f2,m);close(f2);halt;end;
   if od=0 then
           for j:=m1 to m do
             if a[j]>0 then begin
             p:=n;r:=j;t:=j;deal(1,1);end;

   if od=2 then begin p:=n+1;r:=b[1];t:=b[2];deal(b[1],1);end;
end;
begin init; doit;close(f1);close(f2);end.

Program2

{学到了新方法下面**处}

{

ID:

PROG: fence

LANG: PASCAL

}

program p_fence;
const fin='fence.in';fout='fence.out';
var f1,f2:text;
      map:array[1..500,1..500]of word;
      b:array[1..3]of word;
      a:array[1..500]of word;
      c:array[1..1025]of word;{这里，路径中的点数，不一定就是500，这里在第八组一直卡，终于知道是怎么回事了}
      m1,n,m,i,j,od,t,r,p,oo:longint;
      flag:boolean;
procedure init;
var i,j,x,y:longint;
begin
      assign(f1,fin);reset(f1);assign(f2,fout);rewrite(f2);
      fillchar(map,sizeof(map),0);
      fillchar(a,sizeof(a),0);
      read(f1,n);od:=0;m:=0;m1:=maxlongint;oo:=0;
      for i:=1 to n do
        begin
          read(f1,x,y);
         inc(a[x]);inc(a[y]);//a[i],与点x相连的有多少条边，用于找欧拉回路的起点
         inc(map[x,y]);inc(map[y,x]);{要累加，切不可用boolean}//与点（x,y）相连的有多少条边
          if x<m1 then m1:=x;if y<m1 then m1:=y;
          if x>m then m:=x;if y>m then m:=y;
         {要找出最大最小，题目不一定从一开始}
        end;
      for i:=1 to n do
             if a[i] mod 2=1 then begin inc(od);b[od]:=i;end;//看有没有奇点

end;
procedure print;
var i:longint;
begin for i:=n+1 downto 1 do writeln(f2,c[i]);end;
{*******************}
procedure deal(s:longint);
var i:longint;

      begin
      for i:=m1 to m do
            if (map[s,i]>0) then begin dec(map[s,i]);dec(map[i,s]);deal(i);{不回溯}
       end;inc(oo);c[oo]:=s;{在循环外面记录路径}
       end;
{*************************}

procedure doit;
var j:longint;
begin
   if n=1 then begin writeln(f2,m1);writeln(f2,m);close(f2);halt;end;//只有一个栅栏的单独处理
   if od=0 then//全部是偶点
       begin
             p:=n;r:=m1;t:=m;deal(1);end;

   if od=2 then begin p:=n+1;r:=b[1];t:=b[2];deal(b[1]);end;
end;//r起点；t终点
begin init; doit;print;close(f1);close(f2);end.