目录

这是我整理的信息学资料的一部分，包含1996-2008年信息学联赛的题目、题解和程序。希望能够对大家有一定的帮助。所写的程序使用 Free Pascal 编译。这些程序都是我一年或两年前所写，所以分析和代码难免会出现不优美或有问题，如果你发现这样的问题，请及时和我联系。如果你需要其它年份的资料，本站提供这些资料的目录。

1.1.比赛安排(20分)

设有2^n(n<=6)个球队进行单循环比赛,计划在2^n-1天内完成,每个队每天进行一场比赛.设计一个比赛的安排,
使在2^n-1天内每个队都与不同的对手比赛.例如n=2时的比赛安排为:
队    1 2  3 4
比赛  1-2  3-4  第一天
      1-3  2-4  第二天
      1-4  2-3  第三天

简析：设定一个标志数组，标记某两个对是否比赛过。由于是单循环，两者互相比赛，那么数组[A,B]和数组[B,A]都需要设置为True。然后循环判断每天每个队应该和谁比赛即可。

program noip1996_1_bisaianpai;
type integer=longint;
var i,j,k,l,n,m:integer;
    a:array[1..64,1..64]of boolean;
    b:array[1..64]of integer;
function ok(i,j:integer):boolean;
var t:integer;
begin
   for t:=1 to m do
     if (b[t]=i)or(b[t]=j) then exit(false);
   exit(true);
end;
begin
    readln(k);
    for i:=1 to 2**k do
       a[i,i]:=true;
    for i:=1 to 2**k-1 do
    begin
      n:=0;
      fillchar(b,sizeof(b),false);
      m:=0;
      for j:=1 to 2**k do
      begin
         for l:=1 to 2**k do
            if (a[j,l]=false) and (ok(j,l)=true) then
               begin a[j,l]:=true; a[l,j]:=true; m:=m+2; b[m-1]:=j; b[m]:=l; write(j:2,'-',l:2,'  ');
               break;
            end;
         if (n=2**(k-1)) then begin write('ok'); break; end;
      end;
      writeln;
    end;
    for i:=1 to 2**k do
      for j:=1 to 2**k do
        if a[i,j]<>true then write('err at:',j:2,'-',l:2,'  ');
end.

2.2.数制转换(20分)

设字符串A$的结构为: A$='mp'

其中m为数字串(长度<=20),而n,p均为1或2位的数字串(其中所表达的内容在2-10之间)

程序要求:从键盘上读入A$后(不用正确性检查),将A$中的数字串m(n进制)以p进制的形式输出.

例如:A$='48<10>8'

其意义为:将10进制数48,转换为8进制数输出.

输出结果:48<10>=60<8>

简析：这是一个数值转换算法的直接应用。直接贴出程序。

program jinzhizhuanhuan;
type integer=longint;
var s,s1:string[255];
    j1,j2:integer;
    i,j,k:integer;
function getadd(s1,s2:string[255]):string[255];
var l1,l2,l,i,shu1,shu2,shu3,shu4,p:integer;
    ret:string[255];
begin
    l1:=length(s1); l2:=length(s2); if l1>l2 then l:=l1 else l:=l2;
    ret:='';
    shu4:=0; shu3:=0; shu2:=0; shu1:=0;
    for i:=1 to l do
    begin
       shu1:=ord(s1[l1-i+1])-48;
       shu2:=ord(s2[l2-i+1])-48;
       if (s1[l1-i+1]=' ')or(l1-i+1<1) then shu1:=0;
       if (s2[l2-i+1]=' ')or(l2-i+1<1) then shu2:=0;
       shu3:=shu1+shu2+shu4;
       shu4:=shu3 div 10;
       shu3:=shu3 mod 10;
       ret:=chr(shu3+48)+ret;
    end;
    if shu4<>0 then ret:=chr(shu4+48)+ret;
    exit(ret);
end;
function cheng(s1,s2:string[255]):string;
var l1,l2,l,i,j,shu1,shu2,shu3,shu4,k:integer;
    ret,b:string[255];
begin
    l1:=length(s1); l2:=length(s2);
    ret:='0';
    for i:=l1 downto 1 do
      for j:=l2 downto 1 do
      begin
          shu1:=ord(s1[i])-48;
          shu2:=ord(s2[j])-48;
          shu3:=shu1*shu2;
          str(shu3,b);
          if b<>'0' then
             for k:=1 to l1-i+l2-j do
                b:=b+'0';
          ret:=getadd(ret,b);
      end;
    exit(ret);
end;
function chengfang(s1:string[255];l:integer):string[255];
var ret:string[255];
    i:integer;
begin
    ret:='1';
    for i:=1 to l do
      ret:=cheng(ret,s1);
    exit(ret);
end;
function getdiv(s:string;j:integer;var modint:integer):string;
var yushu,l,i,t,shu,ff:integer;
    ret:string[255];
begin
   if s='0' then exit('0');
   ret:='                                        ';
   yushu:=0;
   l:=length(s);
   t:=0;
   for i:=1 to l do
   begin
      shu:=(yushu*10+(ord(s[i])-48));
      ff:=shu div j;
      ret[i]:=chr(ff+48);
      if (t=0)and(ord(ret[i])<>48) then t:=i;
      yushu:=shu mod j;
   end;
   modint:=yushu;
   if t=0 then exit('0');
   exit(copy(ret,t,l-t+1));
end;
function to10jinzhi(nin:string[255];j:integer):string;
var l,i:integer;
    ret,b,b1,f:string[255];
begin
    l:=length(nin);
    ret:='0';
    str(j,b1);
    for i:=1 to l do
    begin
       str(ord(nin[i])-48,b);
       f:=cheng(b,chengfang(b1,l-i));
       ret:=getadd(ret,f);
    end;
    exit(ret);
end;
function zhuanhuan(nin:string[255];j:integer):string;
var ret,b,now,now1:string[255];
    f:integer;
begin
    ret:='';
    now:=nin;
    now1:=getdiv(now,j,f);
    while now<>now1 do
    begin
       now:=now1;
       str(f,b);
       ret:=b+ret;
       now1:=getdiv(now,j,f);
    end;
    if now<>'0' then
    ret:=now+ret;
    exit(ret);
end;
begin
    writeln('Input a string:','  e.g.99136<7>4');readln(s);
    i:=pos('<',s);
    j:=pos('>',s);
    if (i=0) or (j=0) then begin writeln('Wrong number!'); exit; end;
    s1:=copy(s,i+1,j-i-1);
    val(s1,j1);
    val(copy(s,j+1,length(s)),j2);
    writeln(zhuanhuan(to10jinzhi(copy(s,1,i-1),j1),j2));
end.

3.3.字符串编辑(30分)

从键盘输入一个字符串(长度<=40个字符),并以字符'.'结束.

例如:'This  is  a  book.',现对该字符串进行编辑,编辑功能有:

D:删除一个字符,命令的方式为:

  D  a  其中a为被删除的字符

例如:D  s  表示删除字符's',若字符串中有多个's',则删除第一次出现的,如上例中删除的结果为:

        'Thi  is a book.'

I:插入一个字符,命令的格式为:

  I  a1  a2   其中a1表示插入到指定字符前面,a2表示将要插入的字符

例如: I  s  d 表示在指定字符's'的前面插入字符'd',若原串中有多个's',则插入在最后一个字符的前面,

如上例中,原串:'This is a book.'

插入后:'This ids a book.'

R:替换一个字符,命令格式为:

  R  a1  a2 其中a1为被替换的字符,a2为替换的字符,若在原串中有多个a1,则应全部替换

例如:原串:'This  is  a  book.'

输入命令: R  o  e

替换后:' This  is a beek.'

在编辑过程中,若出现被指定的字符不存在时,则给出提示信息

简析：这是一道模拟题，主要考察字符串函数的使用。

program noip1996_3;
var s:string;
    c1,c2,c3,c4,c5:char;
    i,j:integer;
begin
    write('Input a string:'); readln(s);
    while true do
    begin
        write('Delete, Insert, Or Replace?'); read(c1,c2,c3);
        case c1 of
           'D': begin
                   i:=pos(c3,s);
                   if i=0 then writeln('No char!')
                   else
                   begin
                      delete(s,i,1);
                      writeln('New string:',s);
                   end;
                end;
           'I': begin
                   read(c4,c5);
                   i:=pos(c3,s);
                   if i=0 then writeln('Nochar')
                   else
                   begin
                       insert(c5,s,i);
                       writeln('New string:',s);
                   end;
                end;
           'R': begin
                   read(c4,c5);
                   i:=pos(c3,s);
                   while i<>0 do
                   begin
                       s[i]:=c5;
                       i:=pos(c3,s);
                   end;
                   writeln('New string:',s);
                end;
        end;
    end;
end.