Pascal: Giải Bài 2, HSG Bảng B năm học 2018-2019

LẬP TRÌNH PASCAL

Bài 2. HSG Bảng B, Năm học 2018-2019

– Gọi S[i,j] là tổng giá trị lớn nhất các món quà robot thu được khi đi tới ô (i,j) là ô cột j ở hàng thứ i. Ta cần tính giá trị lớn nhất  trong các S[h,i] với i=1,..,h.

Ta sẽ lưu dữ liệu đầu vào trong mảng A[i,j] và kết hợp luôn dữ liệu trong file THUQUA vào bằng cách đặt A[i,j]=-1 nếu ô(i,j) thu quà.

– Ta xác định hàm Quy hoạch động: Dễ thấy S[i,j] được tính thông qua

S[i-1,j-1] và S[i-1,j], tức là S[i,j] = max(S[i-1,j-1] , S[i-1,j])+A[i,j] với j>1, lưu ý S[i,j] =0 nếu A[i,j]=-1 (bị thu quà)

– Tính một số giá trị ban đầu(giá trị có thể tính được:

+ Giá trị đầu tiên:

S[1,1]=A[1,1] (S[1,1] =0 nếu A[i,j]=-1)

+ Tính các giá trị cột 1

S[i,1]=S[i-1,1]+ A[i,1] với i=2,..,h.

+ Tính các giá trị đường chéo.

S[i,i]:=S[i-1,i-1]+a[i,i]; với i=2,..,h

– Tính giá trị lặp hàm QHĐ

for i:=2 to h do

for j:=2 to h do

begin

S[i,j]:=S[i-1,j-1]+a[i,j];

if S[i-1,j-1]<S[i-1,j] then

S[i,j]:=S[i-1,j]+a[i,j];

end;

– Để đưa ra được đường đi ta phải lưu vết đường đi, gọi Truoc[i,j] là ô ngay trước ô(i,j) khi đi tới ô(i,j) cho S[i,j], dễ thấy Truoc[i,j] hoặc là ô (i-1,j-1) hoặc ô (i-1,j) nên ta chỉ cần lưu j-1 hoặc j là đủ.

{Code Pascal}
{Bai 2 HSG Bang B nam hoc 2018-2019}
uses crt;
var a,s:array[1..501,1..501] of longint;
    truoc:array[1..500,1..500] of longint;
    h,n,vt:longint;
{------Doc dl tam giac-----}
procedure doc_tam_giac;
var fi1:text;
    i,j:longint;
begin
       assign(fi1,'tamgiac.inp');
      reset(fi1);
       readln(fi1,h);
       while not eof(fi1) do
                begin
                       for i:=1 to h do
                           begin
                                for j:=1 to i do
                                     read(fi1,a[i,j]);
                                readln(fi1);
                           end;
                end;
end;
{------Doc dl tu qua-----}
procedure doc_thu_qua;
var fi2:text;
        i,j,k:longint;
begin
        assign(fi2,'thuqua.inp');
        reset(fi2);
        while not eof(fi2) do
                begin
                     readln(fi2,n);
                     if n<>0 then
                     begin
                        for k:=1 to n do
                              begin
                                   readln(fi2,i,j);
                                   a[i,j]:=-1;
                                end;
                     end;
                end;
end;
{------------Ham QHD-----------}
procedure qhd;
var i,j:longint;
begin
     s[1,1]:=a[1,1];
     truoc[1,1]:=0;
     if a[1,1]=-1 then
        s[1,1]:=0;
     {Tinh cac gia tri cot 1}
     for i:=2 to h do
         begin
              s[i,1]:=s[i-1,1]+a[i,1];
              truoc[i,1]:=1;
             if a[i,1]=-1 then
                 s[i,1]:=0;
         end;
     {Tinh cac gia tri duong cheo}
     for i:=2 to h do
          begin
                s[i,i]:=s[i-1,i-1]+a[i,i];
                truoc[i,i]:=i-1;
                if a[i,i]=-1 then
                   s[i,i]:=0;
          end;
     {Lap Ham QHD}
     for i:=2 to h do
        for j:=2 to h do
          begin
                if a[i,j]=-1 then
                    s[i,j]:=0
                else
                     begin
                           s[i,j]:=s[i-1,j-1]+a[i,j];
                           truoc[i,j]:=j-1;
                           if s[i-1,j-1]<s[i-1,j] then
                begin                                                      
                  s[i,j]:=s[i-1,j]+a[i,j];
                               truoc[i,j]:=j;
                            end;
                        end;
          end;
     vt:=1;
     for j:=2 to h do
        if s[h,vt]<s[h,j] then
                vt:=j;
     writeln('Gia tri Max=',s[h,vt]);
end;
{---------In dd thuan-------}
procedure in_dd_thuan;
var  vet:array[1..500] of longint;
     i,j:longint;
begin
      vet[h]:=vt;
      j:=truoc[h,vt];
      for i:=h-1 downto 1 do
          begin
                vet[i]:=j;
                j:=truoc[i,j];
           end;
      for i:=1 to h-1 do
          write(a[i,vet[i]],'(',i,',',vet[i],')->');
      write(a[h,vt],'(',h,',',vt,')');
end;
{--------In nguoc----}
procedure in_dd_nguoc;
var m,x:longint;
begin
      write(a[h,vt],'(',h,',',vt,')');
      m:=truoc[h,vt];
      x:=h-1;
      while m>0 do
        begin
             write('->',a[x,m],'(',x,',',m,')');
             m:=truoc[x,m];
             x:=x-1;
        end;
end;
{------------Main--------------}
begin
        clrscr;
        doc_tam_giac;
        doc_thu_qua;
        qhd;
        write('In duong di thuan:');
        in_dd_thuan;
        writeln;
        write('In duong di nguoc:');
        in_dd_nguoc;
       readln;
end.

 

 

 

 

 

 

 

Trả lời

Email của bạn sẽ không được hiển thị công khai. Các trường bắt buộc được đánh dấu *