pascal 编程

Question

题二、XY球队（Table.pas）
【问题背景】最近葛洲坝修建急需资金。所以XY决定率领他的球队，和别的球队比赛，然后将胜利获得的钱捐给国家。

【问题描述】
XY将和白XY和黑XY（即XY②）各进行一场比赛，由于XY让他们，决定和他比乒乓球，他和白XY的比赛为每局11分他和黑XY的比赛为每局21分，按照乒乓球比赛规则..
奇怪的是白XY和黑XY与XY比赛的两场比赛得分情况相同(即记录相同).
现在有这么一份记录，（其中W表示XY获得一分，L表示XY对手获得一分）：
WWWWWWWWWWWWWWWWWWWWWWLW
在与白XY比赛时，此时比赛的结果是XY第一局11比0获胜，第二局11比0获胜，正在进行第三局，当前比分1比1。而在与黑XY比赛时，此时
比赛结果是XY局21比0获胜，正在进行第二局，比分2比1。如果一局比赛刚开始，则此时比分为0比0。
你的程序就是要对于一系列比赛信息的输入（WL形式），输出正确的结果。

【输入格式】每个输入文件包含若干行字符串（每行至多20个字母），字符串有大写的W、L和E组成。其中E表示比赛信息结束，程序应该忽略E之后的所有内容。

【输出格式】输出由两部分组成，每部分有若干行，每一行对应一局比赛的比分（按比赛信息输入顺序）。其中第一部分是11分制下的结果，第二部分是21分制下的结果，两部分之间由一个空行分隔。

【输入样例】
WWWWWWWWWWWWWWWWWWWW
WWLWE

【输出样例】
11:0
11:0
1:1

21:0
2:1

XY难题之乘积问题（maxmu.pas）
问题描述

今年是国际NX联盟确定的“2008——世界XY年”，又恰逢我国著名数学家XY先生100周岁大寿。在XY先生的家乡福州，组织了一场别开生面的数学智力竞赛的活动，你的牛魔王老师CSNMW也有幸得以参加。活动中，他破解了一道XY先生苦心钻研5年的一道数学难题，题目如下：

设有一个长度为N的数字串，要求选手使用K个乘号将它分成K+1个部分，找出一种分法，使得这K+1个部分的乘积能够为最大。

同时，为了帮助选手能够正确理解题意，主持人还举了如下的一个例子：

有一个数字串：312， 当N=3，K=1时会有以下两种分法：

1) 3*12=36
2) 31*2=62

这时，符合题目要求的结果是：31*2=62

现在，请你也来试一试，向大牛靠拢吧！
输 入

程序的输入共有两行：
第一行共有2个自然数N，K（6≤N≤40，1≤K≤6）
第二行是一个长度为N的数字串。

输 出

结果显示在屏幕上，相对于输入，应输出所求得的最大乘积（一个自然数）。

样 例

输入

4 2
1231

输出
62

Answer 1

program table;
procedure tran(fen:integer);
var temp:char;
w,L:integer;
first:boolean;
begin
w:=0;L:=0;
first:=true;
read(temp);
while temp<>'E' do begin
if temp='W' then
w:=w+1
else if temp='L' then
L:=L+1;
if ((w>=fen) or (L>=fen)) and (abs(w-L)>=2) then begin
writeln(w,':',l);
w:=0;L:=0;
first:=false;
end;
read(temp);
end;
writeln(w,':',L);
end;
begin
tran(11);
writeln;
tran(21);
end.

program maxmu;
const maxn=40;maxk=6;
type arr=array[1..50] of integer;
arr1=array[1..maxn,0..maxk,1..50] of integer;
var f:arr1;
s:string;
a:arr;
n,k,i,j,p,q,k1:integer;
x,y,temp:arr;

procedure mul(var z:arr;y:arr);
var x:arr;m,n,nx,ny,c:integer;
begin
for m:=1 to 50 do x[m]:=z[m];
nx:=50;while (nx>0) and (x[nx]=0) do nx:=nx-1;
ny:=50;while (ny>0) and (y[ny]=0) do ny:=ny-1;
fillchar(z,sizeof(z),0);
c:=0;
for m:=1 to nx do begin
for n:=1 to ny do begin
z[m+n-1]:=z[m+n-1]+c+x[m]*y[n];
c:=z[m+n-1] div 10;
z[m+n-1]:=z[m+n-1] mod 10;
end;
n:=ny+m;
while c>0 do begin z[n]:=c mod 10;c:=c div 10;n:=n+1;end;
end;
end;

procedure max(var x:arr;y:arr);
var nx,ny,i:integer;
begin
nx:=50;while (nx>0) and (x[nx]=0) do nx:=nx-1;
ny:=50;while (ny>0) and (y[ny]=0) do ny:=ny-1;
if nx<ny then for i:=1 to ny do x[i]:=y[i]
else if ny=nx then begin
while (nx>0) and (x[nx]=y[nx]) do nx:=nx-1;
if (nx>0) and (y[nx]>x[nx]) then for i:=nx downto 1 do x[i]:=y[i];
end;
end;

begin
readln(n,k);readln(s);
fillchar(a,sizeof(a),0);
fillchar(f,sizeof(f),0);
for i:=1 to n do a[i]:=ord(s[i])-ord('0');
for i:=1 to n do
for p:=1 to i do f[i,0,p]:=ord(s[i+1-p])-ord('0');
for i:=2 to n do begin
if (i-1)>k then k1:=k else k1:=i-1;
for j:=1 to k1 do begin
for q:=1 to 50 do temp[q]:=f[i,j,q];
for p:=j to i-1 do begin
for q:=1 to 50 do x[q]:=f[p,j-1,q];
fillchar(y,sizeof(y),0);
for q:=1 to i-p do y[q]:=a[i+1-q];
mul(x,y);
max(temp,x);
end;
for q:=1 to 50 do f[i,j,q]:=temp[q];
end;
end;
q:=50;
while (f[n,k,q]=0) and (q>0) do q:=q-1;
if q<1 then writeln('Error')
else
while q>0 do begin write(f[n,k,q]);q:=q-1;end;
writeln;
end.

因该都是对的吧！

Answer 2

program table;
var
xy,xy1,xy2:integer;
ch:char;
program readw(t:char);
begin
xy:=0;
xy1:=0;
repeat
read(t);
case t of
'W':begin
xy:=xy+1;
if (xy=11 and xy1<=9) or (xy>11 and xy-xy1=2)then
begin
writeln(xy:xy1);
xy:=0;
xy1:=0;
end;
'L':begin
xy1:=xy1+1;
if (xy1=11 and xy<=9) or (xy1>11 and xy1-xy=2)then
begin
writeln(xy:xy1);
xy:=0;
xy1:=0;
end;
'E':begin
writeln(xy:xy1);
end;
end;
until t='E';
end;
program readb(t:char);
begin
xy:=0;
xy2:=0;
repeat
read(t);
case t of
'W':begin
xy:=xy+1;
if (xy=11 and xy2<=9) or (xy>11 and xy-xy2=2)then
begin
writeln(xy:xy2);
xy:=0;
xy2:=0;
end;
'L':begin
xy2:=xy2+1;
if (xy2=11 and xy<=9) or (xy2>11 and xy2-xy=2)then
begin
writeln(xy:xy1);
xy:=0;
xy2:=0;
end;
'E':begin
writeln(xy:xy2);
end;
end;
until t='E';
begin
readw(ch);
writeln;
readb(ch);
end.