等价表达式(noip2005)

     3.等价表达式

【问题描述】
    兵兵班的同学都喜欢数学这一科目，中秋聚会这天，数学课代表给大家出了个有关代数表达式的选择题。这个题目的题干中首先给出了一个代数表达式，然后列出了若干选项，每个选项也是一个代数表达式，题目的要求是判断选项中哪些代数表达式是和题干中的表达式等价的。
    这个题目手算很麻烦，因为数学课代表对计算机编程很感兴趣，所以他想是不是可以用计算机来解决这个问题。假设你是数学课代表，能完成这个任务吗？

这个选择题中的每个表达式都满足下面的性质：

1． 表达式只可能包含一个变量‘a’。

2． 表达式中出现的数都是正整数，而且都小于10000。
3． 表达式中可以包括四种运算‘+’（加），‘-’（减），‘*’（乘），‘^’（乘幂），以及小括号‘(’，‘)’。小括号的优先级最高，其次是‘^’，然后是‘*’，最后是‘+’和‘-’。‘+’和‘-’的优先级是相同的。相同优先级的运算从左到右进行。（注意：运算符‘+’，‘-’，‘*’，‘^’以及小括号‘(’，‘)’都是英文字符）

4． 幂指数只可能是1到10之间的正整数（包括1和10）。

5． 表达式内部，头部或者尾部都可能有一些多余的空格。

下面是一些合理的表达式的例子：

((a^1) ^ 2)^3，a*a+a-a，((a+a))，9999+(a-a)*a，1 + (a -1)^3，1^10^9……
【输入文件】

第一行给出的是题干中的表达式。第二行是一个整数n（2 <= n <= 26），表示选项的个数。后面n行，每行包括一个选项中的表达式。这n个选项的标号分别是A，B，C，D……

输入中的表达式的长度都不超过50个字符，而且保证选项中总有表达式和题干中的表达式是等价的。

【输出文件】
输出文件包括一行，这一行包括一系列选项的标号，表示哪些选项是和题干中的表达式等价的。选项的标号按照字母顺序排列，而且之间没有空格。
【样例输入】
( a + 1) ^2
3
(a-1)^2+4*a
a + 1+ a
a^2 + 2 * a * 1 + 1^2 + 10 -10 +a -a
【样例输出】
AC
【数据规模】
对于30%的数据，表达式中只可能出现两种运算符‘+’和‘-’；
对于其它的数据，四种运算符‘+’，‘-’，‘*’，‘^’在表达式中都可能出现。
对于全部的数据，表达式中都可能出现小括号‘(’和‘)’。

 解析：

  （1） 如果直接判断两个表达式等价比较麻烦，笔者也没想出来如何比较。但是我们可以用代数法，以不同的a值代入各式，快速排除那些结果不同的表达式，留下的便是等价的了。（注意，这里的a值最好随机生成，并且最好生成多组，这样基本能保证万无一失）。

   （2）表达式求值，有两种方法，一种是中缀转后缀，然后求值；另一种就是中缀表达式直接求值，笔者喜欢第二种。

     中缀表达式直接求值：

     首先给表达式中所有的运算符和括号根据运算规则都规定不同的等级。根据规定的等级可以求出表达中每个运算符的等级。然后递归求解：

    （1）找到级别最低的运算符opt，将表达式分成左右两部分；

   （2）求opt左边的表达式的值s0；

   （3）求opt左边的表达式的值s1；

    (4)s0  opt s1 。

    运算符的级别：

  

符号	+  -	*   /	^	(	)
优先级	1	2	3	3	-3

{中缀表达式直接求值：给每个运算符根据运算规则制定不同的等级，运算时先找出表达式中级别最低的运算符，将表达式分成左右两部分，先求左边

再求右边，最后求整个表达式的运算结果。}
var
  a:array[0..30] of string;
  f:array[0..30] of boolean;
  b:array[1..4] of integer;
  e:array[0..30,1..4] of int64;
  h:array[1..500] of integer;
  n:integer;
  procedure level(s:string);
  var
    i,len,base:integer;
  begin
    len:=length(s);
    for i:=1 to len do h[i]:=maxint;
    base:=0;
    for i:=1 to len do
      case s[i] of
        '(':inc(base,3);
        ')':dec(base,3);
        '+','-':h[i]:=base+1;
        '*':h[i]:=base+2;
        '^':h[i]:=base+3;
      end;
  end;
  procedure init;
  var i:integer;
  begin
    assign(input,'equal.in'); reset(input);
    readln(a[0]);
    readln(n);
    for i:=1 to n do readln(a[i]);
    close(input);
  end;
  function data(L,r,x,t:integer):integer;
  var i:longint;
  begin
    while (a[t][L]='(') or(a[t][L]=' ')do inc(L);
    while (a[t][r]=')')or (a[t][r]=' ') do dec(r);
    data:=0;
    if a[t][L]='a' then exit(x);
    for i:=L to r do  data:=data*10+ord(a[t][i]) -48;
  end;
  function find(L,r:integer):int64;
  var i,min:integer;
  begin
    min:=maxint;
    find:=0;
    for i:=r downto L do
      if h[i]<min then begin min:=h[i];find:=i; end;
  end;
  function opt(u,k,v:int64;t:integer):int64;
  var i:integer;
  begin
    case a[t][k] of
         '+':opt:=u+v;
         '-':opt:=u-v;
         '*':opt:=u*v;
         '^':begin
               opt:=1;
               for i:=1 to v do opt:=opt*u;
             end;
     end;
  end;
  function work(L,r,x,i:integer):int64;
  var k,u,v:int64;
  begin
    k:=find(L,r);
    if k=0 then exit(data(l,r,x,i));
    u:=work(L,k-1,x,i);
    v:=work(K+1,r,x,i);
    work:=opt(u,k,v,i);
  end;
  procedure main;
  var i,j,len:integer;
      bo:boolean;
  begin
    randomize;
    for i:=1 to 4 do
      b[i]:=random(1000);

    for i:=0 to n do
      begin
        level(a[i]);
        len:=length(a[i]);
        for j:=1 to 4 do   e[i,j]:=work(1,len,b[j],i);
        if i>0 then
        begin
          bo:=true;
          for j:=1 to 4 do if e[i,j]<>e[0,j] then bo:=false;
          if bo then write(chr(64+i));
        end;
      end;
  end;
begin
  assign(output,'equal.out');rewrite(output);
  init;
  main;
  close(output);
end.