简单数字三角形问题如何求解? [复制链接]

下图所示为一个数字三角形宝塔。数字三角形中的数字为不超过100的整数。现规定从最顶层走到最底层，每一步可沿左斜线向下或右斜线向下走。假设三角形行数≤10，键盘输入一个确定的整数值M，编程确定是否存在一条路径，使得沿着该路径所经过的数字的总和恰为M，若存在则给出所有路径，若不存在，则输出“NO Answer!”字样。
7
3 8
8 1 0
2 7 4 4
4 5 2 6 5

也可用三维数组

我的程序
begin
  read(n);
  for i:=1 to n do
    for j:=1 to i do
  read(a[i,j]);
for i:=n-1 downto 1 do
  for j:=1 to i do
    begin
        if a[i+1,j]>=a[i+1,j+1] then a[i,j]:=a[i,j]+a[i+1,j]
                                else a[i,j]:=a[i,j]+a[i+1,j+1];
end;
writeln(a[1,1]);
end.
只给了核心，定义自己写

HOLLE

老孙头真卑鄙！

程序有错，哪位高手能帮忙修改下列程序：

Program ex4_11;
{====================说明部分==================}
Const ernf:array[0..9] of integer=(1,2,4,8,16,32,64,128,256,512);
Type
   arr=array[1..10] of 0..1;
   Link=^node;
    node=record
       Road:arr;        {0:left;    1:right}
       Next:link;
   End;
Var w:array[1..10,1..10] of integer;    
   n,m:integer;
   rr:link;
   f:text;

{====================readset过程====================}
Procedure readset;
Var    i,j:integer;
begin
   assign(f,'input.txt');
   reset(f);
   readln(f,n,m);
   for i:=1 to i do begin
       readln(f,w[i,j]);
       readln(f);
   end;
   close(f);
   new(rr);rr^.next:=nil;
end;

{==================chang过程=================}
Procedure chang(a:integer;var b:arr);
Var i:integer;
Begin
   Fillchar(b,sizeof(b),0);
   For i:=1 to n do begin
b:=a mod 2;
a:=a div 2;
if a=0 then break;
end;
End;

{=================answer过程====================}
Procedure answer(road:arr;var ans:integer);
Var i,j:integer;
Begin
   ans:=0;j:=1;
   For i:=1 to n do begin
       Inc(ans,w[I,j]);
       If road=1 then inc(j);
   End;
End;

{===================jia过程=====================}
Procedure jia(roads:arr);
Var p:link;
Begin
   new(p);
   p^.next:=roads;
   p^.next:=rr^.next;
   rr^.next:=p;
End;

{===================sousuo过程========================}
Procedure sousuo;
Var i,ans:integer;
   Road:arr;
Begin
   for i:=0 to ernf[n-1]-1 do begin
       chang(i,road);
       answer(road,ans);
       if ans=m then jia(road);
   end;
End;

{=================print过程================}
Procedure print;
Var p:link;
   I,j:byte;
Begin
   Assign(f,'d:\output.txt');
   Rewrite(f);
   P:=rr;
   While p^.next;
{for i:=1 to n-1 do write(f,p^.road:2);write(f,'-----');}
   j:=1;
   For i:=1 to n do begin
       Write(f,w[i,j],' ');
       If p^.road=1 then inc(j);
   End;
   Writeln(f);
   End;
   Writeln(f);
End;

{=================主程序==================}
Begin
   readset;
   sousuo;
   print;
End.

回溯穷举