Pascal - Bài Tập Quy Hoạch Động + Đáp Án


Bài tập quy hoạch động và đáp án chi tiết. Chuyên đề Quy hoạch động hệ thống các bài tập bồi dưỡng học sinh giỏi tin học, phần quy hoạch động.

A - Phần đề bài

Bài 1:
                Cho N số nguyên dương (0<N<104 +1) và một dãy A1, A2 , ... , An các số nguyên
Tìm trong dãy đã cho một dãy con Ai1, Ai2, .... , Aik  thoả mãn các điều kiện :
                a) Ai j £ Ai  j+1
                b) ij  £ i j+1
                c) k lớn nhất

Dữ liệu vào : File BL1.INP có cấu trúc như sau :
                Dòng thứ nhất ghi số N
                Các dòng tiếp theo của nó chứa dãy A1, A2 , ... , An mỗi dòng không quá 10 số , các số cách nhau ít nhất một dấu cách .
Dữ liệu ra  : File BL1.OUT có cấu trúc như sau :
                Dòng thứ nhất ghi số k
                Các dòng tiếp theo chứa k số Ai1, Ai2, .... , Aik mỗi dòng không quá 10 số , các số cách nhau ít nhất một dấu cách .
File Input
12
6   12   8   11   3   4   1   7   5   9   10   2
File Output
3   4   7   9   10
Bài 2 :
                Cho 2 số nguyên dương M,N (0<M,N£100) và 2 dãy số nguyên : A1, A2 , ... , AN  và B1, B2 , ... , B M . Hãy loại đi một số phần tử của 2 dãy sao cho các số còn lại của 2 dãy ( giữ nguyên thứ tự cũ ) tạo thành 2 dãy như nhau và độ dài k là lớn nhất .
Dữ liệu vào : File BL1.INP có cấu trúc như sau :
                Dòng thứ nhất ghi số N ,M
                Các dòng tiếp theo của nó chứa dãy A1, A2 , ... , AN  và B1, B2 , ... , B M mỗi dòng không quá 10 số , các số cách nhau ít nhất một dấu cách .
Dữ liệu ra  : File BL1.OUT có cấu trúc như sau :
                Dòng thứ nhất ghi số k
                Các dòng tiếp theo chứa k số còn lại của 1 dãy nào đó , mỗi dòng không quá 10 số , các số cách nhau ít nhất một dấu cách .
File Input
8 12
0   0   9   2   3   7   3   1
4   4   0   5   0   9   0   3   10   4   8   3
File Output
5
0   0   9   3   3
Bài 3: ( Di chuyển từ Tây sang Đông )
                Cho hình chữ nhật MxN ô vuông ,mỗi ô chứa một số nguyên
Bài 4: ( Bài Mã vạch  )         
                Cho bộ 3 số (N,M,K) nguyên không âm (N<=100,M,K<=33) . Người ta định nghĩa mỗi bộ 3 số trên ứng với 1 mã là một xâu kí tự dạng nhị phân thoả mãn :
+ Chứa đúng N chữ số
+ Các chữ số 0 liền nhau hoặc các chữ số 1 liền nhau gọi là 1 vạch , phải có đúng M vạch
+ Số chữ số trong 1 vạch gọi là độ rộng của vạch . Độ rộng tối đa của vạch là K
+ Vạch đầu tiên của mã phải là vạch gồm các chữ số 1.
Lập trình thực hiện các yêu cầu sau :
1) Lấy dữ liệu từ File ‘MV.INP’ tổ chức như sau :
                - Dòng đầu là 3 số N,M,K
                - Dòng thứ 2 là số p
                - P dòng tiếp theo : mỗi dòng là một mã M i (0< i <P+1) của bộ mã (M,N,K)
2) Thông tin ra gửi vào File ‘MV.OUT’ :
                - Dòng đầu là số nêu tổng số mã của bộ mã (N,M,K)
                - Tiếp theo gồm p dòng , mỗi dòng ghi 1 số là vị trí của mã M  trong tự điển xếp tăng các mã của bộ mã (N,M,K) .

Thí dụ
File ‘MV.INP’ 
7 4 3
6
1110100
1101100
1001000
1000100
1101110
1110110

File MV.OUT
16            15
                12
                3
                1
                13
                16
Bài 1 : Tìm dãy con tăng dài nhất :
                Cho mảng A(N) . Cần xoá ít nhất một số phần tử của dãy này sao cho các phần tử còn lại tạo thành dãy tăng nghiêm ngặt . Ta  xây dựng mảng T(N) và mảng D(N) với ý nghĩa :
                + T[i] là chỉ số j ( trong mảng A ) của phần tử đứng trước phần tử có chỉ số i (trong mảng A ) khi xét dãy kết quả .
                + D[i] là độ dài của dãy kết quả khi bài toán trên mảng A(N) mới được xét từ phần tử 1 đến phần tử i ( Nghiã là ta tạm giải bài toán với kích thước đến i - đó là kích thước không vượt quá kích thước bài toán đã cho ) . Công thức qui hoạch động của bài toán này là :

D[i] = Max { D[j] + 1 /  "  j :  j <i  mà  A[j] < A[i] }

Chú ý  
                1- Khởi trị bài toán : T[1] = 0 , D[1] = 1
                2- Xử dụng công thức trên với i>1 , mỗi lần tìm được j thoả mãn cần ghi lưu T[i]=j
                3- Khi xong i=N , tìm lại kết quả nhờ duyệt mảng D . Trước hết tìm j có D[j] lớn nhất , sau đó truy hồi dần tìm j bằng cách thay j bởi T[j] cho đến khi T[j]=0
                Các vị trí j tìm được chính là các vị trí trong mảng A cần giữ lại nhưng theo thứ tự ngược .

Thí dụ

Chỉ số
1
2
3
4
5
6
7
8
9
10
11
12
A
6
12
8
11
3
4
1
7
5
9
10
2
T
0
1
1
3
0
5
0
6
6
8
10
7
D
1
2
2
3
-1
-2
1
-3
3
-4
-5
2

Dãy kết quả là :

Chỉ số
5
6
8
10
11
A
3
4
7
9
10


Bài 2 : Xoá ít nhất một số phần tử của 2 dãy sao cho sau khi xoá  2 dãy như nhau

Gợi ý : Cần xây dựng mảng C(N,M) với ý nghĩa : C[i,j] là độ dài của dãy còn lại nếu dãy A chỉ xét tới chỉ số i và dãy B chỉ xét tới chỉ số j . Đương nhiên C[1,j] = 0 nếu A[1] không có trong dãy B(j) ,ngược lại thì  C[1,j] = 1 ; tương tự C[i,1] = 0 nếu B[1] không có trong dãy A(i) ,ngược lại thì  C[i,1] = 1 . Những trường hợp còn lại C[i,j] được tính theo công thức truy hồi sau :

C[i,j] = Max{C[i,j-1],C[i-1,j],C[i-1,j-1]+x} 
( Vì :        nếu A[i]=B[j] thì C[i,j]= C[i-1,j-1]+1
                nếu A[i] không có trong B(j) thì  C[i,j]= C[i-1,j]
                nếu B[j] không có trong A(i) thì  C[i,j]= C[i,j-1]  )

B - Lời giải

Bài 1 :
{Cho N nguyen duong N<=10000 so , tim day tang dai nhat }

Uses   Crt;
Const  Max             = 10000;
                Fi             = 'BL14.inp';
                Fo            = 'BL1.out';
Type        Mang   = Array[1..Max] of Integer;
Var          A,D,T  : Mang;
                N,dem : LongInt;
                F              : Text;
Procedure TaoF;
                Var          F              : Text;
                                i               : LongInt;
                Begin
                                Assign(F,Fi);
                                ReWrite(F);
                                Write('Nhap N = ');
                                Repeat
                                                {$I-} Readln(N);{$I+}
                                Until (IoResult=0) and (N>0) and (N<=Max);
                                Writeln(F,N);
                                For i:=1 to N do
                                Begin
                                                Write(F,10000-i+1:7);
                                                {Write(F,Random(100):3);}
                                                If i mod 10 =0 then Writeln(F);
                                End;
                                Close(F);
                End;

Procedure Nhap;
                Var   i : LongInt;
                Begin
                                FillChar(A,Sizeof(A),0);
                                Assign(F,Fi);
                                Reset(F);
                                Readln(F,N);
                                For i:=1 to N do Read(F,A[i]);
                                Close(F);
                End;

Procedure KhoitriT_D;
                Begin
                                FillChar(T,Sizeof(T),0);
                                T[1] := 0;
                                D[1] := 1;
                End;

Function Vitritruoc(i : LongInt) : LongInt;
                Var          j,Ld,Lj : LongInt;
                Begin
                                Ld := 0;
                                Lj := 0;
                                Vitritruoc := 0;
                                For j:=i-1 downto 1 do
                                                If A[j]<=A[i] then
                                                If D[j]>Ld then
                                                                Begin
                                                                                Ld := D[j];
                                                                                Lj := j;
                                                                End;
                                Vitritruoc := Lj;
                End;

Procedure TaoT_D;
                Var i : LongInt;
                Begin
                                KhoitriT_Dl;
                                For i:=2 to N do
                Begin
                                                T[i]          := Vitritruoc(i);
                                                If T[i]=0 then          D[i] := 1
                                                                Else         D[i] := D[T[i]]+1;
                End;
                End;

Function MaxD : Longint;
                Var          i,p,Li : LongInt;
                Begin
                                p := -MaxInt;
                                Li := 0;
                                For i:=1 to N do
                                If D[i]>p then
                                                Begin
                                                                p              := D[i];
                                                                Li             := i;
                                                End;
                                MaxD := Li;
                End;

Procedure Timketqua;
                Var i : LongInt;
                Begin
                                i               := MaxD;
                                D[i]         := -D[i];
                                dem    := 1;
                                Repeat
                                                i := T[i];
                                                If i<>0 then
                                                Begin
                                                                D[i] := -D[i];
                                                                Inc(dem)
                                                End;
                                Until i=0;
                End;

Procedure Ghi;
                Var          F              : Text;
                                i               : LongInt;
                Begin
                                Assign(F,Fo);
                                ReWrite(F);
                                Writeln(F,dem);
                                dem := 0;
                                For i := 1 to N do
                                                If D[i]<0 then
                                                                Begin
                                                                Write(F,A[i]:7);
                                                                Inc(dem);
                                                                If dem mod 10 = 0 then Writeln(F);
                                                                End;
                                Close(F);
                End;

BEGIN
                Clrscr;
                {TaoF;}
                Nhap;
                TaoT_D;
                Timketqua;
                Ghi;
                Writeln('Da xong ');
                Readln;
END.


Bài 2 :

Uses   Crt;
Const  Max             = 100;
                Fi             = 'qhdong2.inp';
                Fo            = 'qhdong2.out';
Type        M1          = Array[1..Max] of Byte;
                M2          = Array[1..Max,1..Max] of Byte;
Var          A,B         : M1;
                C             : M2;
                F,F2        : Text;
                M,N        : Byte;
Procedure TaoF;
       Var   i               : Byte;
                                F              : Text;
       Begin
           Write('Nhap do dai 2 mang : M,N = ');
           Readln(M,N);
           Assign(F,Fi);
           ReWrite(F);
           Writeln(F,M,' ',N);
           For i:=1 to M do Write(F,Random(100+1),' ');
           Writeln(F);
           For i:=1 to N do Write(F,Random(100+1),' ');
           Close(f);
       End;
Procedure DocF;
       Var   i               : Byte;
       Begin
             Assign(F,Fi);
             Reset(F);
             Readln(F,M,N);
             For i:=1 to M do Read(F,A[i]);
             Readln(F);
             For i:=1 to N do Read(F,B[i]);
             Close(F);
       End;
Function Max3(x,y,z : Byte) : Byte;
       Var   phu          : Byte;
       Begin
            If x>y then phu := x Else phu := y;
            If z>phu then phu := z;
            Max3 := Phu;
       End;
Function Co(x,L : Integer;D : M1) : Boolean;
       Var                                   : Byte;
       Begin
            For i:=1 to L do
            If D[i]=x then
            Begin
                 Co := True;
                 Exit;
            End;
            Co := False;
       End;
Procedure Work;
       Var i,j,dem : Byte;
           P   : M1;
       Begin
            FillChar(C,Sizeof(C),0);
            For i:=1 to M do
                If Co(B[1],i,A) then C[i,1] := 1 Else C[i,1] := 0;
            For i:=1 to N do
                If Co(A[1],i,B) then C[1,i] := 1 Else C[1,i] := 0;
            For i:=2 to M do
                For j:= 2 to N do
                    C[i,j] := Max3(C[i-1,j-1]+Ord(A[i]=B[j]),C[i,j-1],C[i-1,j]);
            Assign(F2,Fo);
            ReWrite(F2);

            If C[M,N] = 0 then
            Begin
                 Writeln(F2,'Khong co nghiem ');
                 Close(f2);
                 Writeln('Chuong trinh da chay xong , xem ket qua trong File ',Fo);
                 Readln;
                 Halt;
            End;
            Writeln(F2,'Do dai day chung : ',C[M,N]);
            i := M;
            j := N;
            Dem := 0;
            While (i>0) and (j>0) do
            Begin
                 If B[j]=A[i] then
                 Begin
                      Inc(dem);
                      P[dem] := A[i];
                      Dec(i);
                      Dec(j);
                 End
                 Else
                 If C[i,j] = C[i-1,j] then Dec(i)
                 Else Dec(j);
            End;
            For i:=dem downto 1 do Write(F2,P[i],' ');
            Close(F2);
       End;
BEGIN
       Clrscr;
       TaoF;
       DocF;
       Work;
       Writeln('Chuong trinh da chay xong , xem ket qua trong File ',Fo);
       Readln
END.


Bài 4: Mã vạch
               

Uses Crt;
Const   Fi                = 'Mv.inp';
                Fo            = 'Mv.out';
                MaxN  = 100;
                MaxM = 33;
Type    Pt                 = Array[1..13] of Byte;
                Ma           = Array[1..104] of 0..1;
                Bang        = Array[0..MaxM,0..MaxN] of Pt;
Var      N,M,K : Byte;
                F              : Bang;
                X             : Ma;
                P              : Pt;
Procedure Dan(P : Pt;Var X : Ma);
       Var i,j,t,tg : Byte;
       Begin
            FillChar(X,Sizeof(X),0);
            T := 0;
            For i:=1 to 13 do
                For j:=0 to 7 do
                Begin
                     Inc(T);
                     X[t] := (P[i] SHR j) and 1;
                End;
       End;
Procedure Nen(X : Ma;Var P : Pt);
       Var i,j,t,tg : Byte;
       Begin
            FillChar(P,Sizeof(P),0);
            T := 0;
            For i:=1 to 13 do
            Begin
                 Tg := 0;
                 For j:=0 to 7 do
                 Begin
                      Inc(T);
                      Tg := Tg+X[t] SHL j;
                 End;
                 P[i] := Tg;
            End;
       End;
Procedure Cong(Var A : Ma;B : Ma);
       Var i,t,nho : Byte;
       Begin
            Nho := 0;
            For i:= 1 to 104 do
            Begin
                 T := A[i]+B[i]+Nho;
                 A[i] := T mod 2;
                 Nho  := T div 2;
            End;
       End;
Procedure Ta  ang; {F[x,y]=So luong cac ma co x vach , dai y ki tu }
       Var i,j : Byte;F3 : Text;
       Procedure Xaydung(x,y:Byte);
                Var i : Byte; A,B : Ma;
                Begin
                Dan(F[x,y],A);
                For i:=1 to k do
                    If i<y then
                    Begin
                         Dan(F[x-1,y-i],B);
                         Cong(A,B);
                    End;
               Nen(A,F[x,y]);
           End;
       Begin
            FillChar(F,Sizeof(F),0);
            For i:=1 to M do F[i,i,1] := 1;
            For i:=1 to K do F[1,i,1] := 1;
            For i:=2 to M do
                For j:=i+1 to N do
                   If i*k>=j then Xaydung(i,j);
       End;
Procedure Nhan(Var S : String;T : Byte);
       Var i,tg,nho,L : Byte;
       Begin
            L := Length(S);
            While(L>1) and (S[1]='0') do
            Begin
                Dec(L);
                Delete(S,1,1);
            End;
            Nho := 0;
            For i:= Length(S) downto 1 do
            Begin
                 Tg := (Ord(S[i])-48)*T+Nho;
                 S[i] := Char(Tg mod 10 + 48);
                 Nho  := Tg div 10;
            End;
            If Nho<>0 then S := Char(Nho+48)+S;
       End;
Procedure CongS(Var S1 : String;S2 : String);
       Var i,tg,nho,L1,L2,L : Byte;
       Begin
            Nho := 0;
            L1 := Length(S1);
            L2 := Length(S2);
            If L1<L2 then L := L2 Else L := L1;
            While Length(S1)<L do S1 := '0'+S1;
            While Length(S2)<L do S2 := '0'+S2;
            For i:=L downto 1 do
            Begin
                 Tg := Ord(S1[i])+Ord(S2[i])-96+Nho;
                 S1[i]  := Char(Tg mod 10 +48);
                 Nho    := Tg div 10;
            End;
            If Nho<>0 then S1 := Char(Nho+48)+S1;
       End;
Function  Doi(P : Pt) : String;  { Doi mang P dang nhi phan thanh xau }
       Var   X             : Ma;
                                i,j             : Byte;
                                S,LT,SP : String;
       Begin
            Dan(P,X);
            Lt := '1';
            S  := '0';
            j := 104;
            While X[j]=0 do Dec(j);
            For i:=1 to j do
            Begin
                 Sp := LT;
                 Nhan(Sp,X[i]);
                 CongS(S,Sp);
                 Nhan(Lt,2);
            End;
            Doi := S;
       End;
Procedure Vitri(S : String;Var P : Pt);
       Var  Ch           : Char;
                i,j,d,L       : Byte;
                A,B         : ma;
       Begin
            FillChar(A,Sizeof(A),0);
            D    := Length(S);
            For i:=M downto 2 do
            Begin
                 Ch := S[1];
                 L  := 0;
                 While (D>0) and (S[1]=ch) do
                 Begin
                      Inc(L);
                      Delete(S,1,1);
                      Dec(D);
                 End;
                 Case ch of
                     '1' : For j:=2 to L do
                           Begin
                                Dan(F[i-1,D+L-j+1],B);
                                Cong(A,B);
                           End;
                     '0' : For j:=k-L downto 1 do
                           Begin
                                Dan(F[i-1,D-j],B);
                                Cong(A,B);
                           End;
                 End;
            End;
            Nen(A,P);
       End;
Procedure Lam;
       Var   F1,F2      : Text;
                                S              : String;
                                P              : Pt;
                                H,i           : Integer;
       Begin
            Assign(F1,Fi);
            Reset(F1);
            Assign(F2,Fo);
            Rewrite(F2);
            Readln(F1,N,M,K);{Ma : N ki tu,co M vach,do rong max cua vach :k}
            Ta  ang;
            S := Doi(F[M,N]); { Ghi tong so ma }
            Writeln(F2,S);
            Readln(F1,H);{ Doc so luong cac ma can chuyen tu ma thanh vitri }
            For i:=1 to H do
            Begin
                                Readln(F1,S);
                                Vitri(S,P);
                                S := Doi(P);
                                CongS(S,'1');
                                Writeln(F2,S);
            End;
            Close(f2);            Close(F1);
       End;
BEGIN
       Clrscr;       Lam;       Writeln('Xong');       Readln;
END.

0 nhận xét:

Đăng nhận xét