# NOIP2009提高组复赛题解

1、潜伏者 program spy; var v: array['A'..'Z'] of boolean; p, q: array['A'..'Z'] of char; a, b: string; j: char; i: integer; procedure stop; begin writeln('Failed'); close(input); close(output); halt; end; begin assign(input, 'spy.in'); reset(input); assign(output, 'spy.out'); rewrite(output); readln(a); readln(b); fillchar(v, sizeof(v), 0); for i := 1 to length(a) do begin v[a[i]] := true; p[a[i]] := b[i]; q[b[i]] := a[i]; end; for j := 'A' to 'Z' do if not v[j] then stop; for i := 1 to length(a) do begin if p[a[i]] <> b[i] then stop; if q[b[i]] <> a[i] then stop; end; readln(a); for i := 1 to length(a) do write(p[a[i]]); writeln; close(input); close(output); end.

2、Hankson 的趣味题

inc(c[m]); p:=p div i; until p mod i<>0; end; inc(i); end; if p<>1 then begin inc(m); x[m]:=p; c[m]:=1; end; dfs(1,1); end; begin readln(n); for i:=1 to n do begin readln(a0,a1,b0,b1); fillchar(p,sizeof(p),0); fillchar(x,sizeof(x),0); fillchar(c,sizeof(c),0); m:=0; tot:=0; t:=0; work(b1); for j:=1 to tot do if (gcd(p[j],a0)=a1) and ((p[j] div gcd(p[j],b0) * b0)=b1) then inc(t); writeln(t); end; end. 思路三： 和思路二有异曲同工之妙。我们可以先预处理 trunc(sqrt(2000000000))以内的质数，然后 每读入一组数据，初始答案 ans=1,然后我们循环质数，看 a0、a1、b0、b1 里面有多少个 该质数因子，并且将这四个数分别消去所有该质数因子。我们设求出来的该因子个数分别 是 t1、t2、t3、t4。如果数据合法，那么 t1>=t2,t3<=t4。根据最大公约数和最小公倍数的 定义，我们要求的数所拥有的该质因子个数 s 必须要同时满足以下限制条件： 若 t1>t2,则 s=t2 若 t1=t2，则 s>=t2 若 t3<t4,则 s=t4

begin inc(l);a0:=a0 div prime[i]; end; while a1 mod prime[i]=0 do begin inc(r);a1:=a1 div prime[i]; end; while b0 mod prime[i]=0 do begin inc(l2);b0:=b0 div prime[i]; end; while b1 mod prime[i]=0 do begin inc(r2);b1:=b1 div prime[i]; end; if l>r then need[i]:=r; if l2<r2 then begin if (need[i]>-1)and(need[i]<>r2) then begin pd:=false;break; end; need[i]:=r2; end; if need[i]=-1 then if r2<r then begin pd:=false;break; end else ans:=ans*(r2-r+1); end; if i=p then if a0>1 then begin inc(i);prime[i]:=a0; l:=0;r:=0;l2:=0;r2:=0; while a0 mod prime[i]=0 do begin inc(l);a0:=a0 div prime[i]; end; while a1 mod prime[i]=0 do begin inc(r);a1:=a1 div prime[i]; end;

while b0 mod prime[i]=0 do begin inc(l2);b0:=b0 div prime[i]; end; while b1 mod prime[i]=0 do begin inc(r2);b1:=b1 div prime[i]; end; if l>r then need[i]:=r; if l2<r2 then begin if (need[i]>-1)and(need[i]<>r2) then begin pd:=false; end; need[i]:=r2; end; if need[i]=-1 then if r2<r then begin pd:=false; end else ans:=ans*(r2-r+1); dec(i); end; if i=p then if b1>1 then begin inc(i);prime[i]:=b1; l:=0;r:=0;l2:=0;r2:=0; while a0 mod prime[i]=0 do begin inc(l);a0:=a0 div prime[i]; end; while a1 mod prime[i]=0 do begin inc(r);a1:=a1 div prime[i]; end; while b0 mod prime[i]=0 do begin inc(l2);b0:=b0 div prime[i]; end; while b1 mod prime[i]=0 do begin inc(r2);b1:=b1 div prime[i];

end; if l>r then need[i]:=r; if l2<r2 then begin if (need[i]>-1)and(need[i]<>r2) then begin pd:=false; end; need[i]:=r2; end; if need[i]=-1 then if r2<r then begin pd:=false; end else ans:=ans*(r2-r+1); dec(i); end; if not pd then writeln(0) else writeln(ans); end; end.

begin inc(k); p[k] := s; exit; end; dfs(i + 1, s); for j := 1 to c[i] do begin s := s * x[i]; dfs(i + 1, s); end; end; procedure get(b: longint); var i: longint; begin m := 0; i := 2; while i <= sqrt(b) + 1e-6 do begin if b mod i = 0 then begin inc(m); x[m] := i; c[m] := 0; repeat inc(c[m]); b := b div i; until b mod i <> 0; end; inc(i); end; if b <> 1 then begin inc(m); x[m] := b; c[m] := 1; end; k := 0; dfs(1, 1); end; begin assign(input, 'son.in'); reset(input);

assign(output, 'son.out'); rewrite(output); read(n); for i := 1 to n do begin read(a0, a1, b0, b1); get(b1); t := 0; for j := 1 to k do if (gcd(p[j], a0) = a1) and (p[j] div gcd(p[j], b0) * b0 = b1) then inc(t); writeln(t); end; close(input); close(output); end. 3、最优贸易

end; procedure init; var i,j,k,l:longint; begin readln(n,m); fillchar(a,sizeof(a),255); ls:=0; for i:=1 to n do read(v[i]); for i:=1 to m do begin readln(j,k,l); if l=1 then insert_e(j,k,1,2) else insert_e(j,k,3,3); end; end; function max(a,b:longint):longint; begin if a>b then exit(a) else exit(b); end; function min(a,b:longint):longint; begin if a<b then exit(a) else exit(b); end; procedure spfa1; var i,k,open,closed:longint; begin fillchar(c,sizeof(c),127); fillchar(f,sizeof(f),0); f[1]:=true; open:=0; closed:=1; stack[1]:=1; c[1]:=v[1]; while open<closed do begin inc(open); k:=stack[open mod maxn]; f[k]:=false; i:=a[k]; while i<>-1 do begin if (seg[i].f and 1=1)and(min(c[k],v[seg[i].t])<c[seg[i].t]) then

begin c[seg[i].t]:=min(c[k],v[seg[i].t]); if not f[seg[i].t] then begin f[seg[i].t]:=true; inc(closed); stack[closed mod maxn]:=seg[i].t; end; end; i:=seg[i].next; end; end; end; procedure spfa2; var i,k,open,closed:longint; begin fillchar(d,sizeof(d),0); fillchar(f,sizeof(f),0); f[n]:=true; open:=0; closed:=1; stack[1]:=n; d[n]:=v[n]; while open<closed do begin inc(open); k:=stack[open mod maxn]; f[k]:=false; i:=a[k]; while i<>-1 do begin if (seg[i].f and 2=2)and(max(d[k],v[seg[i].t])>d[seg[i].t]) then begin d[seg[i].t]:=max(d[k],v[seg[i].t]); if not f[seg[i].t] then begin f[seg[i].t]:=true; inc(closed); stack[closed mod maxn]:=seg[i].t; end; end; i:=seg[i].next; end;

end; end; procedure main; var i,ans:longint; begin spfa1; spfa2; ans:=0; for i:=1 to n do ans:=max(ans,d[i]-c[i]); writeln(ans); end; begin assign(input,'trade.in'); reset(input); assign(output,'trade.out'); rewrite(output); init; main; close(input); close(output); end.

t := j; next := g1[i]; end; g1[i] := s; with e2[s] do begin t := i; next := g2[j]; end; g2[j] := s; end; begin read(n, m); for i := 1 to n do read(b[i]); fillchar(g1, sizeof(g1), 0); fillchar(g2, sizeof(g2), 0); s := 0; for k := 1 to m do begin read(i, j, z); link(i, j); if z = 2 then link(j, i); end; end; begin assign(input, 'trade.in'); reset(input); assign(output, 'trade.out'); rewrite(output); init; fillchar(v, sizeof(v), 0); a[1] := b[1]; for i := 2 to n do a[i] := 100000; f := 0; r := 1; q[1] := 1; while f <> r do begin if f = maxn then f := 1 else inc(f); k := q[f]; v[k] := false; p := g1[k]; while p <> 0 do begin

with e1[p] do if a[t] > a[k] then begin a[t] := a[k]; if a[t] > b[t] then a[t] := b[t]; if not v[t] then begin if r = maxn then r := 1 else inc(r); q[r] := t; v[t] := true; end; end; p := e1[p].next; end; end; s := 0; fillchar(v, sizeof(v), 0); f := 1; r := 1; q[1] := n; v[n] := true; if s < b[n] - a[n] then s := b[n] - a[n]; while f <= r do begin p := g2[q[f]]; while p <> 0 do begin with e2[p] do if not v[t] then begin v[t] := true; if s < b[t] - a[t] then s := b[t] - a[t]; inc(r); q[r] := t; end; p := e2[p].next; end; inc(f); end; writeln(s); close(input); close(output); end.

4、靶形数独 program d_1; var usei,usej,usex:array[0..10,0..10] of boolean; usep:array[0..100] of boolean; maxi,a:array[0..10,0..10] of longint; t,s,max,tot,i,j,k,n,m,p:longint; x,y:array[0..100] of longint; function solve(i,J:longint):longint; var s,s1:longint; begin if (i<=j) then s:=i else s:=j; if (10-i<=10-j) then s1:=10-i else s1:=10-j; if (s=1) or (s1=1) then begin solve:=6; exit;end; if (s=2) or (s1=2) then begin solve:=7; exit;end; if (s=3) or (s1=3) then begin solve:=8; exit;end; if (s=4) or (s1=4) then begin solve:=9; exit;end; if (s=5) or (s1=5) then begin solve:=10;exit;end; end; function pr(i,j:longint):longint; begin pr:=(i-1) div 3*3+(j-1) div 3+1; end; procedure tryit(pp,now:longint); var t,min,w,j:longint; begin if pp=s+1 then begin if now>max then begin max:=now; maxi:=a; end end else begin t:=0; min:=999999; for i:=1 to s do if (a[x[i],y[i]]=0) and (not(usep[i])) then begin w:=0; for j:=1 to 9 do if (usei[x[i],j]) and (usej[y[i],j]) and (usex[pr(x[i],y[i]),j]) then begin

inc(w); if w>=min then break; end; if w<min then begin min:=w; t:=i; end; end; if min=0 then exit; usep[t]:=true; for j:=1 to 9 do if (usei[x[t],j]) and (usej[y[t],j]) and (usex[pr(x[t],y[t]),j]) then begin usei[x[t],j]:=false; usej[y[t],j]:=false; usex[pr(x[t],y[t]),j]:=false; a[x[t],y[t]]:=j; tryit(pp+1,now+solve(x[t],y[t])*j); a[x[t],y[t]]:=0; usei[x[t],j]:=true; usej[y[t],j]:=true; usex[pr(x[t],y[t]),j]:=true; end; usep[t]:=false; end; end; begin assign(input,'sudoku.in'); assign(output,'sudoku.out'); reset(input); rewrite(output); fillchar(usei,sizeof(usei),true); fillchar(usej,sizeof(usej),true); fillchar(usex,sizeof(usex),true); tot:=0; max:=0; s:=0; for i:=1 to 9 do begin for j:=1 to 9 do begin read(a[i,j]); if a[i,j]<>0 then begin

usei[i,a[i,j]]:=false; usej[j,a[i,j]]:=false; usex[pr(i,j),a[i,j]]:=false; t:=solve(i,j); tot:=tot+t*a[i,j]; end; if (a[i,j]=0) then begin inc(s); x[s]:=i; y[s]:=j; end; end; readln; end; fillchar(usep,sizeof(usep),false); tryit(1,tot); if max=0 then writeln('-1') else writeln(max); close(input); close(output); end.

2009noip提高组复赛题解.doc
2009noip提高组复赛题解_企业管理_经管营销_专业资料。NOIP2009 提高解告 NOIP2009 提高解告 一、伏者(spy) 描述: 出密文及...
NOIP2009提高组复赛题解.doc
NOIP2009提高组复赛题解 - 1、潜伏者 program spy; var
NOIP2009提高组复赛题解.doc
NOIP2009提高组复赛题解 - NOIP2009 提高组复赛题解(1) 20
NOIP2009提高组初赛试题及答案.doc
NOIP2009提高组初赛试题及答案_学科竞赛_初中教育_教育专区。第十五届全国青少年...写在试卷纸上一律无效 一. 单项选择题 (共 10 题,每题 1.5 分,共计 15 ...
NOIP2009初赛试题及参考答案和解析(提高组)C++.doc

NOIP2009提高组C++初赛试题与答案.doc
NOIP2009提高组C++初赛试题与答案_学科竞赛_高中教育_教育专区。2009 第十五届...写在试卷纸上一律无效 一. 单项选择题 (共 10 题,每题 1.5 分,共计 15 ...
NOIP2009年提高组(C语言)及参考答案.doc
NOIP2009提高组(C语言)及参考答案 - 第十五届全国青少年信息学奥林匹克联赛初赛试题 ( 提高组 ●● C 语言 二小时完成 )●● 全部试题答案均要求写在答卷纸...
NOIP2009提高组解题报告.doc
NOIP2009提高组解题报告 - 满意答案第二题(Hankson 的趣味题,
QfhygeNOIP2009提高组解题报告.doc
QfhygeNOIP2009提高组解题报告_建筑/土木_工程科技_...| 回复 悲剧了,第二题枚举竟然写错了 qyjubriskxp...noip2010提高组复赛试题 7页 免费 B_station解题报告...
noip2009提高组解题报告(C语言).doc
Hankson 的趣味题 (son.pas/c/cpp) 【问题描述】 Hanks 博士是 BT(Bio-...NOIP2009提高组解题报告 5页 1下载券 NOIP2009提高组复赛题解 12页 1下载券...
2009年第15届noip提高组c++试题及官方答案.doc
2009年第15届noip提高组c++试题及官方答案 - 第十五届全国青少年信息学奥林匹克联赛初赛试题 ( 提高组 ●● C++语言 二小时完成 )●● 全部试题答案均要求写在...
Bf-bcpyoNOIP2009提高组解题报告.doc
Bf-bcpyoNOIP2009提高组解题报告 - 、 .~ ① 我们‖打〈败〉了敌人。 ②我们‖〔把敌人〕打〈败〉了。 [原创]NOIP2009 提高组解题报告{继续供大牛 BS} ...
NOIP2009提高组初赛试题答案.doc

NOIP2009提高组解题报告.doc
NOIP2009提高组复赛题解 12页 1财富值 NOIP2008提高组解题报告
NOIP2009_提高答案.doc
NOIP2009_提高答案 - 第十五届全国青少年信息学奥林匹克联赛初赛试题 ( 提高组 Pascal 语言 二小时完成 )○○ 全部试题答案均要求写在答卷纸上,写在试卷纸上一律...
NOIP提高组复赛题目_图文.doc
NOIP提高组复赛题目 - 第一题题NOIP2007 1.统计数字 (cou
IthneaNOIP2009提高组解题报告.doc
[原创]NOIP2009 提高组解题报告{继续供大牛 BS} 2009-11-21 10:46 P.M. ...NOIP2009提高组复赛题解 12页 1下载券 Noip 2003 提高组 解题报... 12页...
NOIP2009提高组初赛Pascal参考答案.doc
NOIP2009提高组初赛Pascal参考答案 - 提高组(Pascal 语言)
sxnbgnNOIP2009提高组解题报告.doc
| 回复 悲剧了,第二题枚举竟然写错了 qyjubriskxp...这才是最优解啊。 。。 我就是强连通+dp 写的...2009NOIP普及组复赛解题... 6页 免费 《靶形数独...
1999-2009NOIP提高组复赛试题汇编.pdf
1999-2009NOIP提高组复赛试题汇编_IT/计算机_专业资料...NOIP 2003 题一 神经网络 【问题背景】 人工神经...输入数据保证有且仅有一组解, 【输入文件】 输入...