Tài liệu ôn thi HSG Tin học 5

Chơng I : Duyệt không đệ quiI / Nhận xét : Các chơng trình có thể viết dới dạng “ Duyệt bằng đệ quy “ khi nó phải thực hiện nhiệm vụ P có hình thức đệ quy sau đây : trong đó S là một số

Chơng I : Duyệt không đệ qui

I / Nhận xét :

Các chơng trình có thể viết dới dạng “ Duyệt bằng đệ quy “ khi nó phải thực hiện nhiệm vụ P có hình thức đệ quy sau đây :

trong đó S là một số công việc phải thực hiện khi có điều kiện kết thúc B0 của đệ quy , còn Bk là điều kiện cần để thực hiện nhiệm vụ P ở bớc thứ k Trong mỗi bớc gọi thực hiện P thì điều kiện Bk đợc thu hẹp dần để dẫn tới tình trạng kết thúc B0 của quá trình duyệt

Song do chơng trình đệ quy đợc tổ chức bằng Stack (ngăn xếp) trong bộ nhớ có kích thớc tối đa là 16kb nên khi gặp những chơng trình đệ quy quá sâu thờng bị tràn Stack của bộ nhớ ( ngăn xếp của chơng trình đệ quy không đủ chứa các hàm và thủ tục

đệ quy của nó ) Trong những trờng hợp nh thế , ngời ta thờng chuyển sang chơng trình viết dới dạng “Duyệt không đệ qui “ thay đệ quy bằng vòng lặp , dựa vào công thức sau :

G 0 : một số lệnh gán trị ban đầu

Bk : điều kiện cần để thực hiện công việc Pk

II / Một số thí dụ :

Thí dụ 1 : Xây dựng hàm Fibonaci bằng đệ quy và không đệ quy

Function Fibonaci(N : Integer) : Integer;

Begin

If N=0 then Fibonaci =1 {N=0 hoặc N=1 là điều kiện B0 } Else

If N=1 then Fibonaci =1

Fibonaci := Fibonaci(N-1)+ Fibonaci(N-2) End;

Function Fibonaci(N : Integer) : Integer;

Var i,p,U0,U1 : Integer;

Begin

i := 0;

U0 := 0;

U1 := 1;

While i< N do Begin

Inc(i);

p := U1;

U1 := U0+U1;

U0 := p;

End;

Fibonaci := p;

End;

Thí dụ 2 : Sắp xếp mảng bằng thuật toán QuickSort :

P = ( Nếu B 0 thì S ; Nếu Bk thì P )

P = ( G 0 ; Trong khi Bk thì Pk )

Kiểu đệ quy

Program QSort;

{$R-,S-}

Uses Crt;

Const Max = 30000;

Type List = Array[1 Max] of Integer;

Var Data : List;

Procedure QuickSort(Var A: List; Lo, Hi: Integer);

Procedure Sort(L, r: Integer);

Var i, j, x, y: integer;

Begin

j := r;

x := a[(L+r) DIV 2];

While a[i] < x do i := i + 1;

While x < a[j] do j := j - 1;

a[i] := a[j];

a[j] := y;

j := j - 1;

until i > j;

If L < j then Sort(L, j);

If i < r then Sort(i, r);

End;

Begin

Sort(Lo,Hi);

End;

BEGIN {QSort}

Write('Hiện đang tạo ',max ,' số ngẫu nhiên ');

For i := 1 to Max do Data[i] := Random(30000);

Write('Hiện đang sắp xếp các số ');

QuickSort(Data, 1, Max);

For i := 1 to Max do Write(Data[i]:8);

END

Kiểu không đệ quy

Uses Crt;

Const MN = 4000;

Type cs = 1 MN;

Pt = Record

ma : Cs;

gt : Integer;

End;

M1 = Array[1 MN] of pt;

M2 = Array[1 MN] of Record tr,ph : cs End;

Var i,N : cs;

A : M1;

B : M2;

Procedure H;

Var s,i,j,tr,ph : cs;

x : Integer;

coc : Pt;

Begin

s := 1; {Công việc G0 : Nạp phần tử thứ nhất vào Stack B}

B[s].tr := 1;

B[s].ph := N;

Repeat {Thực hiện cho đến gặp điều kiện kết thúc B 0 : Stack rỗng ( s=0)}

tr := B[s].tr; { Lấy 1 phần tử ở đỉnh Stack }

ph := B[s].ph;

Dec(s);

Repeat { Điều kiện thực hiện 1 lần sắp xếp là : tr<ph }

i := tr;

j := ph;

x := A[(tr+ph) div 2].gt;

Repeat

While A[i].gt<x do inc(i);

While A[j].gt>x do dec(j);

If i<=j then

Begin

coc := A[i];

A[i] := A[j];

A[j] := coc;

Inc(i);

Dec(j);

End;

Until i>j;

If i<ph then

Begin

Inc(s);

B[s].tr := i;

B[s].ph := ph;

End;

ph := j;

Until tr >= ph;

Until s = 0;

End;

Procedure DocF;

Const Fi = 'qsort0dq.txt';

Var F : Text; i : cs;

Begin

Assign(F,Fi);

Reset(F);

Readln(F,N);

For i:=1 to N do

Begin

Readln(F,A[i].gt);

A[i].ma := i;

End;

Close(F);

End;

Procedure Hienkq;

Var i : Cs;

Begin

For i:=1 to N do Write(A[i].ma:4);

Writeln;

For i:=1 to N do Write(A[i].gt:4);

End;

Procedure TaoF;

Const Fi = 'qsort0dq.txt';

Var F : Text; i : cs;

Begin

Assign(F,Fi);

ReWrite(F);

N := 4000;

Writeln(F,N);

For i:=1 to N div 2 do Writeln(F,i);

For i:= N div 2+1 to N do Writeln(F,i-(N div 2));

Close(F);

End;

Begin

TaoF;

DocF;

H;

Hienkq;

End

Thí dụ 3 :

Cho 3 ký tự A,B,C Hãy tạo xâu có độ dài M<=250 chỉ chứa 3 ký tự này có tính chất : Không có 2 xâu con liền nhau bằng nhau

Kiểu đệ quy

Uses Crt;

Const N = 20;

Var S : String;

Function Kt(S : String) : Boolean;

Var i,j : Byte;

Begin

Kt := True;

For i:=1 to Length(S) div 2 do

For j:=1 to Length(S)- 2*i+1 do

If Copy(S,j,i)=Copy(S,j+i,i) then

Begin

Kt := False;

Exit;

End;

End;

Procedure Tao(S : String);

Var ch : Char;

Begin

If Length(S)=N then

Begin

Writeln(S);

Readln;

Halt;

End;

For ch:='A' to 'C' do { Khởi tạo mọi khả năng }

Begin

S := S+ch; { Thử chọn 1 khả năng }

If Kt(S) then Tao(S) {Nếu thoả mãn điều kiện thì tìm tiếp }

Else Delete(S,Length(S),1); {Nếu không thì trả về trạng thái cũ}

End;

End;

BEGIN

Clrscr;

S := '';

Tao(S);

END

Cách giải đệ quy ở trên chỉ áp dụng đợc khi Length(S)<=20 Sau đây là cách giải không

đệ quy , có thể áp dụng với S có Length(S) <=250

Kiểu không đệ quy

Uses Crt;

Const Max = 100;{ co the toi 250 }

Var A : Array[1 Max] of Integer;

S : String;

i,j : Integer;

Function Duoc(S : String):Boolean;

Var i,j : Integer;

S1,S2 : String;

Begin

Duoc := False;

S1 := '';

S2 := '';

For i:=1 to Length(S) div 2 do { do dai cua cac xau con }

Begin

For j:=1 to (Length(S)-2*i+1) do { diem dau cua xau con S1 }

Begin

S1 := Copy(S,j,i);

S2 := Copy(S,j+i,i);

If S1=S2 then Exit;

End;

End;

Duoc := True;

End;

Procedure Tim;

Begin

For i:=1 to Max do A[i] := 1;

i := 1;

S := 'A';

While (Length(S)<Max) and (i>0) do

Begin

If A[i]<4 then { A[i]<4 cho biết còn ký tự cho vào S[i+1] }

Begin

If Duoc(S+Char(A[i]+64)) then

Begin

S := S + Char(A[i]+64);

A[i] := A[i]+1;

Inc(i);

End

Else

Inc(A[i]);

End

Else { A[i]=4 : moi ki tu 'A','B','C' cho vào S[i+1] không

thành công, phải xóa S[i] đi, quay lui }

Begin

Delete(S,Length(S),1);

A[i] := 1;

Dec(i);

End;

End;

Writeln;

If i=0 then Writeln('Khong co xau dai ', Max , ' thoa man ')

Else Writeln(s);

End;

BEGIN

Clrscr;

Tim;

Readln;

END

Bài tập về nhà 1) Viết chơng trình tạo các hoán vị của bộ (1,2,3, ,9) bằng duyệt không đệ qui

2) Xâu nhị phân là xâu chỉ chứa các ký tự 1 và 0 Xâu nhị phân S đợc gọi là không lặp bậc L nếu : Các xâu con có độ dài L của nó đều khác nhau từng đôi một Xâu nhị phân không lặp bậc L đợc gọi là cực đại nếu việc bổ xung vào bên trái hoặc bên phải của xâu một ký tự 1 hoặc 0 thì sẽ phá vỡ tính không lặp bậc L của xâu

Viết chơng trình xác định xâu nhị phân không lặp bậc L cực đại , ngắn nhất bằng duyệt đệ qui và duyệt không đệ quy

-Cho một bảng hình chữ nhật kích thớc MxN , M,N nguyên dơng , ( M,N<=50) Hình chữ nhật này đợc chia thành MxN ô vuông bằng nhau bởi các đờng song song với các cạnh trên ô vuông [i,j] ghi số A[i,j]<=50 , từ bảng A ta lập bảng B mà B[i,j] đ ợc tính nh sau : Biểu diễn A[i,j] thành tổng nhiều nhất các số nguyên tố trong đó có nhiều nhất 1 số đợc xuất hiện nhiều nhất là 2 lần ,B[i,j] bằng số số hạng của biểu diễn này kể cả số bội Ví dụ : A[i,j] = 10 = 2+3+5 thì B[i,j]=3 , A[i,j]=12 = 2+2+3+5 thì B[i,j]=4

1) Nhập tữ File INPUT.TXT trong đó dòng đầu ghi 2 số M,N M dòng sau ghi M dòng của mảng A(Không cần kiểm tra dữ liệu ) ghi ra File OUT.TXT mảng B , mỗi dòng

1 dòng của bảng

2) Tìm hình chữ nhật lớn nhất gồm các ô của bảng B ghi các số nh nhau

Bài chữa Bài 1 :

Kiểu đệ quy

Uses Crt;

Const N = 9;

TF = 'hoanvi.txt';

Type TS = String[N];

Var S : TS;

d,Lt : Longint;

F : Text;

T : LongInt Absolute $0000:$046C;

Procedure Doi(Var a,b : Char);

Var p : Char;

Begin

p := a; a := b; b := p;

Procedure Hien(S : TS);

Begin

Inc(d); Write(F,S,' ');

If (d mod 10 = 0) then Writeln(F);

End;

Procedure Tao(S : String;i : Byte);

Var j : Byte;

p : Char;

Begin

If i=N then Hien(S);

For j:=i to N do Begin

Doi(S[i],S[j]);

Tao(S,i+1);

End;

End;

BEGIN

Clrscr;

S := '123456789';

S := Copy(S,1,N);

d := 0;

LT := T;

Assign(F,TF);

ReWrite(F);

Tao(S,1);

Close(F);

Writeln(#13#10,'So hoan vi la : ',d);

Writeln('Mat thoi gian la : ',((T-Lt)/18.2):10:2,' giay');

Readln;

END

Kiểu không đệ quy

Uses Crt;

Const Max = 9;

Fo = 'hoanvi.txt';

Type K1 = Array[1 Max] of Integer;

Var F : Text;

N,i,j : Integer;

V : K1;

dem : LongInt;

Procedure Tao;

Var j,k : Integer;

Procedure Hien;

Var j : Byte;

Begin

Begin

For j:=1 to N do Write(F,V[j]);Write(F,' ');

Inc(dem);

If (dem mod (79 div (N+1))=0) then Writeln(F);

Dec(k);

End

End;

Procedure TaoVk;

Var Ok : Boolean;

Begin

Repeat

j := 1;

While V[k]<>V[j] do Inc(j);

If j=k then Ok := True

Else

Begin

Ok := False;

Inc(V[k]);

End

Until Ok;

End;

Begin

Assign(F,Fo);

ReWrite(F);

For k:=1 to N do V[k] := -1;

V[1] := 1;

k := 2;

Repeat

If k>N then Hien

Else

If V[k]=-1 then

Begin

V[k] := 1;

TaoVk;

Inc(k);

End

Else

Begin

Inc(V[k]);

TaoVk;

If V[k]<=N then Inc(k)

Else

Begin

V[k] := -1;

Dec(k);

End;

End;

Until k=0;

End;

BEGIN

Repeat

Clrscr;

dem := 0;

Write('Tao cac hoan vi cua N chu so lien tiep 1 N Nhap N = ');

Readln(N);

Tao;

Writeln(F);

Writeln(F,'So hoan vi la : ',dem );

Close(F);

Writeln('ESC thoat ');

Until ReadKey=#27;

END

Bài 2 :

Kiểu đệ quy

Uses Crt;

Const Max = 13;

Var L : Byte;

S : String;

Procedure Nhap;

Var Ok : Boolean;

Begin

Write('Nhap bac L cua xau nhi phan khong lap , L = ');

Repeat

{$i-}Readln(L);{$i+}

Ok := (Ioresult=0) and (L<=Max);

If Not Ok then Writeln('Nhap lai ');

Until Ok;

End;

Procedure Taoxau;

Function Ktra1(S : String): Boolean;

Var i,j : Byte;

Begin

Ktra1 := True;

If Length(S)>=L then

For i:=1 to Length(S)-L+1 do

For j:=i+1 to length(S)-L+1 do

If copy(S,i,L)=copy(S,j,L) then

Begin

Ktra1 := False;

Exit;

End;

End;

Function Ktra2: Boolean;

Begin

Ktra2 := False;

If (Not Ktra1('0'+S)) and (Not Ktra1('1'+S)) and

(Not Ktra1(S+'0')) and (Not Ktra1(S+'1')) then

Ktra2 := True;

End;

Procedure Tim;

Var i : Byte;

Begin

If Ktra2 then

Begin

Writeln('Xau nhi phan khong lap bac L cuc dai, ngan nhat : ');

Writeln(S);

Exit;

End;

For i:=0 to 1 do

Begin

S := S+Char(i+48);

If Ktra1(S) then Tim

Else Delete(S,length(S),1);

End;

End;

Begin

S := '';

Tim;

End;

BEGIN

Clrscr;

Repeat

Nhap;

Taoxau;

Writeln('ESC thoat ');

Until Readkey=#27;

END

Kiểu không đệ quy :

Uses Crt;

Const Max = 255;

Var L : Byte;

S : String;

Procedure Nhap;

Var Ok : Boolean;

Begin

Write('Nhap bac L cua xau nhi phan khong lap , L = ');

Repeat

{$i-}Readln(L);{$i+}

Ok := (Ioresult=0) and (L<=Max);

If Not Ok then Writeln('Nhap lai ');

Until Ok;

End;

Procedure Taoxau;

Function Ktra1(S : String): Boolean;

Var i,j : Byte;

Begin

Ktra1 := True;

If Length(S)>=L then

For i:=1 to Length(S)-L+1 do

For j:=i+1 to length(S)-L+1 do

If copy(S,i,L)=copy(S,j,L) then

Begin

Ktra1 := False;

Exit;

End;

End;

Function Ktra2: Boolean;

Begin

Ktra2 := False;

If (Not Ktra1('0'+S)) and (Not Ktra1('1'+S)) and

(Not Ktra1(S+'0')) and (Not Ktra1(S+'1')) then

Ktra2 := True;

End;

Procedure Tim;

Var i,k : Byte;

Ok : Boolean;

Begin

S := '';

Repeat

Ok := False;

i := 0;

While (i<2) and (Not Ok) do

Begin

Ok := Ktra1(S+char(i+48));

If Ok then S := S + Char(i+48);

Inc(i);

End;

Until Ktra2;

End;

Begin

S := '';

Tim;

Writeln(S);

End;

BEGIN

Repeat

Clrscr;

Nhap;

Taoxau;

Writeln('ESC thoat ');

Until Readkey=#27;

END