24点 Pascal大暴力程序

24点大暴力程序：

Pascal Code：

const
  dic:array[1..4]of char=('+','-','*','/');
var
  gd:array['!'..'a']of longint;
  q1:array[0..105]of extended;
  q2:array[0..105]of char;
  a:array[1..4]of longint;
  i,j,k,ll,p,q,m,n,x,y,z,l,o,y1,y2,z1,z2,l1,l2,u,ans,qk,top1,top2:longint;
  s,s1,s2,s3,s4:string;
  flag,flagall,broke:boolean;
procedure kill;
begin
  if (q2[top2]='/') and (q1[top1]=0) then
  begin
    broke:=true;
    exit;
  end;
  case q2[top2] of
    '+':q1[top1-1]:=q1[top1-1]+q1[top1];
    '-':q1[top1-1]:=q1[top1-1]-q1[top1];
    '*':q1[top1-1]:=q1[top1-1]*q1[top1];
    '/':q1[top1-1]:=q1[top1-1]/q1[top1];
  end;
  dec(top1);
end;
procedure get;
var
  n,i,sz:longint;
begin
  n:=length(s);
  top1:=0;
  top2:=0;
  sz:=0;
  i:=1;
  broke:=false;
  while i<=n do
  begin
    if s[i] in['0'..'9'] then
    begin
      sz:=0;
      while (i<=n) and (s[i] in['0'..'9']) do
      begin
        sz:=sz*10+ord(s[i])-48;
        inc(i);
      end;
      inc(top1);
      q1[top1]:=sz;
    end else
    if s[i]='(' then
    begin
      inc(top2);
      q2[top2]:='(';
      inc(i);
    end else
    if s[i]=')' then
    begin
      while (top2>0) and (q2[top2]<>'(') do
      begin
        kill;
        dec(top2);
      end;
      dec(top2);
      inc(i);
    end else
    begin
      while (top2>0) and (gd[q2[top2]]>=gd[s[i]]) do
      begin
        kill;
        dec(top2);
      end;
      inc(top2);
      q2[top2]:=s[i];
      inc(i);
    end;
    if broke then
      exit;
  end;
  if (23.99999<q1[1]) and (q1[1]<24.00001) then
  begin
    delete(s,1,1);
    delete(s,length(s),1);
    flagall:=true;
    writeln(s,'=',24);
  end;
end;
begin
  gd['+']:=1;
  gd['-']:=1;
  gd['*']:=2;
  gd['/']:=2;
  while true do
  begin
    writeln('Input:');
    readln(a[1],a[2],a[3],a[4]);
    writeln('Output:');
    flagall:=false;
    for i:=1 to 4 do
      for j:=1 to 4 do
        if i<>j then
          for k:=1 to 4 do
            if (i<>k) and (j<>k) then
              for ll:=1 to 4 do
                if (i<>ll) and (j<>ll) and (k<>ll) and not flagall then
                begin
                  p:=a[i];
                  q:=a[j];
                  m:=a[k];
                  n:=a[ll];
                  str(p,s1);
                  str(q,s2);
                  str(m,s3);
                  str(n,s4);
                  s:='';
                  qk:=0;
                  for x:=0 to 1 do
                    for y:=1 to 4 do
                      for y1:=0 to 1 do
                        for y2:=0 to 1 do
                          for z:=1 to 4 do
                            for z1:=0 to 1 do
                              for z2:=0 to 1 do
                                for l:=1 to 4 do
                                  for l1:=0 to 1 do
                                    for l2:=0 to 1 do
                                      for o:=0 to 1 do
                                      if not flagall then
                                      begin
                                        s:='';
                                        if x=1 then
                                          s:=s+'(';
                                        s:=s+s1;
                                        if y1=1 then
                                          s:=s+')';
                                        s:=s+dic[y];
                                        if y2=1 then
                                          s:=s+'(';
                                        s:=s+s2;
                                        if z1=1 then
                                          s:=s+')';
                                        s:=s+dic[z];
                                        if z2=1 then
                                          s:=s+'(';
                                        s:=s+s3;
                                        if l1=1 then
                                          s:=s+')';
                                        s:=s+dic[l];
                                        if l2=1 then
                                          s:=s+'(';
                                        s:=s+s4;
                                        if o=1 then
                                          s:=s+')';
                                        qk:=0;
                                        for u:=1 to length(s) do
                                        begin
                                          if ((s[u]='+') or (s[u]='-') or (s[u]='*') or (s[u]='/')) and (s[u-1]='(') then
                                          begin
                                            qk:=-1;
                                            break;
                                          end;
                                          if s[u]='(' then
                                            inc(qk);
                                          if s[u]=')' then
                                            if qk=0 then
                                            begin
                                              qk:=-1;
                                              break;
                                            end else
                                              dec(qk);
                                        end;
                                        if qk<>0 then
                                          continue;
                                        s:='('+s+')';
                                        get;
                                      end;
                end;
    if not flagall then
      writeln('No Answer!');
  end;
end.