通过的程序 Uva AOAPC I: Beginning Algorithm Contests Volume 0. Getting Started
pascal版的。program Hashmat;var a,b:int64;
begin
while not eof do
begin
readln(a,b);
writeln(abs(a-b))
end
end.
program Physics;
var v,t:integer;
begin
while not eof do
begin
readln(v,t);
writeln(2*v*t)
end
end.
program EcologicalPremium;
var n,f,i,j:integer;
a,b,c,s:int64;
begin
readln(n);
for i:=1 to n do begin
readln(f);
s:=0;
for j:=1 to f do begin
readln(a,b,c);
s:=s+a*c;
end;
writeln(s)
end
end.
program Decoder;
var s:string;
a:integer;
begin
while not eof do
begin
readln(s);
for a:=1 to length(s) do
write(chr((ord(s)-7) mod 256));
writeln
end
end.
program Counting;
var s:string;
b:boolean;
i,t:integer;
begin
while not eof do
begin
readln(s);
t:=0;b:=false;
for i:=1 to length(s) do
if ((65<=ord(s))and(ord(s)<=90)) or
((97<=ord(s))and(ord(s)<=122)) then
begin
if b=false then t:=t+1;
b:=true
end
else
b:=false;
writeln(t)
end
end.
program Surface;
var sum,min,t:integer;
i,j,n:integer;
s:string;
begin
repeat
sum:=0;
min:=25;
readln(n);
for i:=1 to n do begin
t:=0;
readln(s);
for j:=1 to length(s) do
if s=' ' then inc(t);
sum:=sum+t;
if t<min then min:=t
end;
if n<>0 then writeln(sum-n*min)
until n=0;
end.
program Rotate;
var c:array of char;
i,j,m,n:integer;
max:integer;
s:string;
begin
m:=0;
n:=0;
fillchar(c,sizeof(c),' ');
while not eof do
begin
readln(s);
inc(n);
j:=length(s);
if j>m then m:=j;
for i:=1 to j do c:=s;
end;
for i:=1 to m do begin
for j:=1 to n do
write(c);
writeln
end
end.
program Maze;
var s:string;
c:char;
i,j,n:integer;
begin
while not eof do
begin
readln(s);
n:=0;
for i:=1 to length(s) do begin
c:=s;
if c='b' then c:=' ';
if (48<=ord(c)) and (ord(c)<=57) then
n:=n+ord(c)-48
else begin
for j:=1 to n do write(c);
n:=0;
end;
if c='!' then writeln
end;
writeln
end
end.
program Wave;
var n,nc,h,f,i,j,k:longint;b:boolean;
begin
read(n);
b:=false;
for nc:=1 to n do begin
read(h,f);
if h*f<>0 then begin
if b then begin writeln;writeln end;
for i:=1 to f do begin
if i>1 then begin writeln;writeln end;
for j:=1 to h do begin
for k:=1 to j do write(j);
if h<>1 then writeln
end;
for j:=h-1 downto 1 do begin
for k:=1 to j do write(j);
if j<>1 then writeln
end;
end;
b:=true;
end;
end;
writeln;
close(output)
end.
program Hangman;
//O
// /|\
//|
///\
var guess,ans:array of boolean;
stock,sum:longint;
round,i,t:longint;
guesss,anss:string;
label 1;
begin
while true do begin
1: readln(round); if round=-1 then halt; writeln('Round ',round);
readln(anss); readln(guesss);
if anss='' then begin writeln('You win.'); goto 1 end;
if guesss='' then begin writeln('You chickened out.'); goto 1 end;
for i:=1 to 26 do begin guess:=false; ans:=false end; sum:=0; stock:=0;
for i:=1 to length(anss) do if ans=false then begin inc(sum); ans:=true end;
for i:=1 to length(guesss) do if guess=false then begin
if ans=true then dec(sum) else inc(stock);
guess:=true;
if sum=0 then begin writeln('You win.'); break end;
if stock=7 then begin writeln('You lose.'); break end
end;
if (sum<>0) and (stock<>7) then writeln('You chickened out.');
end;
end.
program Collatz;
var a,lim,num,i:int64;
begin
i:=0;
while true do begin
readln(a,lim);if(a<0)and(lim<0)then halt;
num:=0;inc(i);write('Case ',i,': A = ',a,', limit = ',lim,', number of terms = ');
while(a<=lim)and(a<>1)do begin
if odd(a) thena:=3*a+1 else a:=a div 2;inc(num) end;
if a=1 then inc(num);
writeln(num);
end;
end.
Program Cell;
var a:array of longint;
b:array of longint;
dna:array of longint;
n,nc,c,i,m,k:longint;
ch:char;
begin
read(n);
for nc:=1 to n do begin
for i:=0 to 9 do read(dna);
for i:=0 to 41 do a:=0;
a:=1;
for i:=1 to 19 do write(' ');
write('.');
for i:=21 to 40 do write(' ');
writeln;
for c:=2 to 50 do begin
for i:=1 to 40 do
b:=dna+a+a];
for i:=1 to 40 do begin
a:=b;
ch:=' ';
if a=0 then ch:=' ';
if a=1 then ch:='.';
if a=2 then ch:='x';
if a=3 then ch:='W';
write(ch);
end;
writeln;
end;
if nc<>n then writeln;
end;
end.
啥东西 代码都很精辟 我不想再看Pascal了 program Excuse;
var s,s1:string;
key,ss:array of string;
nums:array of integer;
nk,ns:integer;
i,j,k,l:integer;
flag:boolean;
num,max:integer;
function isalpha(var c:char):boolean;
begin
if(65<=ord(c))and(ord(c)<=90) then c:=chr(ord(c)+32);
if(97<=ord(c))and(ord(c)<=122) then isalpha:=true else isalpha:=false
end;
begin
l:=1;
while not eof do begin writeln('Excuse Set #',l);inc(l);
readln(nk,ns);max:=0;
for i:=1 to nk do readln(key);
for k:=1 to ns do begin
num:=0;s1:='';
readln(s);
ss:=s;
for i:=1 to length(s) do begin
if isalpha(s) then
s1:=s1+s
else begin
for j:=1 to nk do if key=s1 then inc(num);
s1:=''
end
end;
for j:=1 to nk do if key=s1 then inc(num);
nums:=num;
if max<num then max:=num
end;
for i:=1 to ns do if nums=max then writeln(ss);
writeln
end
end.
Program FindWord;
var
s,s1:string;
i:integer;
function isalpha(var c:char):boolean;
begin
if(65<=ord(c))and(ord(c)<=90) then c:=chr(ord(c)+32);
if(97<=ord(c))and(ord(c)<=122) then isalpha:=true else isalpha:=false
end;
begin
numofdict:=0;
while not eof do begin
s1:='';
readln(s);
for i:=1 to length(s) do begin
if isalpha(s) then
s1:=s1+s
else begin
//produce with word
s1:=''
end
end;
//produce with word
end;
end.
Program Dictonary;
var dict:array of string;
numofdict:integer;
s,s1:string;
i:integer;
function isalpha(var c:char):boolean;
begin
if(65<=ord(c))and(ord(c)<=90) then c:=chr(ord(c)+32);
if(97<=ord(c))and(ord(c)<=122) then isalpha:=true else isalpha:=false
end;
procedure insertword(w:string);
var i,j:integer;
begin
if numofdict=0 then begin numofdict:=1;dict:=w;exit end;
i:=1;
while w<dict do inc(i);
if w=dict then exit;
for j:=numofdict downto i do dict:=dict;
dict:=w;
inc(numofdict)
end;
begin
numofdict:=0;
while not eof do begin
s1:='';
readln(s);
for i:=1 to length(s) do begin
if isalpha(s) then
s1:=s1+s
else begin
if s1<>'' then insertword(s1);
//produce with word
s1:=''
end
end;
if s1<>'' then insertword(s1)
//produce with word
end;
for i:=numofdict downto 1 do writeln(dict)
end.
页:
[1]