noipday3提高组模拟题————解题报告

1.方程式

思路：直接枚举根，然后通过逆向多项式乘法提出这个根因式。

参考程序：

var
  t,n,i,j:longint;
  a,b:array[0..11000]of longint;
function calc(k:longint):longint;
var
  i,tt:longint;
begin
  calc:=0;tt:=1;
  for i:=1 to n do
   begin
     calc:=calc+a[i]*tt;
    // if k=1 then writeln(calc);
     tt:=tt*k;
   end;
end;
procedure change(k:longint);
var
  i:longint;
begin
  b[1]:=a[1] div (-k);
  for i:=2 to n-1 do
   b[i]:=(b[i-1]-a[i])div k;
  n:=n-1;
  a:=b;
end;
begin
  assign(input,'equation.in');reset(input);
  assign(output,'equation.out');rewrite(output);
  read(n);
  n:=n+1;
  for i:=1 to n do read(a[i]);
  //for i:=1 to n shr 1 do begin t:=a[i];a[i]:=a[n-i+1];a[n-i+1]:=t;end;
 for i:=1 to 20 do
   while calc(i)=0 do
    begin
      write(i,' ');
      change(i);
      //for j:=1 to n do write(a[j],' ');writeln;
    end;
  close(input);close(output);
end.

2.高维宇宙

思路：标程是状压dp，我想的是二分图匹配。

            此题中质数只能是由奇数加偶数，因此可将一般图弄为二分图，网络流即可。

参考程序（标准的dinic算法,只有90分，据目测还有一个数据可能有问题）：

type
  edge=record
         tt,v,next:longint;
       end;
var
  e:array[0..110000]of edge;
  b,level,head,q,a:array[0..110000]of longint;
  cnt,cnt1,cnt2,n:longint;
procedure openfile;
begin
  assign(input,'prime.in');reset(input);
  assign(output,'prime.out');rewrite(output);
end;
procedure closfile;
begin
  close(input);close(output);
end;
procedure printf(k:longint);
begin
  write(k);
end;
function min(a,b:longint):longint;
begin
  if a<b then exit(a);
  exit(b);
end;
procedure init;
var
  i,x:longint;
begin
  readln(n);
  for i:=1 to n do
   begin
     read(x);
     if x and 1=1 then begin cnt1:=cnt1+1;a[cnt1]:=x;end
      else begin cnt2:=cnt2+1;b[cnt2]:=x;end;
   end;
end;
procedure insert(u,v,w:longint);
begin
  cnt:=cnt+1;
  e[cnt].tt:=v;
  e[cnt].v:=w;
  e[cnt].next:=head[u];
  head[u]:=cnt;
end;
procedure build;
var
  ok:array[0..2200]of boolean;
  i,j:longint;
begin
  ok[1]:=true;
  for i:=2 to trunc(sqrt(2100)) do//第二版：：大家注意到了么？去掉之后就是。。。。Accepted......
   if not ok[i] then
    for j:=2 to 2100 div i do
     ok[i*j]:=true;
  for i:=1 to cnt1 do
   for j:=1 to cnt2 do
    if not ok[a[i]+b[j]] then
     begin
       //writeln(i,' ',j+cnt1);
       insert(i,j+cnt1,1);
       insert(j+cnt1,i,0);
     end;
  for i:=1 to cnt1 do begin {writeln(0,' ',i);}insert(0,i,1);insert(i,0,0);end;
  for i:=1 to cnt2 do begin {writeln(i,' ',n+1);}insert(i,n+1,1);insert(n+1,i,0);end;
end;
function bfs:boolean;
var
  h,t,i,now:longint;
begin
  fillchar(level,sizeof(level),$ff);
  h:=0;t:=1;q[1]:=0;level[0]:=0;
  while h<t do
   begin
     h:=h+1;
     now:=q[h];
     i:=head[now];
     while i>0 do
      begin
        if (e[i].v>0)and(level[e[i].tt]=-1) then
         begin
           t:=t+1;
           q[t]:=e[i].tt;
           level[e[i].tt]:=level[now]+1;
         end;
        i:=e[i].next;
      end;
   end;
  if level[n+1]=-1 then exit(false);
  exit(true);
end;
function dfs(x,f:longint):longint;
var
  i,used,w:longint;
begin
  if x=n+1 then exit(f);
  used:=0;i:=head[x];
  while i>0 do
   begin
     if (e[i].v>0)and(level[e[i].tt]=level[x]+1) then
      begin
        w:=f-used;
        w:=dfs(e[i].tt,min(e[i].v,w));
        e[i].v:=e[i].v-w;
        e[i xor 1].v:=e[i xor 1].v+w;
        used:=used+w;
        if used=f then exit(f);
      end;
     i:=e[i].next;
   end;
  if used=0 then level[x]:=-1;
  exit(used);
end;
procedure dinic;
const
  INF=maxlongint shr 2;
var
  maxflow:longint;
begin
  maxflow:=0;
  while bfs do
   maxflow:=maxflow+dfs(0,INF);
  printf(maxflow);
end;
procedure solve;
begin
  dinic;
end;
procedure main;
begin
  openfile;
  init;
  build;
  solve;
  closfile;
end;
begin
  main;
end.

第二版：：发现问题之所在————筛质数打错了，为什么要开根号呢？

此题可用状压dp写：

var
  e:array[0..101000]of record
                        x,n:longint;
                       end;
  l,t,nx,x,k,ans,b0,tt,a0,i,j,n:longint;
  key:array[0..50,0..2001000]of boolean;
  a,b:array[0..101000]of longint;
  ok:array[0..22000]of boolean;
function min(a,b:longint):longint;
begin if a<b then exit(a);exit(b);end;
function max(a,b:longint):longint;
begin if a>b then exit(a);exit(b);end;
procedure build;
var
  i,j:longint;
begin
  ok[1]:=true;
  fillchar(ok,sizeof(ok),0);
  for i:=2 to 21000 do
   if not ok[i] then
    for j:=2 to 21000 div i do
     ok[i*j]:=true;
end;
procedure add(x,y:longint);
begin
  l:=l+1;//writeln(x,' ',y);
  e[l].x:=y;e[l].n:=e[x].n;e[x].n:=l;
end;
function count(k:longint):longint;
begin
  count:=0;
  while k>0 do
   begin
     count:=count+k and 1;
     k:=k shr 1;
   end;
end;
begin
  assign(input,'prime.in');reset(input);
  assign(output,'prime.out');rewrite(output);
  readln(n);
  for i:=1 to n do
   begin
     read(tt);
     if tt and 1=1 then begin a0:=a0+1;a[a0]:=tt;end
      else begin b0:=b0+1;b[b0]:=tt;end;
   end;
  nx:=min(a0,b0);
  if b0<a0 then
   begin
     for i:=0 to nx do
      begin
        t:=a[i];a[i]:=b[i];b[i]:=t;
      end;
     t:=a0;a0:=b0;b0:=t;
     for i:=nx+1 to b0 do
      b[i]:=a[i];
   end;
  l:=n;
  build;
  for i:=1 to b0 do
    for j:=1 to a0 do
     if not ok[b[i]+a[j]] then add(i,j);
  key[0,0]:=true;
  for i:=0 to b0-1 do
   for j:=0 to 1<<nx-1 do
    if key[i,j] then
     begin
       key[i+1,j]:=true;
       x:=e[i+1].n;
       while x>0 do
        begin
          k:=e[x].x-1;
          key[i+1,j or (1<<k)]:=true;
          x:=e[x].n;
        end;
     end;
  ans:=0;
  for j:=0 to 1<<nx-1 do
   if key[b0,j] then ans:=max(ans,count(j));
  write(ans);
  close(input);close(output);
end.

3.麻将

思路：枚举打出的牌，再枚举要听的牌，深搜判断胡没胡即可。

参考程序：

var
  {debug:array[0..1000]of record
                          no,num,flag:longint;
  end;}
  cnt:longint;
  c,b,inq,x,a:array[0..1000]of longint;
procedure openfile;
begin
  assign(input,'mahjong.in');reset(input);
  assign(output,'mahjong.out');rewrite(output);
end;
procedure closfile;
begin
  close(input);close(output);
end;
procedure init;
var
  num,ch1,ch2:char;
  i:longint;
begin
  for i:=1 to 14 do
   begin
     read(num,ch1,ch2);
     a[i]:=(ord(num)-48)*10+ord(ch1='p')+ord(ch1='w')*2;
     x[a[i]]:=x[a[i]]+1;
   end;
  //s=0 p=1 w=2
end;
procedure prepare;
var
  i:longint;
begin
  for i:=1 to 9 do
   begin
     cnt:=cnt+1;
     b[cnt]:=i*10;
     b[cnt+1]:=i*10+1;
     b[cnt+2]:=i*10+2;
     cnt:=cnt+2;
   end;
end;
{procedure print;
var
  i:longint;
begin
  for i:=1 to 4 do with debug[i] do writeln(no,' ',num,' ',flag);
  for i:=1 to 14 do write(inq[c[i]],' ');writeln;
end;}
function dfs(last,step:longint):boolean;
var
  i,u:longint;
  bool:boolean;
begin
  if last=2 then
   begin
     for i:=1 to 14 do
      if inq[c[i]]=2 then exit(true);
     exit(false);
   end;
  bool:=false;
  for i:=1 to 14 do
    begin
      if inq[c[i]]>2 then
       begin
         inq[c[i]]:=inq[c[i]]-3;
         //debug[step].no:=i;debug[step].num:=c[i];debug[step].flag:=1;
         bool:=bool or dfs(last-3,step+1);
         inq[c[i]]:=inq[c[i]]+3;
       end;//duizi
      if bool then exit(true);
      if (inq[c[i]]>0)and(inq[c[i]+10]>0)and(inq[c[i]+20]>0) then
       begin
         inq[c[i]]:=inq[c[i]]-1;inq[c[i]+10]:=inq[c[i]+10]-1;inq[c[i]+20]:=inq[c[i]+20]-1;
         //debug[step].no:=i;debug[step].num:=c[i];debug[step].flag:=2;
         bool:=bool or dfs(last-3,step+1);
         inq[c[i]]:=inq[c[i]]+1;inq[c[i]+10]:=inq[c[i]+10]+1;inq[c[i]+20]:=inq[c[i]+20]+1;
       end;//shunzi
      if bool then exit(true);
    end;
  exit(false);
end;
function check(tno,k:longint):boolean;
var tlt:longint;
begin
  inq:=x;c:=a;
  inq[k]:=inq[k]+1;inq[a[tno]]:=inq[a[tno]]-1;
  c[tno]:=k;
  {if k=b[1] then
   begin
     for tlt:=1 to 14 do write(c[tlt]:4);writeln;
     for tlt:=1 to 14 do write(inq[c[tlt]]:4);writeln;writeln;
   end;}
  exit(dfs(14,1));
end;
procedure solve;
var
  max,tt,no,i,j,tlt:longint;
begin
  max:=0;no:=0;
  for i:=1 to 14 do
   begin
     //s=0 p=1 w=2
     tt:=0;
     for j:=1 to cnt do
      if inq[b[j]]<4 then
       if check(i,b[j]) then
        begin
          tt:=tt+5-inq[b[j]];
          //if i=9 then writeln(b[j],' ',tt);
        end;
     if tt>max then begin no:=i;max:=tt;end;
   end;
  write(no,' ',max);
end;
procedure main;
begin
  openfile;
  init;
  prepare;
  solve;
  closfile;
end;
begin
  main;
end.