第八届信息学奥赛普及组复赛答案.docVIP

第八届信息学奥赛普及组复赛答案（Pascal)第一题： program c1; var K: Byte; n: Longint; Sn: Extended; begin Readln(K); Sn := 0; n := 0; Repeat Inc(n); Sn := Sn + 1 / n; Until Sn k; Writeln(n); end. 第二题： program c2; const MaxN = 20; var N, M, i: Byte; ans, s: Longint; x: array[1 .. MaxN] of Longint; f: array[1 .. 10000] of Byte; p: array[1 .. 1229] of Integer; procedure Get_Prime; var i, j, s: Integer; begin s := 0; f[1] := 0; for i := 2 to 10000 do f[i] := 1; for i := 2 to 10000 do if f[i] = 1 then begin Inc(s); p[s] := i; j := 2 * i; while j = 10000 do begin f[j] := 0; Inc(j, i) end; end end; procedure Work(S: Longint); var i: Integer; begin if S = 10000 then Inc(ans, f[S]) else begin i := 1; while sqr(longint(p[i])) = S do begin if S mod p[i] = 0 then Exit; Inc(i) end; Inc(ans) end end; procedure Search(d, pre: Byte); var i: Byte; begin for i := pre + 1 to N - (M - d) do begin Inc(S, x[i]); if d = M then Work(S) else Search(d + 1, i); Dec(S, x[i]) end end; begin Readln(N, M); for i := 1 to N do Read(x[i]); ans := 0; S := 0; Get_Prime; Search(1, 0); Writeln(ans) end. 第三题： program c3; const MaxLen = 30; var Len, M: Byte; a: array[1 .. MaxLen] of Byte; f: array[0 .. 9] of Byte; g: array[0 .. 9, 0 .. 9] of Boolean; procedure Init; var i: Byte; St: String; begin Readln(st); Len := 0; M := 0; i := 1; while st[i] in [0 .. 9] do begin Inc(Len); a[Len] := Ord(st[i]) - 48; Inc(i) end; Repeat if st[i] in [0 .. 9] then M := M * 10 + Ord(st[i]) - 48; Inc(i) Until i Length(st) end; procedure Main; var i, j, k: Byte; begin Fillchar(g, Sizeof(g), False); for k := 1 to M do begin Readln(i, j); g[i, j] := True end; for k := 0 to 9 do for i := 0 to 9 do for j := 0 to 9 do g[i, j] := g[i, j] or (g[i, k] and g[k, j]);