haihongyuan.com

# NOIP初赛备战专题 写程序运行结果

【1】

var

u: array [0..3] of integer;

a, b, c, x, y, z: integer;

begin

a := u[0] + u[1] + u[2] + u[3] - 5;

b := u[0] * (u[1] - u[2] div u[3] + 8);

c := u[0] * u[1] div u[2] * u[3];

x := (a + b + 2) * 3 - u[(c + 3) mod 4];

y := (c * 100 - 13) div a div (u[b mod 3] * 5);

if((x+y) mod 2 = 0) then z := (a + b + c + x + y) div 2; z := (a + b + c – x - y) * 2;

writeln(x + y - z);

end

【2】

var

i, number, ndata, sum: integer;

data: array[1..100] of integer;

procedure solve(s, sign, n: integer);

var i: integer;

begin

for i := s to ndata do begin

inc(sum, sign * (number div (n * data[i]))); solve(i + 1, -sign, n * data[i]);

end;

end;

begin

sum := 0;

for i := 1 to ndata do read(data[i]);

solve(1, 1, 1);

writeln(sum);

end.

【3】

Program excpl;

var

x,y,y1,jk,j1,g,e:Integer;

a:array[1..20] of 0..9;

begin

x:=3465; y:=264; jk:=20;

for j1:=1 to 20 do a[j1]:=0; while y<>0 do

begin

y1:=y mod 10;

y:=y div 10;

while y1<>0 do

begin

g:=x;

for e:=jk downto 1 do

begin

g:=g+a[e];

a[e]:=g mod 10;

g:=g div 10;

end;

y1:=y1-1

end;

jk:=jk-1

end;

j1:=1;

while a[j1]=0 do j1:=j1+1;

for Jk:=j1 to 20 do write(a[jk]:4); writeln;

end.

【4】

var n,jr,jw,jb:integer;

ch1:char;

ch:array[1..20] of char;

begin

for i:=1 to n do read(ch[i]); jr:=1;jw:=n;jb:=n;

while (jr<=jw)do

begin

if(ch[jw]='R')

then begin

ch1:=Ch[jr];Ch[jr]:=ch[jw];ch[jw]:=ch1:jr:=jr+1;

end

else if ch[jw]='W'

then jw:=jw-1

else begin

ch1:=ch[jw];ch[jw]:=ch[jb];ch[jb]:=ch1;jw:=jw-1;jb:=jb-1; end

end;

for i:=1 to n do write(ch[i]);

writeln;

end.

RBRBWWRBBR

【5】

var

a : array [1..50] of integer;

n, i, sum : integer;

procedure work(p, r: integer);

var

i, j, temp : integer;

begin

if p < r then begin

i := p - 1;

for j := p to r - 1 do

if a[j] >= a[r] then begin

inc(i);

temp := a[i]; a[i] := a[j]; a[j] := temp; end;

temp := a[i + 1]; a[i + 1] := a[r]; a[r] := temp; work(p, i);

work(i + 2, r);

end;

end;

begin

for i := 1 to n do read(a[i]);

work(1, n);

for i := 1 to n - 1 do sum := sum + abs(a[i + 1] - a[i]); writeln(sum);

end.

【6】

Var I,j,s,sp1:integer;

p:boolean;

a :array[1..10] of integer;

begin

sp1:=1;a[1]:=2;j:=2:

while sp1<10 do

begin

j :=j+1;p:=true;

for i:=2 to j-1 do

if(j mod i=O)then p:=false;

if p then begin

sp1:=sp1+1;a[sp1]:=j;

end;

end;

j:=2; p:=true;

while p do

begin

s:=1;

for i:=1 to j do s:=s*a[I];

s:=s+1;

for i:=2 to s-1 do

if S mod i=O then p:=false;

j :=j+1;

end;

writeln(s);writeln;

end.

【7】

Var d1,d2,X,Min:real;

begin

min:=10000;X:=3;

while X<15 do

begin

d1:=sqrt(9+(X-3)*(X-3));d2:=sqrt(36+(15-X)*(15-X));

if(d1+d2)<Min then Min:=d1+d2;

X:=x+0.001;

end;

writeln(Min:O:2);

end.

【8】

FUNCTION ACK(M，N：INTEGER):INTEGER；

BEGIN

IF M=0 THEN ACK:=N+1

ELSE IF N=0 THEN ACK:=ACK(M-1，1)

ELSE ACK:=ACK(M-1，ACK(M，N-1)) END；

【9】

VAR P，Q，S，T：INTEGER；

BEGIN

FOR Q:=P+1 TO 2*P DO

BEGIN

T:=0；S:=(P*Q)MOD(Q-P)；

IF S=0 THEN BEGIN T:=P+Q+(P*Q)DIV(Q-P)；WRITE(T：4)；END； END；

END.

【10】

VAR I，J，H，M，N，K：INTEGER；

B ：ARRAY[1..10]OF INTEGER；

BEGIN

FOR I:=1 TO 10 DO

BEGIN

M：=N；J：=11；

WHILE M>0 DO {高精度分解}

BEGIN J:=J-1；B[J]:=M MOD 10；M:=M DIV 10 END； FOR H:=J TO 10 DO N:=N+B[H]；{数位累加}

END；

WRITELN(N)；

END.

【11】

VAR X，Y1，Y2，Y3：INTEGER；

BEGIN

WHILE Y2<=X DO

BEGIN

Y1:=Y1+1; Y3:=Y3+2; Y2:=Y2+Y3; {y3等差数列，y2是y3求和} END；

WRITELN(Y1)； {循环次数}

END.

【12】

VAR

I,J,L,N,K,S,T:INTEGER;

B:ARRAY[1..10] OF 0..9;

BEGIN

IF N>L THEN BEGIN

WHILE S<N DO

BEGIN K:=K+1;T:=T*L;S:=S+T END;

S:=S-T;N:=N-S-1;

FOR I:=1 TO 10 DO B[I]:=0;

J:=11;

WHILE N>0 DO

BEGIN J:=J-1; B[J]:=N MOD L; N:=N DIV L END; {进制转换} FOR I:=10-K+1 TO 10 DO WRITE(CHR(ORD(’A ’)+B[I]));

END

ELSE WRITELN(CHR(ORD(’A’)+N-1))

END.

【13】

const

u: array[0..2] of integer = (1, -3, 2); v: array[0..1] of integer = (-2, 3);

var

i, n, sum: integer;

function g(n: integer): integer;

var i, sum: integer;

begin

sum := 0;

for i := 1 to n do inc(sum, u[i mod 3] * i); g := sum;

end;

begin

sum := 0;