一道小学数学题,不过要求编程序解答。 ( 积分: 100 )

  • 主题发起人 LeeChange
  • 开始时间
上午的没写完, 现在补上, 不知道还有没有漏洞 :)
<.
// 测试用例
var fs = [
['(1.8+2)*(3*4)', '(1.8+2)*3*4'],
['3*(((4+5)))', '3*(4+5)'],
['1+1+1', '1+1+1'],
['2/(2/2)', '2/(2/2)'],
['1/((1+1))', '1/(1+1)'],
['1/((5+6))-7', '1/(5+6)-7'],
['(1+2)+3-(4-5)*6*(7*8)/9/(10/11)', '1+2+3-(4-5)*6*7*8/9/(10/11)'],
['(1+2)+3+(3.1+3.2*(4-5)*6*(7*8)/9/(10/11))-(4-5)*6*(7*8)/9/(10/11)', '1+2+3+(3.1+3.2*(4-5)*6*7*8/9/(10/11))-(4-5)*6*7*8/9/(10/11)'],
['(1+2)+3-(((((((((4-5)))*6))*(7*8)))/9))/(10/11)', '1+2+3-(4-5)*6*7*8/9/(10/11)']
]

var Need = false
foreach f = fsdo
var ret = '+' ~ f[0]
// 反复迭代
loop
Need = false
ret = FormatIt(ret)
if not Need then
{exit loop}
end loop
ret = ret.Delete(0, 1)
?? ret ~ /t/t ~ (ret = f[1])
end foreach

function FormatIt(f)
// 嵌套括号
Result = PutOff(f)
function PutOff(f)
Result = ''
var reg = System.Text.Regex('/( ( (?>[^()]+) | (?R) )* /)', 'x')
var mat = reg.Match(f)
while mat.Successdo
Result ~= mat.UnmatchedValue
var newValue = ReplaceIt(mat.Value, '^/( (/(.*/)) /)$', '$1')
//?? newValue
newValue = '(%s)'.Format(PutOff(newValue.SubString(1, newValue.Length-2)))
Result ~= newValue
mat.NextMatch()
end while
Result ~= mat.UnmatchedValue
end function

// 规则定义
// 规则条目
// 前导运算符, 括号内运算符, 后继运算符
var ps = [
['+/-*', '*/'],
['+', '+/-', '+/-']
]
foreach p = psdo
Result = ReplaceIt(Result, GenPattern(p[0], p[1], p[2]), '${A}${B}${C}')
end foreach
end function

function GenPattern(p0, p1, p2)
//var fact = '(?P<F>[/./d]+|/((?P>F)/))'
var fact = '(?P<F> [/./d]+ | /( (?P>F) [+/-*/] (?P>F) /) )'
Result = '(?P<A>[%s]) /( (?P<B>%s ([%s]%s)+)+ /)'
.Format(p0, fact, p1, fact.Replace('F', 'G'))
if p2 <> nil then
Result ~= '(?P<C>[%s]|$)'.Format(p2)
else
Result ~= '(?P<C>)'
end if
end function

function ReplaceIt(f, p, r)
Result =f
while Result.RegexIsMatch(p, 'x')do
Result = Result.RegexReplace(p, r, 'x')
Need = true
end while
end function
.>
 
感觉好像还有漏洞, 估计还得语言解析的方法才行
 
呵呵,我就不评论了,小马过河——自己试试吧:)
 
不是高效的算法,能写出N多
 
信息学奥林匹克书上的原题,待我将它抄上一抄~
 
program p4_6(input,output);
var s:string;
i:integer;
yes,real:boolean;

function list(a,b:char):char;
var dd:char;
begin
if (a='#') then
dd:='>';
if (a in ['+','-'])and(b in ['+','-']) then
dd:='>';
if a in ['*','/'] then
dd:='>';
if (a in ['+','-'])and(b in ['*','/']) then
dd:='<';
list:=dd
end;

procedure pairyes(s:string;var firsttoend,duoyu:boolean);
var i,code:integer;
yes:boolean;
begin
i:=1;code:=0;
if (s='(')and(s[length(s)]=')') then
begin
code:=0;
repeat
if s='(' then
inc(code);
if s=')' then
dec(code);
inc(i)
until (code=0)or(i>length(s));
if (i>length(s))and(code=0) then
firsttoend:=true else
firsttoend:=false;
if code<>0 then
duoyu:=true else
duoyu:=false
end
else
begin
firsttoend:=false;
code:=0;
repeat
if s='(' then
inc(code);
if s=')' then
dec(code);
inc(i)
until (code=0)or(i>length(s));
if code<>0 then
duoyu:=true else
duoyu:=false
end
end;

procedure reducepair(var s:string);
begin
s:=copy(s,2,length(s)-2)
end;

function find(s:string):byte;
var i,k,si,opi:byte;
w:char;
begin
i:=1;si:=0;w:='#';opi:=0;
repeat
if s in ['(',')'] then
repeat
if s='(' then
inc(si);
if s=')' then
dec(si);
inc(i)
until (si=0);
if s in ['+','-','*','/'] then
if list(w,s)='>' then
begin
w:=s;opi:=i end;
inc(i)
until i>length(s);
find:=opi;
end;

function reduce(s:string):string;
var c1,ctemp:byte;
k,s1,s2,temp1,temp2:string;
pair,heli:boolean;
begin
if length(s)=1 then
reduce:=s
else
begin
c1:=find(s);
s1:=copy(s,1,c1-1);
temp1:=s1;
s2:=copy(s,c1+1,length(s));
temp2:=s2;
repeat
pairyes(temp1,pair,heli);
if pair then
reducepair(temp1);
until not pair;
ctemp:=find(temp1);
if (list(temp1[ctemp],s[c1])='>')or(ctemp=0)
then
s1:=reduce(temp1)
else
s1:='('+reduce(temp1)+')';
repeat
pairyes(temp2,pair,heli);
if pair then
reducepair(temp2);
until not pair;
ctemp:=find(temp2);
if (list(temp2[ctemp],s[c1])='>')or(ctemp=0)
then
s2:=reduce(temp2)
else
s2:='('+reduce(temp2)+')';
reduce:=s1+s[c1]+s2;
end;
end;

begin
assign(input,'word.in');
reset(input);
assign(output,'word.out');
rewrite(output);
readln(s);
pairyes(s,yes,real);
if real then
writeln('input wrong!')
else
begin
while yesdo
begin
reducepair(s);pairyes(s,yes,real) end;
writeln(reduce(s));
end;
end.
郁闷。
 
to 楼上:
怎么连program p4_6都抄来了啊?这是94选拔赛第一题,到哪本书上成了第4章第6题啊?
我其实是想等到用dreamfly所说的&quot;语法树&quot;来做这题的解答.
 
不能套条件,是编余原理的压栈出栈问题啊!
 
我原来用堆排序+栈做过一个支持自定义函数、指数等计算的组件,可惜找不到了。
P/S这是南大出版的信息学教材~呵呵~老朽级的
 
看了这么半天,没有一个人用生成节点树的方法,清一色的字符串截取。和楼主的观点一
样,我也希望能够用完全形式化的方法来解决这类问题。其实,扩展开去,四则运算之外,
乘方、开方、逻辑与、或、非、异或等算子,都可以一并考虑进来,用完全形式化的操作符
矩阵来进行推理,而不是简单的将几个符号写死在代码里。这个功能若是做的足够通用,可
以拿来有效的降低代码编译或者解释过程中的嵌套深度。[:D]
最近忙死了...:( 还是继续期待dreamfly兄能出招:)
 

Similar threads

回复
0
查看
855
不得闲
S
回复
0
查看
950
SUNSTONE的Delphi笔记
S
S
回复
0
查看
771
SUNSTONE的Delphi笔记
S
顶部