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ÌNHTháng 7 năm 2010 Một số hàm số học Uclnx,y: ước chung lớn nhất của 2 số nguyên a, b, Bcnnx,y: bội chung nhỏ nhất của 2 số nguyên a, b, Lenx,b: số chữ số c

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;

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 * * * * * ',nl); writeln(' So Manh lien thong: ');

k := SoManh('graph.inp');

write(nl,' Dap so: ',k);

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);

LienThongHoắ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);

{ 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