Tin học Tây Sơn

Tề thiên hái quả

Go down

Tề thiên hái quả

Bài gửi by Admin on Thu Jan 10, 2019 3:25 pm

Một khu vườn hình chữ nhật kích thước MxN được chia thành các ô vuông đơn vị để trồng một loại cây ăn quả. Trên mỗi ô thì số quả tương ứng có thể hái được là A[i,j] (1<=i<=M; 1<=j<=N).
Tề thiên dạo qua vườn và hái tất cả các quả trên những ô đi qua. Vị trí xuất phát từ ô [1,1] và kết thúc tại ô [M,N] với hành trình là sang ô chung cạnh theo hướng tăng của i hoặc j (sang phải hoặc đi xuống). Hãy viết chương trình tìm lộ trình đi để Tề thiên hái được nhiều quả nhất.
Dữ liệu vào là tệp HAIQUA.INP có cấu trúc như sau:
- Dòng đầu tiên là hai số M, N nguyên dương cách nhau một khoảng cách (0<M,N<100).
- M dòng tiếp theo, mỗi dòng gồm N số tương ứng là số quả có thể hái được ở các ô theo thứ tự tại hàng thứ i. Mỗi số cách nhau một khoảng cách.
Dữ liệu ra là tệp HAIQUA.OUT có cấu trúc như sau:
- Dòng đầu là số quả lớn nhất có thể hái được theo một lộ trình thỏa mãn yêu cầu.
- Dòng tiếp theo gồm M+N-1 số tương ứng là số quả hái ở từng ô theo đường đi để được số quả nhiều nhất. Mỗi số cách nhau ít nhất một khoảng cách.
Ví dụ:
HAIQUA.INP
4 5
1 3 5 7 2
7 9 4 2 2
2 3 1 6 7
7 4 6 2 5

HAIQUA.OUT
41
1 7 9 4 2 6 7 5
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Nguyễn Văn Biên on Thu Jan 10, 2019 9:26 pm

Spoiler:
Code:
program HAIQUA;
var n,m,i,j,k,s,t:integer; f:text;
    A,B:array[1..100,1..100] of integer;
begin
        assign(f,'HAIQUA.INP'); reset(f); readln(f,m,n);
        for i:=1 to m do for j:=1 to n do read(f,A[i,j]);
        close(f); B[m,n]:=A[m,n];
        for i:=m-1 downto 1 do B[i,n]:=B[i+1,n]+A[i,n];
        for i:=n-1 downto 1 do B[m,i]:=B[m,i+1]+A[m,i];
        for i:=m-1 downto 1 do
        for j:=n-1 downto 1 do
        if B[i+1,j]>B[i,j+1] then B[i,j]:=B[i+1,j]+A[i,j] else B[i,j]:=B[i,j+1]+A[i,j];
        assign(f,'HAIQUA.OUT'); rewrite(f); writeln(f,B[i,j]);
        write(f,A[1,1],#32);
        i:=1; j:=1;
        while (i<=m) and (j<=n) do
        if B[i+1,j]>B[i,j+1] then
        begin if A[i+1,j]<>0 then write(f,A[i+1,j],#32); inc(i) end else
        begin if A[i,j+1]<>0 then write(f,A[i,j+1],#32); inc(j) end; close(f)
end.


Được sửa bởi Nguyễn Văn Biên ngày Mon Jan 14, 2019 2:52 pm; sửa lần 1. (Reason for editing : Less code)

_________________

My:
- XDA Account
- Blog
- Game

...
avatar
Nguyễn Văn Biên
Recognised Member & Recognised Developer & Protected Member & Super Administrator
Recognised Member & Recognised Developer & Protected Member & Super Administrator

Posts : 220
Reputation : 1129923
Join date : 18/06/2018
Age : 15
Location : ?

Xem lý lịch thành viên https://bien2004official.blogspot.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Admin on Thu Jan 10, 2019 10:08 pm

Nguyễn Văn Biên đã viết:
Spoiler:

Code:
program HAIQUA;
var n,m,i,j,k,s,t,o,p:integer; f:text;
    A,B:array[1..100,1..100] of integer;
begin
        assign(f,'HAIQUA.INP'); reset(f);
        readln(f,n,m); o:=n; p:=m;
        for i:=1 to n do
        for j:=1 to m do read(f,a[i,j]);
        close(f);
        B[n,m]:=A[n,m];
        for i:=n-1 downto 1 do B[i,m]:=B[i+1,m]+A[i,m];
        for i:=m-1 downto 1 do B[n,i]:=B[n,i+1]+A[n,i];
        for i:=n-1 downto 1 do
        for j:=m-1 downto 1 do
        if B[i+1,j]>B[i,j+1] then B[i,j]:=B[i+1,j]+A[i,j]
        else B[i,j]:=B[i,j+1]+A[i,j];
        assign(f,'HAIQUA.OUT'); rewrite(f);
        writeln(f,B[i,j]);
        write(f,A[1,1],#32);
        i:=1; j:=1;
        while (i<=n) and (j<=m) do
        if B[i+1,j]>B[i,j+1] then
        begin if A[i+1,j]<>0 then write(f,A[i+1,j],#32); inc(i) end else
        begin if A[i,j+1]<>0 then write(f,A[i,j+1],#32); inc(j) end;
        close(f)
end.

so sánh A[i+1,j]<>0 để chi vậy Biên?
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by tonguyengiahan237 on Fri Jan 11, 2019 8:38 pm

Code:
Program Te_thien_hai_qua;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
Var M,N:integer;
    A,B:Mang2c;
    fi,fo:text;

Procedure Docdl;
Var i,j:integer;
Begin
Assign(fi,'Haiqua.inp');
Reset(fi);
Readln(fi,M,N);
For i:=1 to M do
For j:=1 to N do
Read(fi,A[i,j]);
Close(fi);
End;

Function Max(i,j:integer):integer;
Begin
If i>j then Max:=i
else Max:=j;
End;

Procedure T_b;
Var i,j:integer;
Begin
B[m,n]:=A[m,n];
For i:=m-1 downto 1 do
B[i,n]:=A[i,n]+B[i+1,n];
For j:=n-1 downto 1 do
B[m,j]:=A[m,j]+B[m,j+1];
For i:=m-1 downto 1 do
For j:=n-1 downto 1 do
B[i,j]:=A[i,j]+Max(B[i,j+1],B[i+1,j]);
End;

Procedure Xuli;
Var i,j,t:integer;
Begin
Assign(fo,'HAIQUA.OUT');
Rewrite(fo);
Writeln(fo,B[1,1]);
Write(fo,A[1,1],#32);
i:=1;j:=1;
While t<>0 do
        Begin
        If (B[i,j+1]>B[i+1,j]) then
                begin
                inc(j);
                If (i=m) and (j=n) then t:=0;
                If t<>0 then Write(fo,A[i,j],#32);
                end
        else
                begin
                inc(i);
                If (i=m) and (j=n) then t:=0;
                If t<>0 then Write(fo,A[i,j],#32);
                end;
        End;
Write(fo,A[m,n]);
Close(fo);
End;

BEGIN
CLRSCR;
Docdl;
T_b;
Xuli;
READLN;
END.


Được sửa bởi tonguyengiahan237 ngày Sat Jan 12, 2019 2:37 pm; sửa lần 4.
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Admin on Fri Jan 11, 2019 9:17 pm

tonguyengiahan237 đã viết:
Code:
Program Te_thien_hai_qua;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
     Mang1c=array[1..50]of integer;
Var M,N,k,c:integer;
    A,B:Mang2c;
    Q:Mang1c;
    fi,fo:text;

Procedure Docdl;
Var i,j:integer;
Begin
Assign(fi,'Haiqua.inp');
Reset(fi);
Readln(fi,M,N);
For i:=1 to M do
For j:=1 to N do
Read(fi,A[i,j]);
Close(fi);
End;

Function Max(i,j:integer):integer;
Begin
If i>j then Max:=i
else Max:=j;
End;

Procedure T_b;
Var i,j:integer;
Begin
B[m,n]:=A[m,n];
For i:=m-1 downto 1 do
B[i,n]:=A[i,n]+B[i+1,n];
For j:=n-1 downto 1 do
B[m,j]:=A[m,j]+B[m,j+1];
For i:=m-1 downto 1 do
For j:=n-1 downto 1 do
B[i,j]:=A[i,j]+Max(B[i,j+1],B[i+1,j]);
End;

Procedure Xuli;
Var i,j,t:integer;
Begin
Q[1]:=A[1,1];
k:=2;
i:=1;j:=1;
While t<>0 do
        Begin
        If (B[i,j+1]>B[i+1,j]) then
                begin
                inc(j);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end
        else
                begin
                inc(i);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end;
        End;
Q[k]:=A[m,n];
inc(k);
End;

Function Tong(Q:Mang1c):integer;
Var i:integer;
Begin
Tong:=0;
For i:=1 to k-1 do
Tong:=Tong+Q[i];
End;

BEGIN
CLRSCR;
Docdl;
T_b;
Xuli;
Assign(fo,'HAIQUA.OUT');
Rewrite(fo);
Writeln(fo,Tong(Q));
For c:=1 to k-1 do
Write(fo,Q[c],#32);
Close(fo);
READLN;
END.
Thầy không hiểu câu lệnh này:If (i=4) and (j=5) then t:=0;
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by tonguyengiahan237 on Fri Jan 11, 2019 9:29 pm

Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Te_thien_hai_qua;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
     Mang1c=array[1..50]of integer;
Var M,N,k,c:integer;
    A,B:Mang2c;
    Q:Mang1c;
    fi,fo:text;

Procedure Docdl;
Var i,j:integer;
Begin
Assign(fi,'Haiqua.inp');
Reset(fi);
Readln(fi,M,N);
For i:=1 to M do
For j:=1 to N do
Read(fi,A[i,j]);
Close(fi);
End;

Function Max(i,j:integer):integer;
Begin
If i>j then Max:=i
else Max:=j;
End;

Procedure T_b;
Var i,j:integer;
Begin
B[m,n]:=A[m,n];
For i:=m-1 downto 1 do
B[i,n]:=A[i,n]+B[i+1,n];
For j:=n-1 downto 1 do
B[m,j]:=A[m,j]+B[m,j+1];
For i:=m-1 downto 1 do
For j:=n-1 downto 1 do
B[i,j]:=A[i,j]+Max(B[i,j+1],B[i+1,j]);
End;

Procedure Xuli;
Var i,j,t:integer;
Begin
Q[1]:=A[1,1];
k:=2;
i:=1;j:=1;
While t<>0 do
        Begin
        If (B[i,j+1]>B[i+1,j]) then
                begin
                inc(j);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end
        else
                begin
                inc(i);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end;
        End;
Q[k]:=A[m,n];
inc(k);
End;

Function Tong(Q:Mang1c):integer;
Var i:integer;
Begin
Tong:=0;
For i:=1 to k-1 do
Tong:=Tong+Q[i];
End;

BEGIN
CLRSCR;
Docdl;
T_b;
Xuli;
Assign(fo,'HAIQUA.OUT');
Rewrite(fo);
Writeln(fo,Tong(Q));
For c:=1 to k-1 do
Write(fo,Q[c],#32);
Close(fo);
READLN;
END.
Thầy không hiểu câu lệnh này:If (i=4) and (j=5) then t:=0;

Em sai chỗ đó đáng lẽ là : If (i=m) and (j=n) then t:=0 mới đúng ạ Razz
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Admin on Fri Jan 11, 2019 9:32 pm

tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Te_thien_hai_qua;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
     Mang1c=array[1..50]of integer;
Var M,N,k,c:integer;
    A,B:Mang2c;
    Q:Mang1c;
    fi,fo:text;

Procedure Docdl;
Var i,j:integer;
Begin
Assign(fi,'Haiqua.inp');
Reset(fi);
Readln(fi,M,N);
For i:=1 to M do
For j:=1 to N do
Read(fi,A[i,j]);
Close(fi);
End;

Function Max(i,j:integer):integer;
Begin
If i>j then Max:=i
else Max:=j;
End;

Procedure T_b;
Var i,j:integer;
Begin
B[m,n]:=A[m,n];
For i:=m-1 downto 1 do
B[i,n]:=A[i,n]+B[i+1,n];
For j:=n-1 downto 1 do
B[m,j]:=A[m,j]+B[m,j+1];
For i:=m-1 downto 1 do
For j:=n-1 downto 1 do
B[i,j]:=A[i,j]+Max(B[i,j+1],B[i+1,j]);
End;

Procedure Xuli;
Var i,j,t:integer;
Begin
Q[1]:=A[1,1];
k:=2;
i:=1;j:=1;
While t<>0 do
        Begin
        If (B[i,j+1]>B[i+1,j]) then
                begin
                inc(j);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end
        else
                begin
                inc(i);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end;
        End;
Q[k]:=A[m,n];
inc(k);
End;

Function Tong(Q:Mang1c):integer;
Var i:integer;
Begin
Tong:=0;
For i:=1 to k-1 do
Tong:=Tong+Q[i];
End;

BEGIN
CLRSCR;
Docdl;
T_b;
Xuli;
Assign(fo,'HAIQUA.OUT');
Rewrite(fo);
Writeln(fo,Tong(Q));
For c:=1 to k-1 do
Write(fo,Q[c],#32);
Close(fo);
READLN;
END.
Thầy không hiểu câu lệnh này:[size=32]If (i=4) and (j=5) then t:=0;[/size]

Em sai chỗ đó đáng lẽ là : If (i=m) and (j=n) then t:=0 mới đúng ạ Razz
Hàm Tong() có cần thiết ko?
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by tonguyengiahan237 on Fri Jan 11, 2019 9:34 pm

Admin đã viết:
tonguyengiahan237 đã viết:
Admin đã viết:
tonguyengiahan237 đã viết:
Code:
Program Te_thien_hai_qua;
Uses crt;
Type Mang2c=array[1..50,1..50]of integer;
     Mang1c=array[1..50]of integer;
Var M,N,k,c:integer;
    A,B:Mang2c;
    Q:Mang1c;
    fi,fo:text;

Procedure Docdl;
Var i,j:integer;
Begin
Assign(fi,'Haiqua.inp');
Reset(fi);
Readln(fi,M,N);
For i:=1 to M do
For j:=1 to N do
Read(fi,A[i,j]);
Close(fi);
End;

Function Max(i,j:integer):integer;
Begin
If i>j then Max:=i
else Max:=j;
End;

Procedure T_b;
Var i,j:integer;
Begin
B[m,n]:=A[m,n];
For i:=m-1 downto 1 do
B[i,n]:=A[i,n]+B[i+1,n];
For j:=n-1 downto 1 do
B[m,j]:=A[m,j]+B[m,j+1];
For i:=m-1 downto 1 do
For j:=n-1 downto 1 do
B[i,j]:=A[i,j]+Max(B[i,j+1],B[i+1,j]);
End;

Procedure Xuli;
Var i,j,t:integer;
Begin
Q[1]:=A[1,1];
k:=2;
i:=1;j:=1;
While t<>0 do
        Begin
        If (B[i,j+1]>B[i+1,j]) then
                begin
                inc(j);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end
        else
                begin
                inc(i);
                If (i=4) and (j=5) then t:=0;
                If t<>0 then
                        begin
                        Q[k]:=A[i,j];
                        inc(k);
                        end;
                end;
        End;
Q[k]:=A[m,n];
inc(k);
End;

Function Tong(Q:Mang1c):integer;
Var i:integer;
Begin
Tong:=0;
For i:=1 to k-1 do
Tong:=Tong+Q[i];
End;

BEGIN
CLRSCR;
Docdl;
T_b;
Xuli;
Assign(fo,'HAIQUA.OUT');
Rewrite(fo);
Writeln(fo,Tong(Q));
For c:=1 to k-1 do
Write(fo,Q[c],#32);
Close(fo);
READLN;
END.
Thầy không hiểu câu lệnh này:[size=32]If (i=4) and (j=5) then t:=0;[/size]

Em sai chỗ đó đáng lẽ là : If (i=m) and (j=n) then t:=0 mới đúng ạ Razz
Hàm Tong() có cần thiết ko?
Dạ không
avatar
tonguyengiahan237
Nhiệt tình
Nhiệt tình

Posts : 42
Reputation : -1
Join date : 06/11/2018
Age : 14
Location : TT Phú Phong Huyện Tây Sơn Tỉnh Bình Định

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by nguyen77 on Fri Jan 11, 2019 10:02 pm

Code:
program bt;
uses crt;
var i,n,j,s,m,d,l:longint;
    a,b:array[1..100,1..100] of longint;
    c:array[1..100] of longint;
    fi,fo:text;
procedure doc;
begin
assign(fi,'tethien.inp');
reset(fi);
readln(fi,n,m);
for i:=1 to n do
        begin
                for j:=1 to m do
                        read(fi,a[i,j]);
                        readln(fi);
        end;
end;

//-------------------------

begin
clrscr;
doc;
assign(fo,'tethien.out');
rewrite(fo);
b[n,m]:=a[n,m];
for i:=n-1 downto 1 do
        b[i,m]:=b[i+1,m]+a[i,m];
for i:=m-1 downto 1 do
        b[n,i]:=b[n,i+1]+a[n,i];
for i:=n-1 downto 1 do
        for j:=m-1 downto 1 do
                if b[i+1,j]>b[i,j+1] then
                        b[i,j]:=b[i+1,j]+a[i,j]
                else
                b[i,j]:=b[i,j+1]+a[i,j];
i:=1;
d:=1;
j:=1;
writeln(fo,b[1,1]);
write(fo,a[1,1],#32);
while (i<n) and (j<m) do
        begin
                if b[i+1,j]>=b[i,j+1] then
                        begin
                                write(fo,a[i+1,j],#32);
                                inc(i);
                        end
                else
                        begin
                                write(fo,a[i,j+1],#32);
                                inc(j);
                        end;
        end;
write(fo,a[n,m]);
close(fo);
readln;
end.

for i:=n-1 downto 1 do
for j:=m-1 downto 1 do
if b[i+1,j]>b[i,j+1] then
b[i,j]:=b[i+1,j]+a[i,j]
else
b[i,j]:=b[i,j+1]+a[i,j];
chỗ này em chưa hiểu lắm nên có tham khảo
avatar
nguyen77
Năng động
Năng động

Posts : 75
Reputation : -309991
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by nguyen77 on Sat Jan 12, 2019 2:39 pm

Code:
program bt;
uses crt;
var i,n,j,s,m,d,l:longint;
    a,b:array[1..100,1..100] of longint;
    c:array[1..100] of longint;
    fi,fo:text;
procedure doc;
begin
assign(fi,'tethien.inp');
reset(fi);
readln(fi,n,m);
for i:=1 to n do
        begin
                for j:=1 to m do
                        read(fi,a[i,j]);
                        readln(fi);
        end;
end;

//-------------------------

procedure phuongan;
begin
b[n,m]:=a[n,m];
for i:=n-1 downto 1 do
        b[i,m]:=b[i+1,m]+a[i,m];
for i:=m-1 downto 1 do
        b[n,i]:=b[n,i+1]+a[n,i];
for i:=n-1 downto 1 do
        for j:=m-1 downto 1 do
                if b[i+1,j]>b[i,j+1] then
                        b[i,j]:=b[i+1,j]+a[i,j]
                else
                b[i,j]:=b[i,j+1]+a[i,j];
writeln(' Bang Phuong An ');
for i:=1 to n do
        begin
        for j:=1 to m do
                write(b[i,j],#32);
                writeln;
        end;
end;

//----------------------------------------

procedure truyvet;
begin
clrscr;
doc;
phuongan;
assign(fo,'tethien.out');
rewrite(fo);
i:=1;
j:=1;
writeln(fo,b[1,1]);
write(fo,a[1,1],#32);
while (i<n) OR (j<m) do
        begin
                if b[i+1,j]>=b[i,j+1] then
                        begin
                                write(fo,a[i+1,j],#32);
                                inc(i);
                        end
                else
                        begin
                                write(fo,a[i,j+1],#32);
                                inc(j);
                        end;
end;
close(fo);
end;

//----------------------------------

begin
truyvet;
readln;
end.
Code hoàn chỉnh :3
avatar
nguyen77
Năng động
Năng động

Posts : 75
Reputation : -309991
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Tạ Thúy Phượng on Sat Jan 12, 2019 2:51 pm

code:
program bt;
uses crt;
var
n,m,i,j,t,tong,k:integer;
a,b:array[1..100,1..100] of integer;
c:array[1..100] of integer;
fi,fo:text;
//------------------------
procedure doc;
begin
assign(fi,'HAIQUA.INP');
reset(fi);
readln(fi,m,n);
for i:=1 to m do
for j:=1 to n do
read(fi,a[i,j]);
close(fi);
end;
//-----------------------
Procedure Bang_PA;
Begin
b[m,n]:=a[m,n];
For i:=m-1 downto 1 do
       b[i,n]:=a[i,n]+b[i+1,n];
For j:=n-1 downto 1 do
       b[m,j]:=a[m,j]+b[m,j+1];
For i:=m-1 downto 1 do
       For j:=n-1 downto 1 do
       IF b[i,j+1]>b[i+1,j] then
               b[i,j]:=a[i,j]+b[i,j+1]
               else  b[i,j]:=a[i,j]+b[i+1,j];
End;
//----------------------------------------
procedure hai_qua;
begin
assign(fo,'HAIQUA.OUT');
rewrite(fo);
writeln(fo,b[1,1]);
i:=1;j:=1;
write(fo,a[i,j],#32);
While (m<>i) or (n<>j) do
       Begin
       If (b[i,j+1]>b[i+1,j]) then inc(j)
       else  inc(i);
       write(fo,a[i,j],#32);
       end;
close(fo);
end;
//---------------------------------------------
begin
doc;
Bang_PA;
hai_qua;
readln;
end.


Được sửa bởi Tạ Thúy Phượng ngày Sat Jan 12, 2019 3:04 pm; sửa lần 1.
avatar
Tạ Thúy Phượng
Năng động
Năng động

Posts : 66
Reputation : -259993
Join date : 18/06/2018
Location : Binh Thuan-Tay Son-Binh Dinh

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by quantran on Sat Jan 12, 2019 2:53 pm

Code:
program haiqua;
var
n,m,i,j,p,q:integer;
a,b:array[1..100,1..100] of integer;
fi,fo:text;

//------------------------------
procedure nhap;
begin
assign(fi,'haiqua.inp');
reset(fi);
readln(fi,m,n);
for i:=1 to m do
for j:=1 to n do
read(fi,a[i,j]);
close(fi);
end;
//-----------------------------------
Function Max(x,y:integer):integer;
Begin
If x>y then Max:=x
else Max:=y;
End;
//-------------------------------
Procedure bangpp;
Var
i,j:integer;
Begin
b[m,n]:=a[m,n];
for i:=m-1 downto 1 do
b[i,n]:=a[i,n]+b[i+1,n];
for j:=n-1 downto 1 do
b[m,j]:=a[m,j]+b[m,j+1];
for i:=m-1 downto 1 do
for j:=n-1 downto 1 do
b[i,j]:=a[i,j]+Max(b[i,j+1],b[i+1,j]);
        for i:=1 to m do
                begin
                for j:=1 to n do
                write(b[i,j],' ');
                writeln;
                end;
End;
//----------------------------
procedure xuli;
begin
assign(fo,'HAIQUA.out');
rewrite(fo);
bangpp;
i:=1;
j:=1;
writeln(fo,b[1,1]);
write(fo,a[1,1],' ');
while (i<>m) or (j<>n) do
        begin
                if b[i+1,j]>=b[i,j+1] then
                        begin
                                write(fo,a[i+1,j],' ');
                                inc(i);
                        end
                else
                        begin
                                write(fo,a[i,j+1],' ');
                                inc(j);
                        end;
        end;
close(fo);
end;
//---------------------------
begin
nhap;
xuli;
readln;
end.
avatar
quantran
Năng động
Năng động

Posts : 77
Reputation : -339986
Join date : 18/06/2018
Age : 14
Location : Binh Thuan-Tay Son-Binh Dinh

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by mainhatthong2004 on Sat Jan 12, 2019 2:56 pm

thong:
program bai5;
uses crt;
var fi,fo:text;
a,b:array [1..100,1..100] of integer;
m,n,i,j:integer;
//---------------------------------------
function max(c,d:integer):integer;
begin
if c>d then
max:=c else
max:=d;
if c=d then
max:=c;
end;
//--------------------------------------
procedure nhap;
begin
assign(fi,'HAIQUA.inp');
reset(fi);
readln(fi,m,n);
for i:=1 to m do
begin
for j:=1 to n do
read(fi,a[i,j]);
readln(fi);
end;
close(fi);
end;
//------------------------------------------
procedure xl;
begin
assign(fo,'HAIQUA.out');
rewrite(fo);
b[m,n]:=a[m,n];
for i:=n-1 downto 1 do
b[m,i]:=b[m,i+1]+a[m,i];
for i:=m-1 downto 1 do
b[i,n]:=b[i+1,n]+a[i,n];
for i:=m-1 downto 1 do
for j:=n-1 downto 1 do
b[i,j]:=a[i,j]+max(b[i+1,j],b[i,j+1]);
writeln(fo,b[1,1]);
for i:=1 to m do
begin
for j:=1 to n do
write(b[i,j],' ');
writeln;
end;
i:=1; j:=1;
write(fo,a[1,1],' ');
while (i<>m) or (j<>n) do
begin
if b[i+1,j]>b[i,j+1] then
inc(i) else inc(j);
write(fo,a[i,j],' ');
end;
close(fo);
end;
//---------------------------------------
begin
clrscr;
nhap;
xl;
readln;
end.
avatar
mainhatthong2004
Teen cá tính
Teen cá tính

Posts : 85
Reputation : -369988
Join date : 18/06/2018

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Cao Hải Dương on Sat Jan 12, 2019 2:59 pm

DUONG:
Code:
Program Te_thien_hai_qua;
Uses crt;
Var fi,fo:text; i,j,m,n,t:longint;
a,b:array[1..100,1..100] of longint;

Procedure bangPA;
Begin
b[m,n]:=a[m,n];
For i:=m-1 downto 1 do
        b[i,n]:=a[i,n]+b[i+1,n];
For i:=n-1 downto 1 do
        b[m,i]:=a[m,i]+b[m,i+1];
For i:=m-1 downto 1 do
        For j:=n-1 downto 1 do
                If b[i,j+1] > b[i+1,j] then b[i,j]:=a[i,j]+b[i,j+1]
                        else b[i,j]:=a[i,j]+b[i+1,j];
End;

Procedure truy_vet;
Begin
Assign(fo,'HAIQUA.OUT'); Rewrite(fo);
i:=1; j:=1;
Writeln(fo,b[1,1]);
Write(fo,a[i,j],#32);
While (i<>m) or (j<>n) do
        Begin
        If b[i,j+1] >= b[i+1,j] then inc(j) else inc(i);
        Write(fo,a[i,j],#32);
        End;
Close(fo);
End;

Begin
Clrscr;
Assign(fi,'HAIQUA.INP'); Reset(fi);
Readln(fi,m,n);
For i:=1 to m do
        Begin
        For j:=1 to n do Read(fi,a[i,j]);
        Readln(fi);
        End;
Close(fi);
bangPA;
truy_vet;
Readln;
End.


Được sửa bởi Cao Hải Dương ngày Sat Jan 12, 2019 3:01 pm; sửa lần 2.
avatar
Cao Hải Dương
Nhiệt tình
Nhiệt tình

Posts : 58
Reputation : -329968
Join date : 18/06/2018
Age : 14
Location : Bình Định

Xem lý lịch thành viên http://starduongdesign.blogspot.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by nganvonhat123 on Sat Jan 12, 2019 2:59 pm

Code:
program haiqua;

uses crt;
        var fi,fo:text;
            i,j,m,n,t1,t2,s,x:integer;
            a,b:array[1..100,1..100]of integer;


        procedure nhap;
        begin
                assign(fi,'haiqua.inp');
                reset(fi);
                readln(fi,n,m);
                for i:=1 to n do
                begin
                        for j:=1 to m do
                                read(fi,a[i,j]);
                                writeln;
                end;
                close(fi);
        end;

        procedure timb;
        begin
                b[n,m]:=a[n,m];
                for i:=n-1 downto 1 do b[i,m]:=b[i+1,m]+a[i,m];
                for j:=m-1 downto 1 do b[n,j]:=b[n,j+1]+a[n,j];
                for i:=n-1 downto 1 do
                        for j:=m-1 downto 1 do
                        if b[i,j+1]>b[i+1,j] then b[i,j]:=b[i,j+1]+a[i,j]
                                else
                        b[i,j]:=b[i+1,j]+a[i,j];
        end;

        procedure tim;
        begin
                assign(fo,'haiqua.out');
                rewrite(fo);
                timb;
                writeln(fo,b[1,1]);
                i:=1;j:=1;write(fo,a[i,j],#32);
                while (i<>n) or (j<>m) do
                begin

                if b[i,j+1]>b[i+1,j] then  inc(j)
                        else inc(i);
                write(fo,a[i,j],#32);
                end;

                close(fo);
        end;


BEGIN
clrscr;
nhap;
tim;
readln;
END.

avatar
nganvonhat123
Teen Chính hiệu
Teen Chính hiệu

Posts : 12
Reputation : -109991
Join date : 24/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by lohan on Sat Jan 12, 2019 3:04 pm

Code:
program khi_hai_qua;
uses crt;
type mang2c=array[1..100,1..100]of integer;
var m,n:integer;
    a,b:mang2c; fi,fo:text;
//=======================================================
procedure doc;
var i,j:integer;
begin
assign(fi,'Haiqua.inp');reset(fi);
readln(fi,m,n);
for i:=1 to m do
for j:=1 to n do
read(fi,a[i,j]);
close(fi);
end;
//=======================================================
function max(i,j:integer):integer;
begin
if i>j then max:=i
else max:=j;
end;
//=======================================================
procedure tb;
var i,j:integer;
begin
b[m,n]:=a[m,n];
for i:=m-1 downto 1 do
b[i,n]:=a[i,n]+b[i+1,n];
for j:=n-1 downto 1 do
b[m,j]:=a[m,j]+b[m,j+1];
for i:=m-1 downto 1 do
for j:=n-1 downto 1 do
b[i,j]:=a[i,j]+max(b[i,j+1],b[i+1,j]);
end;
//=======================================================
procedure xl;
var i,j,t:integer;
begin
assign(fo,'haiqua.out');rewrite(fo);
writeln(fo,b[1,1]);
write(fo,a[1,1],#32);
i:=1;j:=1;
while t<>0 do
        begin
        if (b[i,j+1]>b[i+1,j]) then
                begin
                inc(j);
                if (i=m) and (j=n) then t:=0;
                if t<>0 then write(fo,a[i,j],#32);
                end
        else
                begin
                inc(i);
                if (i=m) and (j=n) then t:=0;
                if t<>0 then Write(fo,a[i,j],#32);
                end;
        end;
write(fo,a[m,n]);
close(fo);
end;
//=======================================================
begin
clrscr;
        doc;
        tb;
        xl;
readln;
end.
avatar
lohan
Teen Chính hiệu
Teen Chính hiệu

Posts : 21
Reputation : -189985
Join date : 06/11/2018
Age : 14

Xem lý lịch thành viên

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Nguyễn Văn Biên on Mon Jan 14, 2019 2:50 pm

Admin đã viết:so sánh A[i+1,j]<>0 để chi vậy Biên?
Vì khi em chạy nó ra số 0 ở đằng sau ạ thầy...

_________________

My:
- XDA Account
- Blog
- Game

...
avatar
Nguyễn Văn Biên
Recognised Member & Recognised Developer & Protected Member & Super Administrator
Recognised Member & Recognised Developer & Protected Member & Super Administrator

Posts : 220
Reputation : 1129923
Join date : 18/06/2018
Age : 15
Location : ?

Xem lý lịch thành viên https://bien2004official.blogspot.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Admin on Mon Jan 14, 2019 3:01 pm

Nguyễn Văn Biên đã viết:
Admin đã viết:so sánh A[i+1,j]<>0 để chi vậy Biên?
Vì khi em chạy nó ra số 0 ở đằng sau ạ thầy...
Nếu vậy thì code của em có vấn đề rồi
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Nguyễn Văn Biên on Mon Jan 14, 2019 3:02 pm

Admin đã viết:
Nguyễn Văn Biên đã viết:
Admin đã viết:so sánh A[i+1,j]<>0 để chi vậy Biên?
Vì khi em chạy nó ra số 0 ở đằng sau ạ thầy...
Nếu vậy thì code của em có vấn đề rồi
Mà sao em kiểm tra mấy lần vẫn không thấy gì hết là sao nhỉ

_________________

My:
- XDA Account
- Blog
- Game

...
avatar
Nguyễn Văn Biên
Recognised Member & Recognised Developer & Protected Member & Super Administrator
Recognised Member & Recognised Developer & Protected Member & Super Administrator

Posts : 220
Reputation : 1129923
Join date : 18/06/2018
Age : 15
Location : ?

Xem lý lịch thành viên https://bien2004official.blogspot.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Admin on Mon Jan 14, 2019 3:23 pm

Nguyễn Văn Biên đã viết:
Admin đã viết:
Nguyễn Văn Biên đã viết:
Admin đã viết:so sánh A[i+1,j]<>0 để chi vậy Biên?
Vì khi em chạy nó ra số 0 ở đằng sau ạ thầy...
Nếu vậy thì code của em có vấn đề rồi
Mà sao em kiểm tra mấy lần vẫn không thấy gì hết là sao nhỉ
Em coi lại thao tác lựa chọn đường đi. Ko cần so sánh mảng A để chọn đường đi.
avatar
Admin
Admin
Admin

Posts : 687
Reputation : -10042
Join date : 16/11/2015
Age : 29

Xem lý lịch thành viên http://tinhocts.forumvi.com

Về Đầu Trang Go down

Re: Tề thiên hái quả

Bài gửi by Sponsored content


Sponsored content


Về Đầu Trang Go down

Về Đầu Trang


 
Permissions in this forum:
Bạn không có quyền trả lời bài viết