1. 程式人生 > >P1236 算24點

P1236 算24點

題目描述
幾十年前全世界就流行一種數字遊戲,至今仍有人樂此不疲.在中國我們把這種遊戲稱為“算24點”。您作為遊戲者將得到4個1~9之間的自然數作為運算元,而您的任務是對這4個運算元進行適當的算術運算,要求運算結果等於24。

您可以使用的運算只有:+,-,,/,您還可以使用()來改變運算順序。注意:所有的中間結果須是整數,所以一些除法運算是不允許的(例如,(22)/4是合法的,2*(2/4)是不合法的)。下面我們給出一個遊戲的具體例子:

若給出的4個運算元是:1、2、3、7,則一種可能的解答是1+2+3*7=24。

輸入輸出格式
輸入格式:
只有一行,四個1到9之間的自然數。

輸出格式:
如果有解的話,只要輸出一個解,輸出的是三行資料,分別表示運算的步驟。其中第一行是輸入的兩個數和一個運算子和運算後的結果,第二行是第一行的結果和一個輸入的資料、運算子、運算後的結果,或者是另外兩個數的輸出結果;第三行是前面的結果第二行的結果或者剩下的一個數字、運算子和“=24”。如果兩個運算元有大小的話則先輸出大的。

如果沒有解則輸出“No answer!”

如果有多重合法解,輸出任意一種即可。

注:所有運算結果均為正整數

看到題第一想到的是dfs,就是不知怎麼寫
就下了一個過百行的模擬

var i1,i2,i3,i4,i5,i6,i7:longint;
    m,n,x,y:longint;
    q:array[1..4]of longint;
    a:array[1..4,1..4,1..4]of int64;
    b:array[1..4]of boolean;
    c:array[1..4,1..4,1..4,1..4,1..4]of int64;
function AC(m,n,x:longint):longint;
var y:longint;
begin
  case x of
    1:y:=m+n;
    2:y:=m-n;
    3:y:=m*n;
    4:if (m<>0) and (n<>0) then if m mod n=0 then y:=m div n else y:=10000000 else y:=10000000;
  end;
  if y>=0 then
  exit(y) else exit(10000000);
end;
function fh(x:longint):char;
begin
  case x of
  1:fh:='+';
  2:fh:='-';
  3:fh:='*';
  4:fh:='/';
  end;
end;
begin
  for i1:= 1 to 4 do read(q[i1]);
  for i1:=1 to 4 do
  for i2:=1 to 4 do
  for i3:=1 to 4 do
  if i1<>i2 then
  a[i1,i2,i3]:=AC(q[i1],q[i2],i3);
  for i1:=1 to 4 do b[i1]:=true;
  for i1:=1 to 4 do
  begin
  b[i1]:=false;
  for i2:=1 to 4 do
  if b[i2] then
  begin
  b[i2]:=false;
  for i3:=1 to 4 do
  if b[i3] then
  begin
  b[i3]:=false;
  for i4:=1 to 4 do
  if b[i4] then
  begin
  for i5:=1 to 4 do
  for i6:=1 to 4 do
  if (a[i1,i2,i5]<>10000000) and (a[i3,i4,i6]<>10000000) then
  begin
    for i7:=1 to 4 do
    begin
      y:=AC(a[i1,i2,i5],a[i3,i4,i6],i7);
      if y=24 then
      begin
          if (q[i1]>q[i2]) or (i5=2) or (i5=4) then
        writeln(q[i1],fh(i5),q[i2],'=',a[i1,i2,i5])
          else
        writeln(q[i2],fh(i5),q[i1],'=',a[i1,i2,i5]);
          if (q[i3]>q[i4]) or (i6=2) or (i6=4) then
        writeln(q[i3],fh(i6),q[i4],'=',a[i3,i4,i6])
          else
        writeln(q[i4],fh(i6),q[i3],'=',a[i3,i4,i6]);
          if (a[i1,i2,i5]>a[i3,i4,i6]) or (i7=2) or (i7=4) then
            writeln(a[i1,i2,i5],fh(i7),a[i3,i4,i6],'=',24)
          else
            writeln(a[i3,i4,i6],fh(i7),a[i1,i2,i5],'=',24);
             exit;
            writeln;
      end;
    end;
  end;
  end;
  b[i3]:=true;
  end;
  b[i2]:=true;
  end;
  b[i1]:=true;
  end;
  for i1:=1 to 4 do b[i1]:=true;
  for i1:=1 to 4 do
  begin
    b[i1]:=false;
    for i2:=1 to 4 do
    if b[i2] then
    begin
      b[i2]:=false;
      for i3:=1 to 4 do
      if b[i3] then
      begin
        for i4:=1 to 4 do
        for i5:=1 to 4 do
                begin
          c[i1,i2,i3,i4,i5]:=AC(a[i1,i2,i4],q[i3],i5);
               end;
      end;
      b[i2]:=true;
    end;
    b[i1]:=true;
  end;
  for i1:=1 to 4 do b[i1]:=true;
  for i1:=1 to 4 do
  begin
    b[i1]:=false;
    for i2:=1 to 4 do
    if b[i2] then
    begin
      b[i2]:=false;
      for i3:=1 to 4 do
      if b[i3] then
      begin
            b[i3]:=false;
        for i4:=1 to 4 do
        if b[i4] then
        begin
          for i5:=1 to 4 do
          for i6:=1 to 4 do
          begin
            if c[i1,i2,i3,i5,i6]<>10000000 then
            begin
              for i7:=1 to 4 do
              begin
                y:=AC(c[i1,i2,i3,i5,i6],q[i4],i7);
                if y=24 then
                begin
                  if (q[i1]>q[i2]) or (i5=2) or (i5=4) then
                  writeln(q[i1],fh(i5),q[i2],'=',a[i1,i2,i5])
                  else
                  writeln(q[i2],fh(i5),q[i1],'=',a[i1,i2,i5]);
                  if (a[i1,i2,i5]>q[i3]) or (i6=2) or (i6=4) then
                  writeln(a[i1,i2,i5],fh(i6),q[i3],'=',c[i1,i2,i3,i5,i6])
                  else
                  writeln(q[i3],fh(i6),a[i1,i2,i5],'=',c[i1,i2,i3,i5,i6]);
                  if (c[i1,i2,i3,i5,i6]>q[i4]) or (i7=2) or (i7=4) then
                  writeln(c[i1,i2,i3,i5,i6],fh(i7),q[i4],'=',24)
                  else
                  writeln(q[i4],fh(i7),c[i1,i2,i3,i5,i6],'=',24);
                                  exit;
                end;
              end;
            end;
                  end;
        end;
            b[i3]:=true;
      end;
      b[i2]:=true;
    end;
    b[i1]:=true;
  end;
  writeln('No answer!');
end.//思路清晰,不想解釋

就是懶
在經過老師的一番指點後,終於寫出了dfs

const s='+-*/';某位dalao教我的
type arr=array[0..4]of longint;
var i,j,k:longint;
    m,n:longint;
    r:array[0..6,0..4]of longint;
    x,y:longint;
    a:arr;
procedure write_24;//輸出
var i,j,k:longint;
begin
  for i:=1 to 3 do
  begin
  writeln(r[i,1],s[r[i,2]],r[i,3],'=',r[i,4]);
  end;
  halt;
end;
procedure sss(m,n:longint;g:arr);
var i,j,k:longint;
    a:array[0..4]of longint;
    x,y,p,o:longint;
begin
  if (m=1) then
  if n=24 then write_24
  else exit;
  for i:=1 to m do a[i]:=-1;
  for i:=1 to m-1 do
  for j:=i+1 to m do
  if (i<>j) then
  begin
  x:=g[i];
  y:=g[j];
  if x<y then
  begin
    p:=x;
    x:=y;
    y:=p;
  end;
  for k:=1 to 4 do
  begin
    r[5-m,1]:=x;
    r[5-m,2]:=k;
    r[5-m,3]:=y;
    r[5-m,4]:=-1;
    case k of//分類
      1:r[5-m,4]:=x+y;
      2:r[5-m,4]:=x-y;
      3:r[5-m,4]:=x*y;
      4:if (y<>0) then if x mod y=0 then r[5-m,4]:=x div y;
    end;
    if r[5-m,4]<>-1 then
    begin
      p:=0;
      for o:=1 to m do
      if (o<>i) and (o<>j) then
      begin
        inc(p);
        a[p]:=g[o];
      end;
      inc(p);
      a[p]:=r[5-m,4];
      a[p+1]:=-1;
      sss(m-1,a[p],a);
    end;
  end;
  end;
end;
begin
  for i:=1 to 4 do read(a[i]);
  sss(4,0,a);
  write('No answer!');//無解
end.