设为首页收藏本站

cnCalc计算器论坛

 找回密码
 注册
搜索
cnCalc计算器论坛»论坛 › 杂类版块 › 学生学术讨论 › 通过的程序 Uva AOAPC I: Beginning Algorithm Contests ...
返回列表 发新帖
查看: 3267|回复: 6

通过的程序 Uva AOAPC I: Beginning Algorithm Contests Volume 0. Getting Started

[复制链接]
GWHBOB
发表于 2010-8-19 12:04:07 | 显示全部楼层 |阅读模式
pascal版的。
  1. program Hashmat;
  2. var a,b:int64;
  3. begin
  4. while not eof do
  5. begin
  6. readln(a,b);
  7. writeln(abs(a-b))
  8. end
  9. end.
复制代码

  2. program Physics;
  3. var v,t:integer;
  4. begin
  5. while not eof do
  6.    begin
  7.       readln(v,t);
  8.       writeln(2*v*t)
  9.    end
  10. end.
复制代码
  1. program EcologicalPremium;
  2. var n,f,i,j:integer;
  3.     a,b,c,s:int64;
  4. begin
  5. readln(n);
  6. for i:=1 to n do begin
  7.    readln(f);
  8.    s:=0;
  9.    for j:=1 to f do begin
  10.       readln(a,b,c);
  11.       s:=s+a*c;
  12.    end;
  13.    writeln(s)
  14. end
  15. end.
复制代码
  1. program Decoder;
  2. var s:string;
  3.     a:integer;
  4. begin
  5. while not eof do
  6. begin
  7.    readln(s);
  8.    for a:=1 to length(s) do
  9.       write(chr((ord(s[a])-7) mod 256));
  10.    writeln
  11. end
  12. end.
复制代码
  1. program Counting;
  2. var s:string;
  3.     b:boolean;
  4.     i,t:integer;
  5. begin
  6. while not eof do
  7. begin
  8.    readln(s);
  9.    t:=0;b:=false;
  10.    for i:=1 to length(s) do
  11.       if ((65<=ord(s))and(ord(s)<=90)) or
  12.          ((97<=ord(s))and(ord(s)<=122)) then
  13.          begin
  14.             if b=false then t:=t+1;
  15.             b:=true
  16.          end
  17.          else
  18.             b:=false;
  19.    writeln(t)
  20. end
  21. end.
复制代码
  1. program Surface;
  2. var sum,min,t:integer;
  3.     i,j,n:integer;
  4.     s:string;
  5. begin
  6. repeat
  7.    sum:=0;
  8.    min:=25;
  9.    readln(n);
  10.    for i:=1 to n do begin
  11.       t:=0;
  12.       readln(s);
  13.       for j:=1 to length(s) do
  14.          if s[j]=' ' then inc(t);
  15.       sum:=sum+t;
  16.       if t<min then min:=t
  17.    end;
  18.    if n<>0 then writeln(sum-n*min)
  19. until n=0;
  20. end.
复制代码
  1. program Rotate;
  2. var c:array[1..100,1..100] of char;
  3.     i,j,m,n:integer;
  4.     max:integer;
  5.     s:string;
  6. begin
  7.    m:=0;
  8.    n:=0;
  9.    fillchar(c,sizeof(c),' ');
  10.    while not eof do
  11.    begin
  12.       readln(s);
  13.       inc(n);
  14.       j:=length(s);
  15.       if j>m then m:=j;
  16.       for i:=1 to j do c[i,n]:=s;
  17.    end;
  18.    for i:=1 to m do begin
  19.       for j:=1 to n do
  20.          write(c[i,n+1-j]);
  21.       writeln
  22.    end
  23. end.
复制代码
  1. program Maze;
  2. var s:string;
  3.     c:char;
  4.     i,j,n:integer;
  5. begin
  6. while not eof do
  7. begin
  8.    readln(s);
  9.    n:=0;
  10.    for i:=1 to length(s) do begin
  11.       c:=s;
  12.       if c='b' then c:=' ';
  13.       if (48<=ord(c)) and (ord(c)<=57) then
  14.          n:=n+ord(c)-48
  15.       else begin
  16.          for j:=1 to n do write(c);
  17.          n:=0;
  18.       end;
  19.       if c='!' then writeln
  20.    end;
  21.    writeln
  22. end
  23. end.
复制代码
  1. program Wave;
  2. var n,nc,h,f,i,j,k:longint;b:boolean;
  3. begin
  4. read(n);
  5. b:=false;
  6. for nc:=1 to n do begin
  7. read(h,f);
  8. if h*f<>0 then begin
  9.    if b then begin writeln;writeln end;
  10.    for i:=1 to f do begin
  11.       if i>1 then begin writeln;writeln end;
  12.       for j:=1 to h do begin
  13.          for k:=1 to j do write(j);
  14.          if h<>1 then writeln
  15.       end;
  16.       for j:=h-1 downto 1 do begin
  17.          for k:=1 to j do write(j);
  18.          if j<>1 then writeln
  19.       end;
  20.    end;
  21.    b:=true;
  22. end;
  23. end;
  24. writeln;
  25. close(output)
  26. end.
复制代码
  1. program Hangman;
  2. //  O
  3. // /|\
  4. //  |
  5. //  /\
  6. var guess,ans:array[1..26] of boolean;
  7.     stock,sum:longint;
  8.     round,i,t:longint;
  9.     guesss,anss:string;
  10. label 1;
  11. begin
  12. while true do begin
  13.    1: readln(round); if round=-1 then halt; writeln('Round ',round);
  14.    readln(anss); readln(guesss);
  15.    if anss='' then begin writeln('You win.'); goto 1 end;
  16.    if guesss='' then begin writeln('You chickened out.'); goto 1 end;
  17.    for i:=1 to 26 do begin guess:=false; ans:=false end; sum:=0; stock:=0;
  18.    for i:=1 to length(anss) do if ans[ord(anss)-96]=false then begin inc(sum); ans[ord(anss)-96]:=true end;
  19.    for i:=1 to length(guesss) do if guess[ord(guesss)-96]=false then begin
  20.       if ans[ord(guesss)-96]=true then dec(sum) else inc(stock);
  21.       guess[ord(guesss)-96]:=true;
  22.       if sum=0 then begin writeln('You win.'); break end;
  23.       if stock=7 then begin writeln('You lose.'); break end
  24.    end;
  25.    if (sum<>0) and (stock<>7) then writeln('You chickened out.');
  26. end;
  27. end.
复制代码
  1. program Collatz;
  2. var a,lim,num,i:int64;
  3. begin
  4. i:=0;
  5. while true do begin
  6.    readln(a,lim);if(a<0)and(lim<0)then halt;
  7.    num:=0;inc(i);write('Case ',i,': A = ',a,', limit = ',lim,', number of terms = ');
  8.    while(a<=lim)and(a<>1)do begin
  9.       if odd(a) then  a:=3*a+1 else a:=a div 2;inc(num) end;
  10.    if a=1 then inc(num);
  11.    writeln(num);
  12. end;
  13. end.
复制代码
  1. Program Cell;
  2. var a:array[0..41] of longint;
  3.     b:array[1..40] of longint;
  4.     dna:array[0..9] of longint;
  5.     n,nc,c,i,m,k:longint;
  6.     ch:char;
  7. begin
  8. read(n);
  9. for nc:=1 to n do begin
  10.    for i:=0 to 9 do read(dna);
  11.    for i:=0 to 41 do a:=0;
  12.    a[20]:=1;
  13.    for i:=1 to 19 do write(' ');
  14.    write('.');
  15.    for i:=21 to 40 do write(' ');
  16.    writeln;
  17.    for c:=2 to 50 do begin
  18.       for i:=1 to 40 do
  19.          b:=dna[a[i-1]+a+a[i+1]];
  20.       for i:=1 to 40 do begin
  21.          a:=b;
  22.          ch:=' ';
  23.          if a=0 then ch:=' ';
  24.          if a=1 then ch:='.';
  25.          if a=2 then ch:='x';
  26.          if a=3 then ch:='W';
  27.          write(ch);
  28.       end;
  29.       writeln;
  30.    end;
  31.    if nc<>n then writeln;
  32. end;
  33. end.
复制代码
Algorithm, Beginning, Started, Uva, Volume

AOAPC I BeginningAlgorithmContests Volume 0 GettingStarted.rar

4.08 KB, 下载次数: 1
回复

使用道具 举报

zhuloupu4
发表于 2010-8-19 13:31:54 | 显示全部楼层
啥东西
回复 支持 反对

使用道具 举报

hcz
发表于 2010-8-19 15:57:09 | 显示全部楼层
代码都很精辟
回复 支持 反对

使用道具 举报

zhj
发表于 2010-8-20 11:01:56 | 显示全部楼层
我不想再看Pascal了
回复 支持 反对

使用道具 举报

GWHBOB
 楼主| 发表于 2010-9-8 15:13:10 | 显示全部楼层
  1. program Excuse;
  2. var s,s1:string;
  3.     key,ss:array[1..20] of string;
  4.     nums:array[1..20] of integer;
  5.     nk,ns:integer;
  6.     i,j,k,l:integer;
  7.     flag:boolean;
  8.     num,max:integer;
  9. function isalpha(var c:char):boolean;
  10. begin
  11.    if(65<=ord(c))and(ord(c)<=90) then c:=chr(ord(c)+32);
  12.    if(97<=ord(c))and(ord(c)<=122) then isalpha:=true else isalpha:=false
  13. end;
  14. begin
  15. l:=1;
  16. while not eof do begin writeln('Excuse Set #',l);inc(l);
  17. readln(nk,ns);max:=0;
  18. for i:=1 to nk do readln(key[i]);
  19. for k:=1 to ns do begin
  20.    num:=0;s1:='';
  21.    readln(s);
  22.    ss[k]:=s;
  23.    for i:=1 to length(s) do begin
  24.       if isalpha(s[i]) then
  25.          s1:=s1+s[i]
  26.       else begin
  27.          for j:=1 to nk do if key[j]=s1 then inc(num);
  28.          s1:=''
  29.       end
  30.    end;
  31.    for j:=1 to nk do if key[j]=s1 then inc(num);
  32.    nums[k]:=num;
  33.    if max<num then max:=num
  34. end;
  35. for i:=1 to ns do if nums[i]=max then writeln(ss[i]);
  36. writeln
  37. end
  38. end.
复制代码
回复 支持 反对

使用道具 举报

GWHBOB
 楼主| 发表于 2010-9-8 15:18:41 | 显示全部楼层
  1. Program FindWord;
  2. var
  3.     s,s1:string;
  4.     i:integer;
  5. function isalpha(var c:char):boolean;
  6. begin
  7.    if(65<=ord(c))and(ord(c)<=90) then c:=chr(ord(c)+32);
  8.    if(97<=ord(c))and(ord(c)<=122) then isalpha:=true else isalpha:=false
  9. end;
  10. begin
  11. numofdict:=0;
  12. while not eof do begin
  13.    s1:='';
  14.    readln(s);
  15.    for i:=1 to length(s) do begin
  16.       if isalpha(s[i]) then
  17.          s1:=s1+s[i]
  18.       else begin
  19.          //produce with word
  20.          s1:=''
  21.       end
  22.    end;
  23.    //produce with word
  24. end;
  25. end.
复制代码
回复 支持 反对

使用道具 举报

GWHBOB
 楼主| 发表于 2010-9-8 15:41:58 | 显示全部楼层
  1. Program Dictonary;
  2. var dict:array[1..5000] of string;
  3.     numofdict:integer;
  4.     s,s1:string;
  5.     i:integer;
  6. function isalpha(var c:char):boolean;
  7. begin
  8.    if(65<=ord(c))and(ord(c)<=90) then c:=chr(ord(c)+32);
  9.    if(97<=ord(c))and(ord(c)<=122) then isalpha:=true else isalpha:=false
  10. end;
  11. procedure insertword(w:string);
  12. var i,j:integer;
  13. begin
  14.    if numofdict=0 then begin numofdict:=1;dict[1]:=w;exit end;
  15.    i:=1;
  16.    while w<dict[i] do inc(i);
  17.    if w=dict[i] then exit;
  18.    for j:=numofdict downto i do dict[j+1]:=dict[j];
  19.    dict[i]:=w;
  20.    inc(numofdict)
  21. end;
  22. begin
  23. numofdict:=0;
  24. while not eof do begin
  25.    s1:='';
  26.    readln(s);
  27.    for i:=1 to length(s) do begin
  28.       if isalpha(s[i]) then
  29.          s1:=s1+s[i]
  30.       else begin
  31.          if s1<>'' then insertword(s1);
  32.          //produce with word
  33.          s1:=''
  34.       end
  35.    end;
  36.    if s1<>'' then insertword(s1)
  37.    //produce with word
  38. end;
  39. for i:=numofdict downto 1 do writeln(dict[i])
  40. end.
复制代码
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|cnCalc计算器论坛

GMT+8, 2024-12-5 10:39 , Processed in 0.076239 second(s), 24 queries .

Powered by Discuz! X3.4

© 2001-2023 Discuz! Team.

快速回复 返回顶部 返回列表