hnoi2006 总结

这两天考了一下06年湖南省选题

day1：
第一题：枚举+二分图匹配
    因为不太记得匈牙利所有最大流写的。。常数巨丑。。囧，
第二题：很水的递推
    没看出来。。还想着自己用类似数位统计的方法构造。。
第三题：贪心+bfs
    和标准解法类似，考试时a的
第四题：据说和自动机有关？？不会。

day2：
第一题：dp+kmp
    好吧。。kmp不太熟，没看出来
第二题：类似最小生成树的贪心
    看错题了。。。。。。。
第三题：递推
    因为没想清楚情况所以纠结了很久，其实就是一递推。。幸好这题a了，不然就暴零了。。
    但貌似数据很水，随便骗都有60分。。
第四题：暴力搜或者dp
    这题数据10个点都有问题。。

 

以下是代码：

type ki=^node; node=record data,dis:longint; next,last:ki;end; var a,b,c:array[0..2010] of ki; sf,f:array[0..2010] of longint; n,m,x,y,i,j,ans,ans1,dd:longint; procedure newd(x,y,z:longint); begin if a[x]=nil then begin new(a[x]);c[x]:=a[x];end else begin new(c[x]^.next);c[x]:=c[x]^.next;end; c[x]^.data:=y;c[x]^.next:=nil;c[x]^.dis:=z; if a[y]=nil then begin new(a[y]);c[y]:=a[y];end else begin new(c[y]^.next);c[y]:=c[y]^.next;end; c[y]^.data:=x;c[y]^.next:=nil;c[y]^.dis:=0; c[x]^.last:=c[y];c[y]^.last:=c[x]; end; procedure search(i:longint); begin b[i]:=a[i]; while b[i]<>nil do begin if (b[i]^.data<>0)and(b[i]^.dis=0) then begin f[b[i]^.data-n]:=i-1;exit;end; b[i]:=b[i]^.next;end; end; function did(i,ss:longint):longint; var j,min,s,t:longint; begin if i=n+m+1 then exit(ss); b[i]:=a[i];min:=n+m+1;t:=ss; while b[i]<>nil do begin j:=b[i]^.data; if b[i]^.dis>0 then begin if f[i]=f[j]+1 then begin if b[i]^.dis>t then s:=t else s:=b[i]^.dis; s:=did(j,s); dec(b[i]^.dis,s); dec(t,s); inc(b[i]^.last^.dis,s); if f[0]>n+m+1 then exit(ss-t); if t=0 then break;end; if min>f[j] then min:=f[j];end; b[i]:=b[i]^.next;end; if ss=t then begin dec(sf[f[i]]); if sf[f[i]]=0 then f[0]:=n+m+2; f[i]:=min+1; inc(sf[f[i]]);end; exit(ss-t); end; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); readln(n,m); for i:=1 to m do begin read(x,y); inc(x);inc(y); newd(x,i+n,1); newd(y,i+n,1);end; for i:=1 to n do newd(0,i,1); ans:=0;dd:=0; for i:=1 to m do begin newd(n+i,n+m+1,1); ans1:=ans; sf[0]:=n+m+2; fillchar(f,sizeof(f),0); while f[0]<n+m+2 do ans:=ans+did(0,maxlongint); if ans=ans1 then break else inc(dd);end; writeln(dd); if dd>0 then begin fillchar(f,sizeof(f),0); for j:=1 to n do search(j); for j:=1 to dd do writeln(f[j]);end; close(input);close(output); end.

var n,i,k,m,td:longint; f,s:array[0..33] of longint; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); readln(n); m:=0; while n>0 do begin inc(m);f[m]:=(n+1) shr 1; n:=n-f[m];end; writeln(m); for i:=m downto 2 do write(f[i],' '); writeln(f[1]); close(input);close(output); end.

const b:array[1..8,1..2] of longint=((1,2),(1,-2),(2,1),(2,-1),(-1,2),(-1,-2),(-2,1),(-2,-1)); var x,y,xx,yy,tx,ty,ans,tt,i,j:longint; t:array[0..2001,1..2] of longint; f:array[-20..20,-20..20] of longint; procedure newd(x,y,z:longint); begin if (abs(x)>15)or(abs(y)>15) then exit; if f[x,y]<>-1 then exit; f[x,y]:=z; inc(tt);t[tt,1]:=x;t[tt,2]:=y; end; procedure did(var x:longint;y:longint); begin if x>0 then dec(x,y) else inc(x,y); end; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); read(x,y,xx,yy); x:=abs(xx-x);y:=abs(yy-y); fillchar(f,sizeof(f),$ff); t[1,1]:=0;t[1,2]:=0;tt:=1;i:=0;f[0,0]:=0; repeat inc(i); for j:=1 to 8 do newd(t[i,1]+b[j,1],t[i,2]+b[j,2],f[t[i,1],t[i,2]]+1); until i=tt; ans:=0; while (abs(x)>10)or(abs(y)>10) do begin tx:=abs(x);ty:=abs(y);inc(ans); if tx>ty then begin did(x,2);did(y,1);end else begin did(x,1);did(y,2);end;end; writeln(ans+f[x,y]); close(input);close(output); end.

var f:array[0..10001,0..32] of ansistring; s:array[0..15] of ansistring; mul,sl:array[0..10001] of longint; l:array[0..10001,0..32] of longint; p:array[0..15,0..700] of longint; i,j,n,m,k,ll,kk:longint; ss:ansistring; procedure did(var s,t:ansistring;var l1,l2:longint;k:longint); var i,j:longint; begin ss:=s; j:=0; for i:=1 to l1 do begin while (j>0)and(s[i]<>t[j+1]) do j:=p[k,j]; if t[j+1]=s[i] then inc(j); if j=l2 then exit;end; ss:=ss+copy(t,j+1,l2-j); end; function check(i,j:longint):boolean; begin if (l[i,j]=0)or(l[i,j]>ll) then exit(true); if l[i,j]<ll then exit(false); if f[i,j]>ss then exit(true);exit(false); end; procedure pr(k:longint); var i,j:longint; begin j:=0; for i:=2 to sl[k] do begin while (j>0)and(s[k,j+1]<>s[k,i]) do j:=p[k,j]; if s[k,j+1]=s[k,i] then inc(j); p[k,i]:=j;end; end; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); readln(n); for i:=1 to n do begin readln(s[i]);sl[i]:=length(s[i]);end; fillchar(p,sizeof(p),0); for i:=1 to n do pr(i); mul[1]:=1; for i:=2 to n do mul[i]:=mul[i-1]*2; m:=mul[n]*2-1; for i:=1 to m do for j:=1 to n do f[i,j]:=''; fillchar(l,sizeof(l),0); for i:=1 to n do begin f[mul[i],i]:=s[i];l[mul[i],i]:=length(s[i]);end; for i:=1 to m-1 do for kk:=1 to n do if f[i,kk]<>'' then for j:=1 to n do if (i and mul[j])=0 then begin k:=i+mul[j];did(f[i,kk],s[j],l[i,kk],sl[j],j);ll:=length(ss); if check(k,j) then begin f[k,j]:=ss;l[k,j]:=ll;end;end; for i:=1 to n do begin ss:=f[m,i];ll:=length(ss); if check(0,0) then begin f[0,0]:=ss;l[0,0]:=ll;end;end; writeln(f[0,0]); close(input);close(output); end.

var c:array[1..2,0..20001] of longint; x,y,f,p,d:array[0..20001] of longint; xx,i,n,k,m,yy,l,ans:longint; procedure swap(i,j:longint); begin if i=j then exit; c[1,i]:=c[1,i]+c[1,j];c[1,j]:=c[1,i]-c[1,j];c[1,i]:=c[1,i]-c[1,j]; c[2,i]:=c[2,i]+c[2,j];c[2,j]:=c[2,i]-c[2,j];c[2,i]:=c[2,i]-c[2,j]; x[i]:=x[i]+x[j];x[j]:=x[i]-x[j];x[i]:=x[i]-x[j]; y[i]:=y[i]+y[j];y[j]:=y[i]-y[j];y[i]:=y[i]-y[j]; d[i]:=d[i]+d[j];d[j]:=d[i]-d[j];d[i]:=d[i]-d[j]; end; procedure sort(l,r,k:longint); var i,j,xx,x:longint; begin i:=l;j:=r; x:=c[k,(l+r)div 2];xx:=c[3-k,(l+r)div 2]; repeat while (c[k,i]<x)or((c[k,i]=x)and(c[3-k,i]<xx)) do inc(i); while (c[k,j]>x)or((c[k,j]=x)and(c[3-k,j]>xx)) do dec(j); if i<=j then begin swap(i,j);inc(i);dec(j);end; until i>j; if i<r then sort(i,r,k); if l<j then sort(l,j,k); end; procedure getf(x:longint); begin if x=f[x] then exit; getf(f[x]);f[x]:=f[f[x]]; end; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); read(n,k,m); for i:=1 to m do begin read(x[i],y[i],c[1,i],c[2,i]);d[i]:=i;end; sort(1,m,1); for i:=1 to n do f[i]:=i; fillchar(p,sizeof(p),0); for i:=1 to m do begin getf(x[i]);getf(y[i]); xx:=f[x[i]];yy:=f[y[i]]; if xx<>yy then begin f[xx]:=f[yy];p[d[i]]:=1; if c[1,i]>ans then ans:=c[1,i]; dec(k); if k=0 then break;end;end; sort(i+1,m,2); l:=i+1; for i:=l to m do begin getf(x[i]);getf(y[i]); xx:=f[x[i]];yy:=f[y[i]]; if xx<>yy then begin f[xx]:=f[yy];p[d[i]]:=2; if c[2,i]>ans then ans:=c[2,i];end;end; writeln(ans); for i:=1 to m do if p[i]<>0 then writeln(i,' ',p[i]); close(input);close(output); end.

var f:array[0..101,0..101] of int64; ans:int64; n,m,i,j:longint; begin assign(input,'input.txt');reset(input); assign(output,'output.txt');rewrite(output); readln(m,n); for i:=1 to m do f[1,i]:=2; for i:=1 to n do f[i,1]:=2; for i:=2 to n do for j:=2 to m do f[i,j]:=f[i-1,j-1]+f[i,j-1]; ans:=2; for i:=1 to m-1 do ans:=ans+f[n,i]; writeln(ans); close(input);close(output); end.