比赛 NOIP_4 评测结果 AAAWWWAAWW
题目名称 算24点 最终得分 50
用户昵称 0彼岸0 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2008-09-19 21:20:59
显示代码纯文本
type arr=array[1..4]of integer; 
var a:arr; 
    r:array[1..3,1..4]of integer; 
    i:integer; 

procedure print; 
var i,j:integer; 
begin 
  for i:=1 to 3 do 
  begin 
    for j:=1 to 4 do 
    if j=2 then 
    case r[i,j]of 
   1:write('+'); 
   2:write('-'); 
   3:write('*'); 
   4:write('/') ; 
  end 
  else 
    if j=4 then 
    write('=',r[i,j]) 
    else write(r[i,j]); 
         writeln; 
end; 

close(input); 
close(output); 

end; 

procedure try(k:integer;a:arr); 
var x,y,i,j,l,m,t,o:integer; 
    e:arr; 
begin 
  m:=k+1; 
  if(k=3)and(a[1]=24)then 
  begin 
    print; 
    halt; 
  end 
  else 
    for i:=1 to 3-k do 
    begin 
      j:=i+1;  
      x:=a[i];y:=a[j]; 
      r[m,1]:=x;r[m,3]:=y;r[m,4]:=-1;  
      t:=0; 
       for l:=1 to i-1 do begin inc(t);e[t]:=a[l];end; 
       inc(t);o:=t; 
        for l:=i+2 to 4-k do begin inc(t);e[t]:=a[l];end; 
          for l:=1 to 4 do        
        begin 
           case l of 
           1:r[m,4]:=x+y; 
           2:r[m,4]:=x-y; 
           3:r[m,4]:=x*y; 
           4:if y<>0 then if x mod y=0 then r[m,4]:=x div y; 
        end; 
        if r[m,4]>=0 then 
      begin 
        e[o]:=r[m,4]; 
        r[m,2]:=l; 
        try(m,e); 
      end; 
    end; 
 end; 
end; 

begin 
  assign(input,'point24.in'); 
  reset(input); 
  assign(output,'point24.out'); 
  rewrite(output); 
  for i:=1 to 4 do 
  read(a[i]); 
  readln; 
  try(0,a); 
  writeln('No answer!'); 
  close(input); 
  close(output); 
end. 
 type arr=array[1..4]of integer; 
  var a:arr; 
      r:array[1..3,1..4]of integer; 
      i:integer; 

procedure print; 
var i,j:integer; 
begin 
  for i:=1 to 3 do 
  begin 
    for j:=1 to 4 do 
    if j=2 then 
    case r[i,j]of 
    1:write('+'); 
    2:write('-'); 
    3:write('*'); 
    4:write('/') ;  
  end 
  else 
  if j=4 then 
  write('=',r[i,j]) 
  else write(r[i,j]); 
  writeln; 
end; 
  close(input); 
  close(output); 
end; 

procedure try(k:integer;a:arr); 
var x,y,i,j,l,m,t,o:integer; 
    e:arr; 
begin 
  m:=k+1; 
  if(k=3)and(a[1]=24)then 
  begin 
    print; 
    halt; 
  end 
  else 
  for i:=1 to 3-k do 
  begin 
    j:=i+1; 
    x:=a[i];y:=a[j]; 
    r[m,1]:=x;r[m,3]:=y;r[m,4]:=-1; 
    t:=0; 
     for l:=1 to i-1 do begin inc(t);e[t]:=a[l];end; 
     inc(t);o:=t; 
      for l:=i+2 to 4-k do begin inc(t);e[t]:=a[l];end; 
       for l:=1 to 4 do 
       begin 
         case l of 
         1:r[m,4]:=x+y; 
         2:r[m,4]:=x-y; 
         3:r[m,4]:=x*y; 
         4:if y<>0 then if x mod y=0 then r[m,4]:=x div y; 
       end; 
    if r[m,4]>=0 then 
 begin 
    e[o]:=r[m,4]; 
    r[m,2]:=l; 
    try(m,e); 
 end; 
end; 
end; 
end; 

begin 
  assign(input,'point24.in'); 
  reset(input); 
  assign(output,'point24.out'); 
  rewrite(output); 
  for i:=1 to 4 do 
  read(a[i]); 
  readln; 
  try(0,a); 
  writeln('No answer!'); 
  close(input); 
  close(output); 
end.