The National Olympiad in Informatics (NOI) is an annual informatics competition for secondary school students in China. The first NOI was held in 1984, earlier than IOI.
The contest consists of one practice contest and two official competitions, each involving solving problems of an algorithmic nature. Each day’s competition consists of three problems and contestants have five hours to try to solve them. Students compete on an individual basis, with up to five students competing from each participating province (with around 30 provinces in 2003). Students are selected from similar contests in their own province.
I participated in NOI 2006, 2007 and 2008; also in CTSC 2008 and APIO 2008, was among Bronze medalists all 2008 contests.
Here are some ancient Pascal code of mine for NOI 2008.
KMP Algorithm:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
Program KMP; Const inf = 'kmp.in'; ouf = 'kmp.out'; maxn = 20000000; Var a,b : array [0..maxn] of char; p : array [0..maxn] of longint; i,j,n,m,ans : longint; procedure ComputePrefix; var i, k: longint; begin P[1] := 0; k := 0; for i := 2 to m do begin while (k > 0) and (b[k + 1] <> b[i]) do k := P[k]; if b[k + 1] = b[i] then Inc(k); P[i] := k; end; end; procedure KMP; var i, k: longint; begin k := 0; for i := 1 to n do begin while (k > 0) and (b[k + 1] <> a[i]) do k := P[k]; if b[k + 1] = a[i] then Inc(k); if k = M then begin Writeln(i - k + 1); //exit; k := P[k]; //Seek for next match end; end; end; {Procedure NEXT; Var i,j:longint; Begin p[1]:=0; j:=0; for i:= 2 to m do; begin while (j>0) and (b[j+1]<>b[i]) do j:=p[j]; if b[j+1]=b[i] then inc(j); p[i]:=j; end; End; Function KMP:longint; Var i,j:longint; begin NEXT; j:=0; for i:= 1 to n do begin while (j>0) and (b[j+1]<>a[i]) do j:=p[j]; if b[j+1]=a[i] then inc(j); if j=m then begin exit(i-j+1); j:=p[j]; end; end; exit(0); End;} Begin assign(input,inf); reset(input); assign(output,ouf); rewrite(output); readln(n); for i:= 1 to n do read(a[i]); readln; readln(m); for i:= 1 to m do read(b[i]); readln; ComputePrefix; KMP; //writeln(KMP); close(input); close(output); END. |
Min-cost Max-flow Algorithm
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 |
Program fjo; const inf='fjo.in'; ouf='fjo.out'; maxn=2673; Var best : array [0..maxn] of record value,father:longint; end; var f,c,a,w,b:array [0..maxn,0..maxn] of longint; g,id:array [0..maxn,0..maxn] of integer; d,q:array [0..maxn] of longint; p:array [0..maxn] of integer; oo:array [0..maxn] of boolean; n,m,i,j,k,o,ans,s,t,ss,kk:longint; Procedure Giveedge(u,v:longint); Begin inc(d[u]); g[u,d[u]]:=v; inc(d[v]); g[v,d[v]]:=u; End; procedure add(u,v,x,y:longint); begin inc(d[u]); g[u,d[u]]:=v; c[u,d[u]]:=x; w[u,d[u]]:=-y; inc(d[v]); g[v,d[v]]:=v; c[v,d[v]]:=0; w[v,d[v]]:=y; end; function rfs:boolean; var i,j,k:integer; fail:boolean; begin fillchar(oo,sizeof(oo),1); oo[s]:=false; q[s]:=0; repeat fail:=true; for i:= 1 to t do if not oo[i] then for k:= 1 to d[i] do begin j:=g[i,k]; if (f[i,j]<c[i,j]) and (oo[j] or (q[j]>q[i]+w[i,j])) then begin oo[j]:=false; q[j]:=q[i]+w[i,j]; p[j]:=i; fail:=false; end; end; until fail; if not oo[t] then exit(true) else exit(false); end; procedure mrf; var i,j:integer; begin i:=t; while i<>s do begin j:=p[i]; inc(f[j,i]); f[i,j]:=-f[j,i]; i:=j; end; inc(ans,q[t]); end; begin assign(input,inf); reset(input); assign(output,ouf); rewrite(output); readln(m,n,kk); k:=(n<<1+m-1)*m>>1; for i:= 1 to m do for j:= 1 to n+i-1 do begin inc(s); read(b[i,j]); a[i,j]:=s; end; for i:= 1 to m do for j:= 1 to n+i-1 do begin c[a[i,j],a[i,j]+k]:=1; giveedge(a[i,j],a[i,j]+k); w[a[i,j],a[i,j]+k]:=-b[i,j]; w[a[i,j]+k,a[i,j]]:=b[i,j]; if a[i+1,j]<>0 then begin c[a[i,j]+k,a[i+1,j]]:=1; giveedge(a[i,j]+k,a[i+1,j]); end; if a[i+1,j+1]<>0 then begin c[a[i,j]+k,a[i+1,j+1]]:=1; giveedge(a[i,j]+k,a[i+1,j+1]); end; end; s:=s*2+1; ss:=s+1; t:=ss+1; for i:= 1 to n do begin c[ss,i]:=1; giveedge(ss,i); end; for i:= 1 to n+m-1 do begin c[a[m,i]+k,t]:=1; giveedge(a[m,i]+k,t); end; c[s,ss]:=kk; giveedge(s,ss); WHILE RFS DO MRF; writeln(-ans); close(input); close(output); END. |
Max-flow Min-cut Algorithm
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
Program ditch; Uses Math; Const inf='ditch.in'; ouf='ditch.out'; maxn=1000; maxm=4000000; Var e:array [-maxm..maxm] of record v,next,x,y:longint end; f:array [0..maxn] of record vd,current,link:longint end; c:array [0..maxn,0..maxn] of longint; n,m,s,t,i,j,k,ans,r,delta:longint; Procedure Add(a,b,c:longint); Begin inc(r); with e[r] do with f[a] do begin v:=b; x:=c; next:=link; link:=r; end; with e[-r] do with f[b] do begin v:=a; x:=0; next:=link; link:=-r end; End; Function RFS(cv,zl:longint):boolean; Var i:longint; Begin if cv=t then begin delta:=zl; exit(true); end; with f[cv] do begin vd:=ans; i:=current; repeat with e[i] do begin if (y<x) and (f[v].vd<>ans) and RFS(v,Min(zl,x-y)) then begin inc(y,delta); e[-i].y:=-y; current:=i; exit(true); end; i:=next; end; if i=0 then i:=link; until i=current; end; exit(false); end; Begin assign(input,inf); reset(input); assign(output,ouf); rewrite(output); readln(m,n); for s:= 1 to m do begin readln(i,j,k); inc(c[i,j],k); end; for i:= 1 to n do for j:= 1 to n do if c[i,j]<>0 then add(i,j,c[i,j]); s:=1; t:=n; for i:= 1 to t do with f[i] do begin current:=link; vd:=-1 end; while RFS(s,maxlongint) do inc(ans,delta); writeln(ans); close(input); close(output); END. |
Move:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 |
Program move; Const inf = 'move.in'; ouf = 'move.out'; maxn = 202; zl : array [1..4,1..2] of longint = ((0,1),(0,-1),(1,0),(-1,0)); Type PIT = record a,b,d,l,r:longint; c:boolean; end; Var best : array [0..maxn] of record value,father:longint; end; Var ok,b,vd : array [0..maxn,0..maxn] of boolean; save : array [0..maxn] of record y,x:longint; end; dist : array [0..maxn>>1,0..maxn>>1,0..maxn>>1] of longint; queue : array [0..maxn*maxn] of longint; c,f,w,g : array [0..maxn,0..maxn] of longint; deg,d,p : array [0..maxn] of longint; oo,mk : array [0..maxn] of boolean; q : array [0..maxn*maxn] of record y,x,s:longint end; i,j,m,n,x,y,s,t,ans,sum,v,st,z,id: longint; Procedure Add(a,b,x,y:longint); Begin inc(deg[a]); g[a,deg[a]]:=b; c[a,b]:=x; w[a,b]:=y; inc(deg[b]); g[b,deg[b]]:=a; c[b,a]:=0; w[b,a]:=-y; End; Procedure Del(a,b:longint); Begin dec(deg[a]); c[a,b]:=0; w[a,b]:=0; dec(deg[b]); c[b,a]:=0; w[b,a]:=0; End; Function RFS:boolean; Var i,j,k,front,rear:longint; Begin fillchar(oo,sizeof(oo),true); fillchar(mk,sizeof(mk),false); front:=1; rear:=1; oo[s]:=false; d[s]:=0; queue[1]:=s; while front<=rear do begin i:=queue[front]; mk[i]:=false; for k:= 1 to deg[i] do begin j:=g[i,k]; if (f[i,j]<c[i,j]) and (oo[j] or (d[j]>d[i]+w[i,j]) ) then begin oo[j]:=false; d[j]:=d[i]+w[i,j]; p[j]:=i; if not mk[j] then begin inc(rear); queue[rear]:=j; mk[j]:=true; end; end; end; inc(front) end; if oo[t] then exit(false) else exit(true); End; Procedure MRF; Var i,j:longint; Begin i:=t; while i<>s do begin j:=p[i]; inc(f[j,i]); f[i,j]:=-f[j,i]; i:=j; end; inc(sum,d[t]); End; Procedure BFS(y0,x0:longint); var f,r,v,i,j:longint; q:array [0..10000] of record y,x,s:longint; end; Begin f:=1; r:=1; with q[f] do begin y:=y0; x:=x0; s:=0; end; fillchar(vd,sizeof(vd),0); vd[y0,x0]:=true; dist[id,y0,x0]:=0; while f<=r do begin for v:= 1 to 4 do begin i:=q[f].y+zl[v,1]; j:=q[f].x+zl[v,2]; if ok[i,j] and not vd[i,j] and not b[i,j] then begin inc(r); with q[r] do begin y:=i; x:=j; s:=q[f].s+1; end; vd[i,j]:=true; dist[id,i,j]:=q[r].s; end; end; inc(f); end; End; Procedure Updata; Var i,j:longint; Begin for i:= 1 to n do for j:= 1 to n do with q[j] do if not b[y,x] then add(i+1,j+1+n,1,dist[i,y,x]); for i:= 1 to n do add(i+1+n,t,1,0); fillchar(f,sizeof(f),0); sum:=0; while rfs do mrf; for i:= 1 to n do for j:= 1 to n do with q[j] do if not b[y,x] then del(i+1,j+1+n); for i:= 1 to n do del(i+1+n,t); for i:= 1 to n do if f[s,i+1]<>1 then exit; if sum<ans then ans:=sum; End; Begin assign(input,inf); reset(input); assign(output,ouf); rewrite(output); readln(n,m); s:=1; t:=2+n<<1; fillchar(dist,sizeof(dist),1); for i:= 1 to n do for j:= 1 to n do ok[i,j]:=true; for i:= 1 to n do with save[i] do read(y,x); for j:= 1 to m do begin read(y,x); b[y,x]:=true; end; for i:= 1 to n do with save[i] do begin id:=i; BFS(y,x); Add(s,i+1,1,0); end; ans:=maxlongint; for i:= 1 to n do begin for j:= 1 to n do with q[j] do begin y:=i; x:=j; end; updata; end; for j:= 1 to n do begin for i:= 1 to n do with q[i] do begin y:=i; x:=j; end; updata; end; for i:= 1 to n do with q[i] do begin y:=i; x:=i; end; updata; for i:= 1 to n do with q[i] do begin y:=i; x:=n-i+1; end; updata; if ans=maxlongint then writeln(-1) else writeln(ans); close(input); close(output); END. |
Profit.pas
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
Program profit; Uses Math; Const inf = 'profit.in'; ouf = 'profit.out'; maxn = 60000; maxm = 160000; Var e : array [-maxm..maxm] of record v,next,x,y:longint end; f : array [0..maxn] of record vd,current,link:longint end; p,a,b,c : array [0..maxm] of longint; n,m,s,t,ans,sum,i,j,r,delta : longint; Procedure Add(a,b,c:longint); Begin inc(r); with e[r] do with f[a] do begin v:=b; x:=c; next:=link; link:=r; end; with e[-r] do with f[b] do begin v:=a; x:=0; next:=link; link:=-r end; End; Function Rfs(cv,zl:longint):boolean; Var i:longint; Begin if cv=t then begin delta:=zl; exit(true); end; with f[cv] do begin vd:=ans; i:=current; repeat with e[i] do begin if (y<x) and (f[v].vd<>ans) and (Rfs(v,Min(zl,x-y))) then begin inc(y,delta); e[-i].y:=-y; current:=i; exit(true); end; i:=next; end; if i=0 then i:=link; until i=current; end; exit(false); End; Begin assign(input,inf); reset(input); assign(output,ouf); rewrite(output); readln(n,m); for i:= 1 to n do read(p[i]); for i:= 1 to m do read(a[i],b[i],c[i]); s:=n+m+1; t:=s+1; for i:= 1 to m do begin add(a[i],i+n,maxlongint); add(b[i],i+n,maxlongint); add(i+n,t,c[i]); inc(sum,c[i]); end; for i:=1 to n do add(s,i,p[i]); for i:= 1 to t do with f[i] do begin current:=link; vd:=-1 end; while RFS(s,maxlongint) do inc(ans,delta); writeln(sum-ans); close(input); close(output); END. |
Finally, I share all the data I used here:
