Tài liệu 01-BAI TAP
Bạn đang xem bản rút gọn của tài liệu. Xem và tải ngay bản đầy đủ của tài liệu tại đây (111.33 KB, 3 trang )
ĐỆ 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.
