荣幸地得了400分..Share4道Ac程序..
==========
program NOIp_random;
const
inputfile='random.in';
outputfile='random.out';
var
n,m:byte;
f:array[1..1000]of boolean;
procedure origin;
var
i:byte;
x:word;
begin
assign(input,inputfile);
reset(input);
readln(n);
fillchar(f,sizeof(f),0);
for i:=1 to n do
begin
read(x);
f[x]:=true
end;
close(input)
end;
procedure main;
var
i:word;
begin
m:=0;
for i:=1 to 1000 do
if f[i] then
inc(m)
end;
procedure printout;
var
flag:boolean;
i:word;
begin
assign(output,outputfile);
rewrite(output);
writeln(m);
flag:=false;
for i:=1 to 1000 do
if f[i] then
if flag then
write(' ',i)
else
begin
write(i);
flag:=true
end;
writeln;
close(output)
end;
begin
origin;
main;
printout
end.
==========
program NOIp_happy;
const
maxn=30000;
maxm=25;
inputfile='happy.in';
outputfile='happy.out';
var
m:byte;
n:word;
p:array[1..maxm]of byte;
v:array[1..maxm]of word;
f:array[0..maxm,0..maxn]of longint;
procedure origin;
var
i:byte;
begin
assign(input,inputfile);
reset(input);
readln(n,m);
fillchar(v,sizeof(v),0);
fillchar(p,sizeof(p),0);
for i:=1 to m do
readln(v[i],p[i]);
close(input)
end;
procedure main;
var
i:byte;
j:word;
x:longint;
begin
fillchar(f,sizeof(f),0);
for i:=1 to m do
for j:=0 to n do
begin
f[i,j]:=f[i-1,j];
if j>=v[i] then
begin
x:=f[i-1,j-v[i]]+v[i]*p[i];
if x>f[i,j] then
f[i,j]:=x
end
end;
end;
procedure printout;
begin
assign(output,outputfile);
rewrite(output);
writeln(f[m,n]);
close(output)
end;
begin
origin;
main;
printout
end.
==========
program NOIp_count;
const
inputfile='count.in';
outputfile='count.out';
var
temp:shortint;
s,t,w,total:byte;
str:string;
place,path:array[0..26]of byte;
first:array[0..26]of boolean;
letter:array[0..26]of char;
procedure origin;
begin
readln(s,t,w);
readln(str);
end;
procedure init;
begin
total:=0;
temp:=t-s-w+1;
fillchar(place,sizeof(place),0);
fillchar(path,sizeof(path),0);
fillchar(first,sizeof(first),1);
fillchar(letter,sizeof(letter),0)
end;
procedure build_letter;
var
i:byte;
begin
for i:=s to t do
letter[i-s+1]:=chr(i+96);
end;
procedure build_place;
var
i:byte;
begin
for i:=1 to w do
repeat
inc(place[i])
until str[i]=letter[place[i]]
end;
procedure print;
var
i:byte;
begin
for i:=1 to w do
write(letter[path[i]]);
writeln
end;
procedure qtry(dep:byte);
var
i:byte;
begin
if dep<=w then
begin
if first[dep] then
begin
i:=place[dep];
first[dep]:=false
end
else
i:=path[dep-1]+1;
for i:=i to temp+dep do
begin
path[dep]:=i;
qtry(dep+1)
end
end
else
begin
if total>0 then
if total>5 then
begin
close(output);
halt
end
else
print;
inc(total)
end
end;
procedure main;
begin
build_letter;
build_place;
qtry(1)
end;
begin
assign(input,inputfile);
reset(input);
assign(output,outputfile);
rewrite(output);
origin;
init;
main;
close(input);
close(output)
end.
==========
program NOIp_sequence;
const
inputfile='sequence.in';
outputfile='sequence.out';
var
k,power:shortint;
n:word;
p:array[0..10]of longint;
f:array[0..2000]of longint;
procedure origin;
begin
assign(input,inputfile);
reset(input);
readln(k,n);
close(input)
end;
procedure build_power;
var
power2,powerk,limit2,limitk:longint;
begin
power:=0;
power2:=1;
powerk:=1;
limit2:=1000 div 2;
limitk:=maxlongint div k;
while (power2<=limit2)and(powerk<=limitk) do
begin
inc(power);
power2:=power2*2;
powerk:=powerk*k;
end
end;
procedure build_p;
var
i:byte;
begin
fillchar(p,sizeof(p),0);
p[0]:=1;
for i:=1 to power do
p[i]:=p[i-1]*k
end;
procedure qtry(start,dep:byte;sum:longint);
var
i:byte;
begin
if dep=0 then
begin
inc(f[0]);
f[f[0]]:=sum;
exit
end;
for i:=start to power-dep+1 do
qtry(i+1,dep-1,sum+p[i])
end;
procedure build_f;
var
i:byte;
begin
fillchar(f,sizeof(f),0);
for i:=1 to power do
qtry(0,i,0);
end;
procedure sort_f;
var
i,j:word;
temp:longint;
begin
for i:=1 to f[0]-1 do
for j:=i+1 to f[0] do
if f[j]<f[i] then
begin
temp:=f[i];
f[i]:=f[j];
f[j]:=temp
end
end;
procedure main;
begin
build_power;
build_p;
build_f;
sort_f;
end;
procedure printout;
begin
assign(output,outputfile);
rewrite(output);
writeln(f[n]);
close(output)
end;
begin
origin;
main;
printout
end.
==========
|
