一. 钱币系统问题( 30分 )

    某钱币系统由 k (k≤20) 种硬币组成, 币值依次为 a[1],a[2],...,a[k], 其中 a[i] (i=1,2,...,k) 为互不相同的正整数, 且依降序排列, a[1]≤200. 给定某整数币值 n(n≤3000), 要求用最少枚数的硬币表示这个币值.

    输入: 用文件输入已知数据, 格式为:

      第 1 行: k (硬币种数)

      第 2 行: a[1] a[2] ... a[k] (各币值用空格隔开,已按降序排列好)

      第 3 行: n (给定的币值)

 (参看文件 EXAM1.TXT).

    输出: 直接在屏幕上输出结果. 如果该钱币系统无法表示币值 n,应输出'No', 否则按以下格式输出:

      第 1 行: 最少钱币枚数 r.

      第 2 行: 输出若干形如 m*n 的表达式, m 为币值, n为使用该币值的枚数. 各式第 2 个因子之和应等于 r, 各式乘积之和应等于 n.

    例: 设 (a[1],a[2],a[3])=(5,2,1),  n=12,  则应输出

       3

       5*2  2*1.

program coi962_1; { 钱币系统问题, Write by Li Xuewu }

  type arr10=array [1..10] of integer;

  var

    a,b,b2: arr10;

    i,j,k,n,r,r1: integer;   file1: string[20];

    text1: text;   gree: boolean;

{贪心法子程序}

procedure greedy(n,k:integer; var b2:arr10; var r:integer);

  var j:integer;

begin

  r:=0;

  for j:=1 to k do

    begin

      b2[j]:=n div a[j];

      r:=r+b2[j];  n:=n-b2[j]*a[j];

    end;

  if n>0 then  r:=3000;

end;

{输出结果}

procedure result(r:integer);

  var i:integer;

begin

  if r=3000

    then writeln('No solution!')

  else

    begin

      writeln(r:4);

      for i:=1 to k do

        if  b[i]>0 then  write(a[i]:3,'*',b[i],'  ');

      writeln

    end;

end;

{递归回溯子程序}

procedure find1(w,t:integer;var b2:arr10);

  var i,j,m,w1:integer;

begin{*}

  m:=w div a[t];

  for j:=0 to m do

    begin{**}

      w1:=w;

      if t=1 then r:=0;

      w1:=w1-j*a[t];  r:=r+j;  b2[t]:=j;

      if w1=0 then for i:=t+1 to k do b2[i]:=0;

      if (w1>0)and(r<r1)and(t<k) then find1(w1,t+1,b2);

      if (w1=0)and(r<r1) then

        begin

          r1:=r;

          for i:=1 to k do b[i]:=b2[i];

        end;

      r:=r-j;

    end;{**}

end;{*}

begin {main}

  writeln('input filename:');   readln(file1);

  assign(text1,file1);   reset(text1);

  readln(text1,k);

  r:=0;  r1:=0;

  for i:=1 to k do b[i]:=0;

  b2:=b;

  writeln('Money system:');

  for i:=1 to k do

    begin  read(text1,a[i]); write(a[i]:4); end;

  readln(text1); writeln;

  readln(text1,n); writeln('The number of Money:',n:5);

  close(text1);

  gree:=true;

  for i:=1 to k-1 do if a[i]<(2*a[i+1]) then gree:=false;

  if a[k]>1 then gree:=false;

  r1:=3000;

  greedy(n,k,b,r1);

  if gree  then  result(r1)

    else  begin  find1(n,1,b2); result(r1)  end;

end.

二. 省刻度尺问题( 35分 )

    给定长度为 L 的直尺, L 为整数,且L≤40. 为了能一次直接量出  1,2,...,L 的各种长度, 该尺内部至少要有多少条刻度 ? 请输出最少刻度数(不含两端点)及每个刻度的位置. 测量长度时可利用两端点, 其位置分别为 0, L.

    输入: 由键盘输入 L.

    输出: 用文本文件按以下格式输出结果(文件名: ANS2.TXT):

      第 1 行: S ( 最少刻度数 )

      第 2 行: 尺内 S 个刻度的位置

      第 3 行至第 L+2 行: 每行输出 3 个用空格隔开的整数 t m n, 其中 1≤t≤L 为要测量的各长度, m,n 依次为该长度的起止刻度 (m<n).

    例: 如果 L=6, 则一个正确的输出是:

       2

       1 4                    提示:  (1) 最少刻度数 S 应满足:

       1 0 1                     C[S+2,2]=(S+2)*(S+1)/2≥L.

       2 4 6                         (2) 除两端点外, 第一个刻度可取为

       3 1 4                     A[1]=1, 第二个刻度可在 2, L-2, L-1 这

       4 0 4                     三个数中选取.

       5 1 6

       6 0 6

program coi962_2; { 省刻度尺问题 , Write by Li Xuewu }

  label 10;

  type arr40=array [0..40]of byte;

  var  a,b,c,d:arr40;

       i,j, k,kz,r,m,t1,t2:byte;

       done: boolean;

procedure result;

  var  file1:string[20];

       text2:text;

       i,j,w:integer;

begin

  writeln('enter filename for output:');

  readln (file1);

  assign(text2,file1);   rewrite(text2);  writeln(k:2);

  for i:=1 to k do  write(a[i]:4);

  writeln;

  for i:=1 to m do writeln(i:2, c[i]:4,d[i]:4);

  writeln(text2,k:2);

  for i:=1 to k do  write(text2,a[i]:4);

  writeln(text2);

  for i:=1 to m do writeln(text2,i:2, c[i]:4,d[i]:4);

  close(text2);

  done:=true;

  halt;

end;

procedure init1;

  var i:integer;

begin

  for i:=0 to 40 do b[i]:=0;  c:=b; d:=b;

  for i:=2 to k do a[i]:=0;

  a[0]:=0;  a[k+1]:=m;   a[1]:=1;

end;

procedure find2(r,t1,t2:integer);

  var i,j,j2,v1,v2,t,t3,t4,temp:integer;

begin {1}

  for i:=t1 to t2 do

    begin {2}

      a[r]:=i;

      if (r<k) and (i<t2) then

        begin  t3:=i+1;  find2(r+1,t3,t2); end;

      if r=k then

        begin{3}

          if ((kz=1)or(kz=3)) and (k>2) then

            begin

              temp:=a[2];

              for j:=2 to k-1 do a[j]:=a[j+1];

              a[k]:=temp;

            end;

          for j:=1 to m do b[j]:=0;

          for j:=0 to k  do

          for j2:=j+1 to k+1 do

            begin

              t:=a[j2]-a[j];

              if b[t]=0 then

                begin

                  b[t]:=1; c[t]:=a[j]; d[t]:=a[j2];

                end;

            end;

          done:=true;  j:=0;

          repeat j:=j+1 until (b[j]=0)or(j>m);

          if j<=m then done:=false;

          if done then result;

        end;{3}

    end; {2}

end; {1}

begin{main}

  writeln('inptu L:(L<=40 and L>3)');  readln(m);

  k:=0;

  repeat k:=k+1 until ((k+2)*(k+1) div 2) >= m;

  10: init1;

  for kz:=1 to 3 do

    case kz of

      1: begin{*}

           a[2]:=m-2;

           if k=2

             then find2(2,a[2],a[2])

             else

               begin

                 r:=3; t1:=2;  t2:=m-3;

                 find2(r,t1,t2);

               end;

         end;{*}

      2: begin{**}

           a[2]:=2;

           r:=3; t1:=3;  t2:=m-1;

           if t2<t1 then t2:=t1;

           find2(r,t1,t2);

         end;{**}

      3: begin{***}

           a[2]:=m-1;

           r:=3; t1:=2; t2:=m-2;

           if t2<t1 then t2:=t1;

           find2(r,t1,t2);

         end;{***}

    end;{case}

  k:=k+1;  goto 10;

end.

三. 卡车更新问题( 35分 )

    某人购置了一辆新卡车, 从事个体运输业务. 给定以下各有关数据:   

    R[t], t=1,2,...,k, 表示已使用过 t 年的卡车, 再工作一年所得的运费, 它随 t 的增加而减少, k (k≤20) 年后卡车已无使用价值.

    U[t], t=1,...,k, 表示已使用过 t 年的卡车, 再工作一年所需的维修费, 它随 t 的增加而增加. 

    C[t], t=1,2,...,k, 表示已使用过 t 年的旧卡车, 卖掉旧车, 买进新车, 所需的净费用, 它随 t 的增加而增加. 以上各数据均为实型, 单位为"万元".

    设某卡车已使用过 t 年,

    ① 如果继续使用, 则第 t+1 年回收额为 R[t]-U[t],

    ② 如果卖掉旧车,买进新车, 则 第 t+1 年回收额为 R[0]-U[0]-C[t] .

    该运输户从某年初购车日起,计划工作 N (N<=20) 年, N 年后不论车的状态如何,不再工作. 为使这 N 年的总回收额最大, 应在哪些年更新旧车?  假定在这 N 年内, 运输户每年只用一辆车, 而且以上各种费用均不改变.

    输入: 用文件输入已知数据, 格式为:

      第 1 行: N (运输户工作年限)

      第 2 行: k (卡车最大使用年限, k≤20 )

      第 3 行: R[0] R[1] ... R[k]

      第 4 行: U[0] U[1] ... U[k]

      第 5 行: C[0] C[1] ... C[k]

    输出: 用文本文件按以下格式输出结果(文件名: ANS3.TXT):

      第 1 行: W ( N 年总回收额 )

      第 2--N+1 行: 每行输出 3 个数据:

         年序号     ( 从 1 到 N 按升序输出 );

         是否更新   ( 当年如果更新,输出 1, 否则输出 0);

         当年回收额 ( N 年回收总额应等于 W ).

    例: 设给定以下数据:

      N=4,  k=5,

         i:   0    1    2    3    4    5

      R[i]:   8    7    6    5    4    2

      U[i]:  0.5   1    2    3    4    5

      C[i]:   0    2    3    5    8   10

    则正确输出应是

      24.5

      1    0   7.5

      2    1   5.5

      3    1   5.5

      4    0   6.0

program coi962_3; {卡车更新问题}

  type arr20=array[0..20] of real;

  var rr,uu,cc,d,e:arr20;

      f:array [0..22,0..21] of real;

      g:array [0..22,0..21] of integer;

      i,j,k,k2,n,t:integer;

      file1:string[20];   p,q:real;

      text2,text3:text;

procedure init;

  var i:integer;

begin

  writeln('Input filename:');

  readln(file1);

  assign(text2,file1);  reset(text2);

  readln(text2,n);  readln(text2,k);

  for i:=0 to k do read(text2,rr[i]);  readln(text2);

  for i:=0 to k do read(text2,uu[i]);  readln(text2);

  for i:=0 to k do read(text2,cc[i]);  readln(text2);

  close(text2);

  for i:=0 to k do

    begin d[i]:=rr[i]-uu[i];  e[i]:=d[0]-cc[i];  end;

end;

procedure result3;

  var i:integer;

begin

  writeln('enter filename for output:');

  readln(file1);

  assign(text3,file1);   rewrite(text3);

  writeln(text3,f[1,1]:8:3);

  writeln(text3,' 1  0', e[0]:8:2); t:=1;

  for i:=2 to n do

    if g[i,t]=1 then

      begin writeln(text3,i:2,'  1',e[t]:8:2); t:=1 end

    else

      begin  writeln(text3,i:2,'  0',d[t]:8:2); t:=t+1;  end ;

  writeln(f[1,1]:8:3);

  writeln(' 1  0',e[0]:8:2);  t:=1;

  for i:=2 to n do

    if g[i,t]=1 then

      begin writeln(i:2,'  1',e[t]:8:2); t:=1 end

    else

      begin  writeln(i:2,'  0',d[t]:8:2); t:=t+1;  end ;

  close(text3);

end;

begin {main}

  init;

  for i:=0 to n do

    for j:=0 to k do  g[i,j]:=1;

  for i:=0 to k do  f[n+1,i]:=0;

    for i:=1 to n+1 do f[i,k+1]:=-100;

  for j:=n downto 2 do

    begin

      k2:=k; if j<k then k2:=j-1;

      for t:=1 to k2 do

        begin

          p:=e[t]+f[j+1,1];  q:=d[t]+f[j+1,t+1];

          f[j,t]:=p;   g[j,t]:=1;

          if q>p then

            begin g[j,t]:=0;  f[j,t]:=q;  end;

        end;

    end;

  f[1,1]:=d[0]+f[2,1];

  result3;

end.