ĐỆ QUY VÀ KHỬ ĐỆ QUY Laptrinh_Hieu 6 I. Lý thuyết 1. Đệ quy Khi giải bằng giải thuật đệ quy thì ta cần chú ý đến 2 đặc điểm - Trường hợp suy biến (Suy biến đệ quy) - Biểu thức truy hồi Ví dụ1: Viết chương trình đếm số chữ số của một số nguyên dương cho trước bằng cách - Suy biến đệ quy: n ≤ 9 số chữ số = 1 - Biểu thức truy hồi: dem(N) = 1 + dem (N div 10); - Chương trình đệ qui function dem_dq(n: longint): byte; begin if n <= 9 then dem_dq := 1 else dem_dq := 1 + dem_dq(n div 10); end; Ví dụ 2: Tính N!. N ≥ 0, được nhập từ bàn phím - Suy biến đệ qui: N = 0 N! = 0 - Biểu thức truy hồi: N! = N * (N-1)! - Chương trình đệ qui function gt(n: integer): longint; begin if n = 0 then gt := 1 else gt := n*gt(n-1); end; 2. Khử đệ quy bằng lặp Thông thường các giải thuật đệ qui có tính lặp mới khử bằng lặp được. function dem(n: longint):byte; var d: byte; begin d := 1; while n>9 do begin inc(d); n := n div 10; end; dem := d; end; function dgt(n: integer) : longint; var tg,i: longint; begin tg := 1; while n > 0 do begin tg := tg *i; n := n - 1; end; dgt := tg; end; 3. Khử đệ quy bằng Stack Ta có công thức chung: function sgt(n: integer) : longint; var tg: integer; begin tg := 1; top := 0; top := top +1; s[top] := n; while top > 0 do begin n := s[top]; top := top - 1; tg := tg*n; n := n-1; if n>0 then begin top := top +1; s[top] := n; end; end; sgt := tg; end; function sdem(n: longint) : longint; var tg: longint; begin tg := 1; top := 0; top := top +1; s[top] := n; while top > 0 do begin n := s[top]; top := top - 1; tg := tg +1; n := n div 10; if n>9 then begin top := top +1; s[top] := n; end; end; sdem := tg; end; ĐỆ QUY VÀ KHỬ ĐỆ QUY Laptrinh_Hieu 7 II.Bài tập Bài 3 program b3_UCLN; var a,b: integer; function UCLNQ(a,b:integer):integer; begin if a=b then UCLNQ := a else if a>b then UCLNQ := UCLNQ(a-b,b) else UCLNQ := UCLNQ(a,b-a); end; function UCLN(a,b:integer): integer; begin while a<> b do begin if a>b then a := a-b else b := b-a; end; UCLN := a; end; begin {nhap a,b>0} repeat write('a= '); readln(a); write('b= '); readln(b); until (a>0) and (b>0); writeln('DQ:’,UCLN_DQ(a,b)); writeln('UCLN(a,b)); readln; end. Bài 4 function dguoc(n:longint): longint; var m,tg: longint; begin m := 0; while n>0 do begin tg := n mod 10; m := m*10 + tg; n := n div 10; end; dnguoc := m; end; Bài 5 program b5_lietke_6be; var a : array[1 6] of byte; dem : integer; procedure inkq; var i: byte; begin inc(dem); for i:=1 to 6 do write(a[i],' '); writeln; end; procedure try(j: byte); var i: byte; begin for i := 0 to 9 do if (j=1) or (a[j-1]>i) then begin a[j] := i; if j = 6 then inkq else try(j+1); end; end; begin dem := 0; try(1); writeln('dem = ',dem); readln; end. Bài 6 program b6_lietke_xau; var a: array[1 100]of byte; n: byte; procedure inkq; var i: byte; begin for i:=1 to n do write(a[i]); writeln; end; function kt: boolean; var i: byte; begin for i:=1 to n-2 do if (a[i] = 0) and (a[i+1] = 1) and (a[i+2] = 0) then begin kt := false; exit; end; kt := true; end; ĐỆ QUY VÀ KHỬ ĐỆ QUY Laptrinh_Hieu 8 procedure try(j: byte); var i: byte; begin for i:=0 to 1 do begin a[j] := i; if (j = n) then begin if kt then inkq end else try(j+1); end; end; begin repeat write('n = '); readln(n); until n>=3; try(1); end. Bài 7 program b7_lietke_chanle; var a,b: array[1 100]of integer; ctham :array[1 100]of boolean; n,i: byte; procedure inkq; var i:byte; begin for i:=1 to n do write(b[i],' '); writeln; end; procedure try(j: byte); var i: byte; begin for i:=1 to n do if ctham[i] then begin b[j] := a[i]; ctham[i] := false; if j = n then begin if (b[1] mod 2) + (b[n] mod 2) = 1 then inkq; end else try(j+1); {tiep} ctham[i] := true; end; end; begin repeat write('n = '); readln(n); until n>=2; for i:=1 to n do begin write('a[',i,']= '); readln(a[i]); end; fillchar(ctham,n,true); try(1); end. Bài 8 program b8_lietke_3tang; var a: array[1 100]of integer; ctham :array[1 100]of boolean; n: byte; function kt: boolean; var i: byte; begin for i:=1 to n-2 do if (a[i]< a[i+1]) and (a[i+1]<a[i+2]) then begin kt := false; exit; end; kt := true; end; procedure inkq; var i:byte; begin for i:=1 to n do write(a[i],' '); end; procedure try(j: byte); var i: byte; begin for i:=1 to n do if ctham[i] then begin a[j] := i; ctham[i] := false; if j = n then begin if kt then inkq; end else try(j+1); ctham[i] := true; end; end; begin readln(n); fillchar(ctham,n,true); try(1); end.