Tài liệu tập huấn bồi dưỡng học sinh gỏi tin học 11 của thầy n x huy tại quảng bình + pas

TÀI LIỆU TẬP HUẤN TẠI QUẢNG BÌNH
Tháng 7 năm 2010
Một số hàm số học
Ucln(x,y): ước chung lớn nhất của 2 số nguyên a, b,
Bcnn(x,y): bội chung nhỏ nhất của 2 số nguyên a, b,
Len(x,b): số chữ số của số nguyên x trong hệ đếm b,
Height(x,b): Độ cao (tổng các chữ số) của số nguyên x trong hệ đếm b,
Lat(x): số lật của số số nguyên x. Lat(1234) = 4321,
LaSoGanh(x): số x đối xứng? Lat(x) = x,
TongUoc(x): tổng các ước thực sự của số nguyên x,
SoUoc(x): số ước thực sự của số nguyên x,
IsPrime(x): x là số nguyên tố, SoUoc(x) = 1,
Can(x) : căn (bậc 2) nguyên của số nguyên x.
(*---------------------------------Mot so ham so hoc
---------------------------------*)
uses crt;
const bl = #32; { Dau cach }
nl = #13#10; { Ve dau dong tiep theo }
type int = longint;
function Ucln(a,b: int): int;
var r: int;
begin
while b <> 0 do
begin
r := a mod b;
a := b;
b := r;
end;
Ucln := a;
end;
function Bcnn(a,b: int): int;

begin
Bcnn := (a div Ucln(a,b)) * b;
end;
function Len(x,b: int):int;
var d : int;
begin
d := 0;
repeat
inc(d);
x := x div b;


until x = 0;
Len := d;
end;
function Height(x,b: int): int;
var h: int;
begin
h := 0;
repeat
h := h + (x mod b);
x := x div b;
until x = 0;
Height := h;
end;
function Lat(x: int): int;
var y: int;
begin
y := 0;
repeat

y := y * 10 + (x mod 10);
x := x div 10;
until x = 0;
Lat := y;
end;
function LaSoGanh(x: int): Boolean;
begin LaSoGanh := ( x = Lat(x)); end;
function Can(x: int): int;
begin Can := trunc(sqrt(x)); end;
function TongUoc(x: int): int;
var c, d, i: int;
begin
TongUoc := 0;
if x = 1 then exit;
c := Can(x); d := 1;
if c*c = x then begin d := d + c; dec(c) end;
for i := 2 to c do
if x mod i = 0 then d := d + i + (x div i);
TongUoc := d;
end;
{ So uoc thuc su }


function SoUoc(x: int): int;
var c, d, i: int;
begin
SoUoc := 0;
if x = 1 then exit;
c := Can(x); d := 1;
if c*c = x then begin inc(d); dec(c) end;

for i := 2 to c do
if x mod i = 0 then inc(d,2);
SoUoc := d;
end;
function IsPrime(x: int): Boolean;
begin IsPrime := (SoUoc(x) = 1); end;
procedure Run;
const HeDem = 10;
var x, y: int;
begin
x := 75; y := 60;
writeln(nl,' x = ', x);
writeln(nl,' Ucln(',x,',',y,') = ',Ucln(x,y));
writeln(nl,' Bcnn(',x,',',y,') = ',Bcnn(x,y));
writeln(nl,' Len(',x,') trong he dem ',HeDem , ' =
',Len(x,HeDem));
writeln(nl,' Do cao cua ',x,' trong he dem ',HeDem,'
= ',Height(x,HeDem));
writeln(nl,' So lat cua ', x , ' = ', Lat(x));
writeln(nl,' Can nguyen cua ', x , ' = ', Can(x));
for x := 1 to 20 do
begin
writeln(' Xet so ', x, ': ');
writeln('
. TongUoc = ', TongUoc(x));
write('
. La so ganh (doi xung): ');
if LaSoGanh(x) then writeln(' Yes') else writeln('
No');
write('

. La so nguyen to: ');
if IsPrime(x) then writeln(' Yes') else writeln('
No');
readln;
end;
end;
BEGIN
Run;
readln;
END.


Bài toán vẽ 2 nét
Cho đồ thị G liên thông vô hướng, n đỉnh, m cạnh.
Hãy vẽ G bằng 1 nét bút: xuất phát từ 1 đỉnh và qua mỗi cạnh đúng 1 lần.
Thuật toán
1. Đọc dữ liệu gồm n – số đỉnh; m – số cạnh và đọc đủ m cạnh (x,y) ghi vào mảng 2
chiều c gọi là mảng kề, c[x,y] = c[y,x] = 1.
2. Đếm số đỉnh lẻ ghi vào biến s và ghi đỉnh lẻ đầu tiên vào biến DinhLe để dùng sau
này.
3. Kiểm tra s: Nếu s > 2 thông báo vô nghiệm.
Nếu s = 0: Gọi thủ tục Ve(1) bắt đầu từ đỉnh 1;
Nếu s = 2: Gọi thủ tục Ve(DinhLe) bắt đầu từ đỉnh DinhLe.
Thủ tục Ve(z)
Trước tiên ta nạp đỉnh đầu
Tiếp theo lặp đến khi nào trống không,
Từ ngọn ngăn xếp ta trông
Còn đường : xếp tiếp, nếu không xuất liền.
Ý nghĩa :
Ve(z)

Trước tiên ta nạp đỉnh đầu : Nạp đỉnh z vào ngăn xếp
Tiếp theo lặp đến khi nào trống không : Lặp đến khi ngăn xếp rỗng
Từ ngọn ngăn xếp ta trông : Xét phần tử x trên ngọn ngăn xếp (không lấy ra)
Còn đường : xếp tiếp, nếu không xuất liền : Nếu từ x tìm được đường chưa đi đến y thì
nạp y vào ngăn xếp, nếu không ta lấy ngọn ngăn xếp (tức là x)để xuất ra kết quả.
uses crt;
const
fn = 'Ve1net.inp';
mn = 100; bl = #32; nl = #13#10;
type
int = integer;
mi1 = array[0..mn] of int;
mi2 = array[0..mn] of mi1;
var
c: mi2;
n: int;
st: mi1; { styack - ngan xep }
p: int; { con tro ngan xep }
kq: mi1;
s: int; { So dinh bac le }
k: int; { con tro ket qua }
dinhLe: int;
procedure Doc;
var f: text;
i,m,x,y: int;
begin


assign(f,fn); reset(f);
read(f,n,m); fillchar(c,sizeof(c),0);

for i := 1 to m do
begin
read(f,x,y);
c[x,y] := 1;
c[y,x] := 1;
end;
close(f);
end;
procedure Xem;
var i,j: int;
begin
write(nl,nl,'n = ',n,nl);
for i := 1 to n do
for j := i+1 to n do
if c[i,j] = 1 then writeln(i,' -> ',j);
end;
{ Tim toi da 2 dinh le }
procedure TimDinhLe;
var i,j,b: int;
begin
s := 0;
for i:=1 to n do
begin
b := 0;
for j := 1 to n do b := b + c[j,i];
if Odd(b) then
begin
inc(s);
if s = 1 then DinhLe := i;
end;

end;
end;
{ x -> y ? }
function TimDinhKe(x: int): int;
var y: int;
begin
for y := 1 to n do
if c[x,y] = 1 then
begin
TimDinhKe := y;
exit;


end;
TimDinhKe := 0;
end;
{ Khởi trị stack }
procedure InitSt; begin p := 0; end;
{ Nạp x vào stack }
procedure Push(x: int); begin inc(p); st[p] := x; end;
{ Lấy ngọn stack ra khỏi stack }
function Pop: int; begin Pop := st[p]; dec(p); end;
{ Kiểm tra stack rỗng ? }
function StIsEmpty: Boolean; begin StIsEmpty := (p = 0);
end;
{ Xem ngọn stack }
function GetTop:int; begin GetTop := st[p]; end;
procedure Ve(z: int);
var x,y,i: int;
begin

InitSt;
Push(z); { nap dinh z vao stack st }
writeln;
repeat
x := GetTop; { xem ngon x cua stack st }
y := TimDinhKe(x); { x -> y }
if y = 0 then
begin { het duong: dua ngon stack vao ket qua }
inc(k); kq[k] := Pop;
end else { co dinh ke, x -> y }
begin
c[x,y] := 2; c[y,x] := 2; { Danh dau duong da duyet }
{ Nap y vao st } Push(y);
end;
until p = 0;
writeln;
for i:=1 to k do write(kq[i],' ');
end;
procedure Run;
var i,j,net: int;
begin
Doc;
Xem;


TimDinhLe;
writeln(nl, s , ' Dinh le ');
if s > 2 then
begin writeln(nl,' Vo nghiem '); exit end;
write(nl, ' Ve 1 net: ');

if s = 0 then Ve(1) else Ve(DinhLe);
end;
BEGIN
Run;
readln;
END.
Dữ liệu test: file Ve1net.inp
10 13
1 2
1 10
2 3
3 4
3 9
3 10
4 5
5 6
5 8
5 9
6 7
7 8
3 5
Find & Union
Find & Union là kỹ thuật quản lý hợp của các tập con rời nhau. Mỗi tập con chính là một
tập con của các đỉnh trong đồ thị, tức là tập con của tập Đỉnh = {1, 2, ..., n}.
Sử dụng 1 mảng d[1..n] để ghi nhận sự lệ thuộc của các đỉnh: d[i] = j cho biết đỉnh j lệ
thuộc vào đỉnh i, hay j là phần tử trong tập chứa phần tử i.
Ta quy ước Với mỗi tập, phần tử có số hiệu nhỏ nhất là đại diện (nhóm trưởng) của tập
đó.
Xác định các mảnh liên thông
Khởi trị: for i := 1 to n do d[i] := i; với ý nghĩa: lúc đầu mọi phần tử rời nhau, mỗi phần

tử tạo thành một tập con riêng biệt có nhóm trưởng là chính nó.
Với mỗi cạnh (x,y) ta thực hiện thủ tục Union như sau:
- Xác định nhóm trưởng tx của nhóm chứa x, tx := Find(x) ;
- Xác định nhóm trưởng ty của nhóm chứa y, ty := Find(y) ;
- So sánh : nếu tx = ty kết luận x và y cùng nhóm do đó không cần hợp nhất, gán
Union = 0 và dừng.
- Nếu tx < ty : cho ty bám theo tx : d[ty] := tx, Union := 1 (có sự hợp nhất).
- Nếu tx > ty : cho tx bám theo ty : d[tx] := ty (có sự hợp nhất).
Lúc đầu có n mảnh liên thông, sau mỗi lần hợp nhất số mảnh liên thông giảm 1.


Hàm Find (x) xác định nhóm trưởng của nhóm chứa x.
Nhận xét : x là nhóm trưởng khi và chỉ khi d[x] = x.
Sau đó duyệt lại d để xác định các nhóm trưởng và liệt kê các phần tử (đỉnh) trong mỗi
mảnh liên thông : j nằm trong nhóm i khi và chỉ khi Find(j) = i.
Nhận xét : đỉnh 1 luôn luôn là nhóm trưởng của một mảnh liên thông.
Thuật toán Liên thông hóa
Nếu đồ thị G có k mảnh liên thông thì coa thể thêm cho G k-1 cạnh để thu được đồ thị
liên thông. Các cạnh cần thêm là (1,m2), (1,m3),...,(1,mk), trong đó mi là nhóm trưởng, mi
≠ 1.
Thuật toán Kruskal
Init ;
Đọc dần từng cạnh (x,y). Xét
- Nếu Union(x,y) = 0 thì bỏ qua vì x và y cùng mảnh do đó sẽ tạo thành chu trình.
- Nếu Union(x,y) = 1 : Đưa cạnh (x,y) vào cây khung.
(*-----------------------------------Find Union va ung dung:
- Tinh so manh lien thong
- Tim Cay khung theo Kruskal
------------------------------------*)
uses crt;

const
mn = 100; bl = #32; nl = #13#10;
type int = integer;
mi1 = array[0..mn] of int;
canh = record a,b: int end; { canh: a -> b }
mc1 = array[0..5*mn] of canh;
var
n: int; { so dinh }
d: mi1; { d[i] = j: dinh i le thuoc dinh j }
khung: mc1; { cac canh cua cay khung }
procedure Init;
var i: int;
begin
for i := 1 to n do d[i] := i;
end;
function Find(x: int): int;
begin
while d[x] <> x do x := d[x];
Find := x;
end;
function Union(x,y: int):int;


begin
x := Find(x); y := Find(y);
Union := 0;
if x = y then exit;
if x < y then d[y] := x else d[x] := y;
Union := 1;
end;

{ Tinh so manh lien thong }
function SoManh(fn: string): int;
var f: text;
i, m: int;
x,y: int;
s: int;
begin
assign(f,fn); reset(f);
read(f,n,m);
writeln(' So dinh: ',n, ' So canh: ',m);
Init;
s := n; { Luc dau co n manh }
for i := 1 to m do
begin
read(f,x,y); writeln(' Canh: ', x, ' -> ',y);
s := s - Union(x,y);
end;
close(f);
SoManh := s;
end;
{ Liet ke cac manh lien thong }
procedure ManhLienThong(fn: string);
var i,j,k: int;
begin
k := SoManh(fn);
{ Liet ke }
for i := 1 to n do
if (d[i] = i) then
begin
write(nl,' Manh ',i,': ');

for j := 1 to n do
if Find(j) = i then write(j,bl);
end;
write(nl,nl,' Tong cong ',k,' manh lien thong');
end;
(* cay khung *)
procedure Kruskal(fn: string);


var m: int; { so canh }
i: int; { duyet canh }
x, y: int ; { canh: x -> y }
k: int; { dem canh trong cay khung }
f: text;
begin
assign(f,fn); reset(f);
read(f,n,m);
writeln(nl,' So dinh: ',n,' So canh: ',m);
Init;
k := 0;
for i := 1 to m do
begin
read(f,x,y);
if Union(x,y) = 1 then
{ canh (x,y) khong tao chu trinh }
begin
inc(k);
khung[k].a := x; khung[k].b := y;
end;
end;

close(f);
{ Hien thi cay khung }
writeln(nl,' Cay khung gom ',k, ' canh: ');
for i := 1 to n-1 do writeln(i,'. ',khung[i].a,' ->
',khung[i].b);
end;
function LienThongHoa(fn: string): int;
var i,k: int;
begin
k := SoManh(fn);
for i := 2 to n do
if d[i] = i then { gap nhom truong }
writeln(' Noi dinh 1 voi dinh ', i);
writeln(nl,' So canh can then cho do thi ',fn,':
k-1);
LienThongHoa := k-1;
end;
procedure Run;
var i,k: int;
begin
writeln(nl,'* * * * * D E M O
writeln(' So Manh lien thong: ');
k := SoManh('graph.inp');
write(nl,' Dap so: ',k);

* * * * * ',nl);

',

write(nl,' Bam phim tuy y de tiep tuc: '); readln;
write(nl,' Liet ke cac manh lien thong', nl);
ManhLienThong('graph.inp');
write(nl,' Lien thong hoa: them it canh nhat de co do
thi lien thong',nl);
LienThongHoa('graph.inp');
write(nl,' Bam phim tuy y de tiep tuc: '); readln;
writeln(nl,' Cay khung (Kruskal)',nl);
Kruskal('khung.inp');
end;
BEGIN
Run;
readln;
END.
Dữ liệu cho thuật toán tìm cây khung
khung.inp
10 13
1 2
1 10
2 3
3 4
3 9
3 10
4 5
5 6
5 8
5 9
6 7
7 8
1 7

Dữ liệu cho thuật toán tìm các mảnh liên thông
graph.inp
10 9
1 2
1 10
2 3
3 10
5 6
6 7
7 8
8 5
4 9
Luồng
Phát biểu bài toán:


Cho đồ thị hữu hạn, có hướng G gồm n đỉnh, m cung. Mỗi cung (x,y) có nhãn c(x,y) là
một số nguyên dương gọi là thông lượng của cung. Gọi s là đỉnh phát, t là đỉnh thu của
G. Hãy gán trên mỗi cung (x,y) của G một giá trị nguyên không âm z(x,y) thỏa các ddiều
kiện sau:
a) z(x,y) ≤ c(x,y),
b) Tại mỗi đỉnh x, ta kí hiệu
w+(x) là lượng đến đỉnh x: w+(x) = Σ{ z(u,x) | cung (u,x) thuộc G };
w-(x) là lượng đi từ đỉnh x: w-(x) = Σ{ z(x,y) | cung (x,y) thuộc G },
Với mỗi đỉnh x, trừ đỉnh phát s và đỉnh thu t hệ thức sau được thỏa:
w+(x) = w-(x)
+
c) w (s) = w (t) và đạt max.
Thuật toán
Thuật toán sau đây đơn giản, dễ cài.

1. Khởi trị: z(x,y) = 0 với mọi cung (x,y) thuộc G.
2. Gọi TangLuong là hàm bool sau đây:
Xuất phát từ đỉnh phát s, tìm được 1 đường đi đến đỉnh thu t
s = x0 → x1 → x2 → ... → xk = t
(*)
thỏa tính chất z(xi, xj) < c(xi, xj), 0 ≤ i < k, j = i+1.
Nếu tìm được đường (*) thì gọi thủ tục Update tăng lượng của mỗi cạnh (xi, xj) trên
đường (*) một lượng v = min { c(xi, xj) - z(xi, xj) | 0 ≤ i < k, j = i+1 } và hàm TangLuong
nhận trị true với ý nghĩa là còn tăng được luồng.
Nếu không tồn tại đường (*) thì hàm tangLuong nhận trị false.
3. while (TangLuong) do;
uses crt;
const mn = 100; bl = #32; nl = #13#10;
fn = 'luong.inp';
type int = integer;
mi1 = array[0..mn] of int;
mi2 = array[0..mn] of mi1;
var c: mi2 ; { ma tran thong luong cua cung }
z: mi2; { ma tran ket qua }
s: int; { dinh phat }
t: int; { dinh thu }
f: text; { input file }
n: int; { so dinh }
st: mi1; { ngan xep }
p: int; { con tro ngan xep }
tr: mi1; { tro truoc, tr[j] = i: cung i -> j }
w: mi1; { trong so dinh }
{ Hien thi mang 1 chieu }
procedure Print1(var a: mi1);
var i: int;

begin
writeln;


for i:=1 to n do write(a[i],bl);
end;
{ Hien thi mang 2 chieu }
procedure Print2(var a: mi2);
var i: int;
begin
for i:=1 to n do Print1(a[i]);
end;
procedure Doc;
var i,j, m, x, y, v: int;
begin
assign(f,fn); reset(f);
read(f,n,m);
writeln(' so dinh: ', n, '
so cung: ', m);
read(f,s,t);
writeln(' Dinh phat: ', s, '
Dinh thu: ', t);
fillchar(c,sizeof(c),0);
for i := 1 to m do
begin
read(f,x,y, v); writeln(' Cung ',x, ' -> ',y, '
thong luong: ', v);
c[x,y] := v;
end;
close(f);

end;
{ Khoi tri ngan xep }
procedure InitSt; begin p := 0; end;
{ Nap dinh y vao ngan xep, tro truoc den dinh x }
procedure Push(x,y: int);
begin
inc(p); st[p] := y;
tr[y] := x;
end;
{ Xuat ngon ngan xep }
function Pop: int; begin Pop := st[p]; dec(p) end;
{ Kiem tra ngan xep rong }
function IsEmpty: Boolean; begin IsEmpty := (p = 0);
end;
function Min(a,b: int): int;
begin if a < b then Min := a else Min := b end;


procedure Update(y: int);
var x: int;
begin
while tr[y] <> x do
begin
x := tr[y]; { xet cung x -> y }
inc(z[x,y],w[t]); { tang them cho cung x->y mot
luong w[t] }
y := x; { Dinh tiep theo }
end;
end;
function TangLuong: Boolean;

var x,y: int;
begin
fillchar(tr, sizeof(tr),0);
InitSt;
w[s] := maxint;
Push(s, s); { nap dinh phat s vao st, tro truoc den
chinh s }
repeat
x := Pop;
if x = t { Gap dinh cuoi (dinh thu) } then
begin
Update(x);
TangLuong := true;
exit;
end;
{ Duyet cac cung x->y }
for y := 1 to n do
if (c[x,y] > z[x,y]) and (tr[y] = 0) then
begin
w[y] := Min(w[x],c[x,y]-z[x,y]); { Tinh trong
so }
Push(x,y); { Nap y vao st, tro truoc toi x }
end;
until IsEmpty;
TangLuong := false;
end;
{ Giai trinh ket qua }
function Ket: int;
var vmax,i: int;
begin

vmax := 0; { Gia tri cuc dai cua luong }


writeln(' Ma tran ket qua:'); Print2(z);
for i := 1 to n do inc(vmax,z[s,i]);
Ket := vmax;
end;
function Luong: int;
begin
fillchar(z,sizeof(z),0);
while (TangLuong) do;
Luong := Ket;
end;
procedure Run;
var v: int;
begin
Doc;
v := Luong;
writeln(nl,' Dap so (thong luong max): ',v);
end;
BEGIN
Run;
readln;
END.
Dữ liệu test, file luong.inp
8 14 – 8 đỉnh, 14 cạnh
1 8 – đỉnh phát s = 1, đỉnh thu t = 8
1 2 4 – cung (1,2) có thông lượng 4
1 3 9
2 6 6

2 3 5
3 7 10
4 2 2
4 7 3
5 6 9
5 8 2
6 4 2
6 8 10
7 2 8
7 5 4
7 6 1