QBXT day1 拯救 蚂蚁和瓢虫 反质数

A 拯救

      九连环、格雷码、N阶立方体上的Hamilton回路、Hanoi塔是等价问题。把题目的格雷码解码以后，问题变成高精度二进制数转十进制。

program lan;
uses math;
const FileName='lan';p=10000;
type  num=array[0..100] of longint;
var   ans,tmp:num;
      n,i:longint;
      a:array[1..1000] of integer;
procedure fopen;
          begin
	  assign(input ,FileName+'.in' );
	  assign(output,FileName+'.out');
	  reset(input);rewrite(output);
	  end;
procedure fclose;
          begin close(input);close(output);end;
procedure ADD;
          var i,len:longint;
	      x:Qword;
          begin
	  len:=max(ans[0],tmp[0]);x:=0;
          for i:=1 to len do begin 
	    inc(ans[i],tmp[i]+x);
	    x:=ans[i] div p;
	    ans[i]:=ans[i] mod p;
	    end;
          while x>0 do begin
	    inc(len);ans[len]:=x mod p;
	    x:=x div p;end;
	  ans[0]:=len;
	  end;
procedure mul;
          var i,len:longint;
	      x:Qword;
	  begin
	  len:=tmp[0];x:=0;
          for i:=1 to len do begin
	    tmp[i]:=tmp[i]<<1+x;
	    x:=tmp[i] div p;
	    tmp[i]:=tmp[i] mod p;
	    end;
	  while x>0 do begin
	    inc(len);tmp[len]:=x mod p;
	    x:=x div p;end;
	  tmp[0]:=len;
	  end;
procedure print;
          var t,i,j:longint;
	      x:Qword;
	      s:array[1..10] of longint;
	  begin
	  if(ans[0]=1)and(ans[1]=0)
	    then writeln(0) else begin
          x:=ans[ans[0]];t:=0;
	  while x>0 do begin
	      inc(t);s[t]:=x mod 10;
	      x:=x div 10;end;
	   for j:=t downto 1 do write(s[j]);
          for i:=ans[0]-1 downto 1 do begin
            x:=ans[i];
            write(x div 1000,x mod 1000 div 100,
                  x mod 100 div 10,x mod 10);
	    end;
	  writeln;end;
	  end;
begin
fopen;
fillchar(ans,sizeof(ans),0);
fillchar(tmp,sizeof(tmp),0);
readln(n);
for i:=1 to n do read(A[i]);
for i:=n-1 downto 1 do
  A[i]:=A[i] xor A[i+1];
//for i:=n downto 1  do write(a[i]);writeln;
ans[0]:=1;ans[1]:=0;
tmp[0]:=1;tmp[1]:=1;
for i:=1 to n do begin
  if A[i]>0 then ADD;
  MUL;end;
print; fclose;
end.

 

B 蚂蚁和瓢虫

    核心思想就是一步让蚂蚁爬到位。抄标程做的，不多说。

program mro;
uses math;
const FileName='mro';
      maxn=5000;maxk=1000;
var   next,v:array[0..maxn*2] of longint;
      dis,head,vis,tree:array[0..maxn] of longint;
      cnt,pos:array[0..maxk] of longint;
      root,h,a,b,tot,flag,i,j,n,m:longint;
procedure fopen;
          begin
          assign( input,FileName+'.in' );
          assign(output,FileName+'.out');
          reset(input);rewrite(output);
          end;
procedure fclose;
          begin close(input);close(output);end;
procedure build(a,b:longint);
          begin
          inc(tot);v[tot]:=b;
          next[tot]:=head[a];
          head[a] :=tot;
          end;
procedure DFS(u:longint);
          var i:longint;
          begin
          vis[u]:=flag;i:=head[u];
          while i<>0 do begin
            if vis[v[i]]<>flag
              then begin
              DFS(v[i]);
              if(dis[u]>dis[v[i]]+1)or
                ((dis[u]=dis[v[i]]+1)and
                  (tree[v[i]]<tree[u]))
                then begin
                dis [u]:=dis [v[i]]+1;
                tree[u]:=tree[v[i]];
                end;end;
          i:=next[i];end;
          end;
procedure slove(u,time:longint);
          var i:longint;
          begin
          time:=min(dis[u],time);
          vis[u]:=flag;i:=head[u];
          while i<>0 do begin
            if vis[v[i]]<>flag
              then slove(v[i],time);
          i:=next[i];end;
          if dis[u]<=time then pos[tree[u]]:=u;
          end;
procedure deal(root:longint);
          var i:longint;
          begin
          filldword(dis,sizeof(dis)>>2,maxlongint-10);
          for i:=1 to m do dis[pos[i]]:=0;
          inc(flag);DFS(root);inc(cnt[tree[root]]);
          inc(flag);slove(root,dis[root]);
          end;

begin fopen;
readln(n);
for i:=1 to n-1 do
  begin
  read(a,b);
  build(a,b);
  build(b,a);
  end;
readln(m);
for i:=1 to m do read(pos[i]);
for i:=1 to m do tree[pos[i]]:=i;
readln(h);
for i:=1 to h do begin
  read(root);deal(root);end;
for i:=1 to m do
  writeln(pos[i],' ',cnt[i]);
fclose;end.

 

C 反质数

      把问题转化为找约数最大的数的集合中的最小值。当时打表做的，甚至写了具有友好的输入输出的素数分解用来找规律，结果没找到。。。。

      x>n以后要break，不然再乘几下就回饶了。 

program ant;
const P:array[1..20] of longint=(2,3,5,7,11,13,17,19,
                                 23,29,31,37,41,43,47,
                                 53,59,61,67,71);
      Filename='ant';
var   ans,anscnt:int64;
      n:longint;
procedure DFS(k,pre:integer;x,cnt:int64);
          var i:longint;
              temp:int64=1;
          begin
          if(x>n)or(k>9)then exit;//居然用前九个质数就能过
          if((cnt=anscnt)and(ans>x))or
            (cnt>anscnt)
            then begin
                 ans:=x;
                 anscnt:=cnt;
                 end;
          for i:=1 to pre do begin
            x:=x*P[k];if x>n then break;
            DFS(k+1,i,x,cnt*(i+1));
            end;
          end;
begin
readln(n);ans:=n;
DFS(1,trunc(ln(n)/ln(2)),1,1);
writeln(Ans);
end.