QHD Đường đi cực đại(HSG Bình Thuận)

N

nguyentaingoc

[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!

ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.

Tóm tắt đề
Cho một bảng mxn gồm các số. Bạn được xuất phát từ bất kì ô nào của cột 1, từ ô [i,j] có thể đi qua [i+1,j+1], [i,j+1], [i-1,j+1]. Yêu cầu đến cột cuối cùng sao cho tổng các ô đi qua là lớn nhất.
Dữ liệu vào file văn bản Maxpath.inp
-dón 1 chứ 2 số m,n
-tiếp theo la bảng số ( mảng 2 chiều)
kết quả Ghi ra file Maxpath.out
tiếp đến ghi các vi trị ô đi qua

VD

InPUT
4 5
1 2 6 7 9
7 6 5 6 7
1 2 3 4 2
4 7 8 7 6

OUT
35
2 1
2 2
1 3
1 4
1 5
 
Last edited by a moderator:
N

nguyentaingoc

mikelhpdatke said:
Có thắc mắc gì về code, hay thuật toán bạn cứ post code / thuật toán lên nhé!
Bấm để xem đầy đủ nội dung ...

Mã: 
program ddcd;
uses crt;
var A,K:array[0..30,0..30] of integer;
	f,g:text;
	csmax,j,m,i,z,b,n,c,csi,mmax:integer;
procedure nhap;
begin
assign(f,'C:\Maxpath');reset(f);
readln(m,n);
for i:=1 to m do
	for j:=1 to n do
	readln(f,A[i,j]);
close(f);
end;

function max(z,b,c:integer):integer;
begin
max:=z;
If z < b then
max:=b;
If b < c then
max:=c;
end;

procedure QHD;
begin
for j:=1 to m do
	K[j,1]:=A[j,1];
for i:=1 to m do
	for j:=1 to n do
	K[i,j]:=max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])+A[i,j];


for i:=1 to m do
    if K[i,n]>mmax then mmax:=k[i,n];
end;

procedure xuat;
begin
assign(g,'C:\kq.txt');
rewrite(g);
writeln(g,mmax,n);
i:=csmax;
REPEAT
	begin
	if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i,j-1] then
		begin
		writeln(g,i,' ',j-1);
		K[i,j]:=K[i,j-1];end;

	if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i-1,j-1] then
		begin
		writeln(g,i-1,' ',j-1);
		M[i,j]:=K[i-1,j-1];
		end;
	if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i+1,j-1] then
		begin
		writeln(g,i+1,j-1);
		M[i,j]:=K[i+1,j-1];
		end;
	end;
close(g);
end UNTIL J=1;
END;

begin
clrscr;
nhap;
QHD;
xuat;
end.
 
Q

quanghero100

Code bài đó đây
Mã: 
const fi='input.dat';
      fo='output.dat';
var a,b:array[0..100,0..100] of integer;
    m,n:integer;
    f:text;
procedure input;
var i,j:integer;
begin
    assign(f,fi);
    reset(f);
    readln(f,m,n);
    fillchar(a,sizeof(a),0);
    for i:=1 to m do
       begin
          for j:=1 to n do
             read(f,a[i,j]);
          readln(f);
       end;
    close(f);
end;
function max(a,b,c:integer):integer;
begin
    max:=a;
    if max<b then max:=b;
    if max<c then max:=c;
end;
procedure QHD;
var i,j:integer;
begin
    fillchar(b,sizeof(b),0);
    for i:=1 to m do b[i,1]:=a[i,1];
    for j:=2 to n do
       for i:=1 to m do
          b[i,j]:=max(b[i-1,j-1],b[i,j-1],b[i+1,j-1])+a[i,j];
end;
procedure output;
var i,j,MM,d:integer;
    x,y:array[1..100] of integer;
begin
    assign(f,fo);
    rewrite(f);
    MM:=0;
    for j:=1 to m do
       if MM<b[j,n] then
         begin
            MM:=b[j,n];
            i:=j;
         end;
    writeln(f,MM);
    d:=1;
    x[d]:=i; y[d]:=n;
    repeat
         MM:=max(b[i-1,n-1],b[i,n-1],b[i+1,n-1]);
         if b[i-1,n-1]=MM then begin dec(i); dec(n); end;
         if b[i,n-1]=MM then  dec(n);
         if b[i+1,n-1]=MM then begin inc(i); dec(n); end;
         inc(d);
         x[d]:=i; y[d]:=n;
    until (n=1);
    for i:=d downto 1 do writeln(f,x[i],' ',y[i]);
   close(f);
end;
begin
   input;
   QHD;
   output;
end.
 
M

mikelhpdatke

nguyentaingoc said:
Mã: 
program ddcd;
uses crt;
var A,K:array[0..30,0..30] of integer;
    f,g:text;
    csmax,j,m,i,z,b,n,c,csi,mmax:integer;
procedure nhap;
begin
assign(f,'C:\Maxpath');reset(f);
readln(m,n);
for i:=1 to m do
    for j:=1 to n do
    readln(f,A[i,j]);
close(f);
end;

function max(z,b,c:integer):integer;
begin
max:=z;
If z < b then
max:=b;
If b < c then
max:=c;
end;

procedure QHD;
begin
for j:=1 to m do
    K[j,1]:=A[j,1];
for i:=1 to m do
    for j:=1 to n do
    K[i,j]:=max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])+A[i,j];


for i:=1 to m do
    if K[i,n]>mmax then mmax:=k[i,n];
end;

procedure xuat;
begin
assign(g,'C:\kq.txt');
rewrite(g);
writeln(g,mmax,n);
i:=csmax;
REPEAT
    begin
    if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i,j-1] then
        begin
        writeln(g,i,' ',j-1);
        K[i,j]:=K[i,j-1];end;

    if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i-1,j-1] then
        begin
        writeln(g,i-1,' ',j-1);
        M[i,j]:=K[i-1,j-1];
        end;
    if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i+1,j-1] then
        begin
        writeln(g,i+1,j-1);
        M[i,j]:=K[i+1,j-1];
        end;
    end;
close(g);
end UNTIL J=1;
END;

begin
clrscr;
nhap;
QHD;
xuat;
end.
Bấm để xem đầy đủ nội dung ...

Bạn chưa khởi tạo viền của mảng thì phải :-?..................
 
Q

quanghero100

nguyentaingoc said:
Mã: 
program ddcd;
uses crt;
var A,K:array[0..30,0..30] of integer;
	f,g:text;
	csmax,j,m,i,z,b,n,c,csi,mmax:integer;
procedure nhap;
begin
assign(f,'C:\Maxpath');reset(f);
readln(m,n);
for i:=1 to m do
	for j:=1 to n do
	readln(f,A[i,j]);
close(f);
end;

function max(z,b,c:integer):integer;
begin
max:=z;
If z < b then
max:=b;
If b < c then
max:=c;
end;

procedure QHD;
begin
for j:=1 to m do
	K[j,1]:=A[j,1];
for i:=1 to m do
	for j:=1 to n do
	K[i,j]:=max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])+A[i,j];


for i:=1 to m do
    if K[i,n]>mmax then mmax:=k[i,n];
end;

procedure xuat;
begin
assign(g,'C:\kq.txt');
rewrite(g);
writeln(g,mmax,n);
i:=csmax;
REPEAT
	begin
	if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i,j-1] then
		begin
		writeln(g,i,' ',j-1);
		K[i,j]:=K[i,j-1];end;

	if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i-1,j-1] then
		begin
		writeln(g,i-1,' ',j-1);
		M[i,j]:=K[i-1,j-1];
		end;
	if max(K[i,j-1],K[i-1,j-1],K[i+1,j-1])=K[i+1,j-1] then
		begin
		writeln(g,i+1,j-1);
		M[i,j]:=K[i+1,j-1];
		end;
	end;
close(g);
end UNTIL J=1;
END;

begin
clrscr;
nhap;
QHD;
xuat;
end.
Bấm để xem đầy đủ nội dung ...
không phải là chưa tạo viền đâu :D code này sai ngay ở thủ tục QHĐ
 
You must log in or register to reply here.
Top Bottom