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;
Trang 2II.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;
Trang 3procedure 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.