Bài toán về sự tương thích

Bài toán về sự tương thích

Bài toán về sự tương thích

Nguyễn Duy Khương

Có rất nhiều bài toán cần kiểm tra hoặc buộc phải kiểm tra tính giống nhau của hai thành phần nào đó với yêu cầu tốc độ cao Muốn 'ăn' hết test bạn cần phải có một thuật giải tốt Tôi xin nêu ra một cách làm tương đối hay như sau:

Trước tiên, ta phát biểu dạng tổng quát của bài toán:

Cho hai đối tương A, B (là các đồ thị, dãy số ) Hai phần tử A, B gọi là tương thích nếu

A, B cùng thoả mãn tính chất nào đó Bài toán yêu cầu kiểm tra sự tương thích giữa hai đối tương A, B

Thuật giải: Xây dựng một quy tắc mã hoá thoả mãn: Tất cả các đối tượng có cùng tính

chất thì kết quả mã hoá phải giống nhau

Xét các ví dụ:

Bài 1:

Cho hai cây A, B gồm N đỉnh (1 ≤ N ≤ 1000), gốc R1, R2 A, B gọi là tương đương nếu chỉ cần thay đổi nhãn các đỉnh của B thì thu được A

Yêu cầu: Hãy xác định A, B có tương đương không?

Input: TREE.IN

- Dòng đầu ghi N

- Dòng hai ghi R1 là gốc cây A

- N - 1 dòng tiếp mô tả các cạnh của cây A

- Dòng tiếp theo ghi R2 là gốc của B

- N - 1 dòng tiếp mô tả các cạnh của cây A

Ouput: TREE.OUT

- Dòng đầu ghi là YES nếu tương đương, NO nếu không

- Dòng thứ hai gồm N số, số thứ I là nhãn nút của cây B tương ứng với nút I của A

Nhận xét:

- Theo như đề bài hai gốc sẽ giữ cùng nhãn

- Như vậy ta sẽ phải sắp xếp các nút con theo một trật tự để tương đương Bạn có thể duyệt đến khoảng 100, nhưng > 1000 một thuật toán tối ưu hơn

Thuật giải: Xây dựng quy tắc mã hoá một cây sau:

- Bắt đầu từ nút gốc Ta xây dựng đệ quy như sau: Tại mỗi nút, số đầu tiên của dãy mã hoá nút đó là: S là số nút con của đỉnh đó Tiếp sau là dãy mã hoá nhỏ nhất của các nút con nó, và tiếp tục lớn dần

- Như vậy ta thấy rằng: 1 dạng cây có duy nhất một cách mã hoá, và ngược lại một cách

mã hoá xác định 1 dạng cây duy nhất Hai cây tương đương khi và chỉ khi dãy mã hoá của chúng là giống nhau

{$N+,Q+,R+,S+}

{$M 60384,0,655360}

Const

Tfi = 'TREE.IN';

Tfo = 'TREE.OUT';

MaxN = 1001;

Type Pnode = ^Tnode;

Tnode = Record

x : Integer;

Next : Pnode; End;

Arr1p = Array[0 MaxN] of Pnode;

Arr1i = Array[0 MaxN] of Integer;

Var Q1, Q2 : Arr1p;

Code : Array [1 2] of Arr1p;

Tr1, Tr2 : Pnode;

Order, Nson1, Nson2 : Arr1i;

Visit : Array [0 MaxN] of Byte;

N, R1, R2 : Integer;

Fi, Fo : Text;

Procedure Push (x : Integer; Var Last : Pnode); Var p : Pnode;

Begin

New (p);

p^.x := x;

p^.Next := Last;

Last := p;

End;

Procedure Readlist;

Var i, x, y : Integer;

Begin

Assign (Fi, Tfi); Reset (Fi);

Readln (Fi, N);

Readln (Fi, R1);

For i := 1 to N - 1 do

Begin

Readln (Fi, x, y);

Push (x, Q1[y]);

Push (y, Q1[x]);

End;

Readln (Fi, R2);

For i := 1 to N - 1 do

Begin

Readln (Fi, x, y);

Push (x, Q2[y]);

Push (y, Q2[x]);

End;

Close (Fi);

End;

Procedure MakeCode (Root : Integer;

Var Q : Arr1p; Var Son : Arr1i; Var Tree : Pnode); Procedure InitNumSon (x : Integer);

Var p : Pnode;

Begin

Visit[x] := 1;

p := Q[x];

Son[x] := 1;

While p <> Nil do

Begin

If Visit[p^.x] = 0 Then

Begin

InitNumSon (p^.x);

Son[x] := Son[p^.x] + Son[x];

End;

p := p^.Next;

End;

End;

Procedure Swapi (Var x, y : Integer);

Var i : Integer;

Begin

i := x; x := y; y := i;

End;

Function Kind (r1, r2 : Pnode) : Byte;

Begin

Kind := 0;

While r1 <> Nil do

Begin

If Son[r1^.x] <> Son[r2^.x] Then

Begin

If Son[r1^.x] > Son[r2^.x] Then Kind := 1 Else Kind := 2; Exit;

End;

r1 := r1^.Next;

r2 := r2^.Next;

End;

End;

Procedure Sort (l, r : Integer);

Var i, j : Integer;

tr : Pnode;

Begin

If l >= r Then Exit;

i := l + Random (r - l + 1);

tr := Code[1, Order[i]];

i := l;

j := r;

Repeat

While Kind (Code[1, Order[i]], tr) = 1 do i := i + 1; While Kind (Code[1, Order[j]], tr) = 2 do j := j - 1;

If i <= j Then

Begin

Swapi (Order[i], Order[j]);

i := i + 1;

j := j - 1;

End;

Until i > j;

Sort (i, r);

Sort (l, j);

End;

Procedure BuildCode (x : Integer);

Var p : Pnode; i, All : Integer;

Begin

All := 0;

Visit[x] := 1;

p := Q[x];

While p <> Nil do

Begin

If Visit[p^.x] = 0 Then BuildCode (p^.x);

p := p^.Next;

End;

Visit[x] := 2;

p := Q[x];

While p <> Nil do

Begin

If Visit[p^.x] = 2 Then

Begin

Inc (All);

Order[All] := p^.x;

End;

p := p^.Next;

End;

Sort (1, All);

p := Nil;

Push (x, p);

p^.Next := Code[1, Order[All]];

Code[1, x] := p;

For i := All downto 2 do

Code[2, Order[i]]^.Next := Code[1, Order[i - 1]];

If All >= 1 Then Code[2, x] := Code[2, Order[1]] Else Code[2, x] := p; End;

Begin

Fillchar ( Visit, sizeof (Visit), 0);

InitNumSon (root);

Fillchar ( Visit, sizeof (Visit), 0);

BuildCode (root);

Tree := Code[1, Root];

End;

Function Check (R1, R2 : Pnode) : Boolean;

Var i : Integer;

Begin

Check := False;

For i := 1 to N do

Begin

If NSon1[R1^.x] <> Nson2[R2^.x] Then Exit;

R1 := R1^.Next;

R2 := R2^.Next;

End;

Check := True;

End;

Procedure Print;

Var i : Integer; p1, p2 : Pnode;

Begin

Assign (Fo, Tfo); Rewrite (Fo);

If Check (Tr1, Tr2) Then

Begin

Writeln (Fo, 'YES');

p1 := Tr1;

p2 := Tr2;

For i := 1 to N do

Begin

Order[p1^.x] := p2^.x;

p1 := p1^.Next;

p2 := p2^.Next;

End;

For i := 1 to N do

Write (Fo, Order[i], ' ');

Writeln (Fo);

End Else Writeln (Fo, 'NO');

Close (Fo);

End;

Begin

Readlist;

MakeCode (R1, Q1, Nson1, Tr1);

MakeCode (R2, Q2, Nson2, Tr2);

Print;

End

Bài 2:

Cho hai dãy số nguyên {an}, {bn} (1& le; N ≤ 100000, 1 ≤ ai, bi ≤ 8000) Hai dãy số gọi

là tương thích nếu:

+) nếu vị trí I có hai giá trị ai, bi thì bất kỳ j <> i mà ai = aj> => bi = bj

+) nếu vị trí I có hai giá trị ai, bi thì bất kỳ j <> i mà ai <> aj => bi <> bj

Yêu cầu: Hãy kiểm tra hai dãy {an}, {bn} có tương thích không?

Input: SEQUENCE.IN

- Dòng đầu ghi có N

- Dòng hai ghi dãy {an}

- Dong ba ghi dãy {bn}

Ouput: SEQUENCE.OUT

- Ghi YES nếu tương thích, ghi NO nếu không

Lời giải:

Xây dựng quy tắc mã hoá sau:

- Fa (i), Fb(i) = Vị trí xuất hiện trước của ai, bi

- {an}, bn} tương thích khi và chỉ khi Fa = Fb với mọi i

Const Tfi = 'SEQUENCE.IN';

Tfo = 'SEQUENCE.OUT';

MaxN = 8000;

Var Fa, Fb : Array [1 8000] of Longint;

N : Longint;

F1, F2, Fo : Text;

Procedure Print (St : String);

Begin

Assign (Fo, Tfo); Rewrite (Fo);

Writeln (Fo, St);

Close (Fo);

Close (F1);

Close (F2);

Halt;

End;

Procedure Main;

Var i, x, y : Longint;

Begin

Assign (F1, Tfi); Reset (F1);

Assign (F2, Tfi); Reset (F2);

Readln (F1, N);

Readln (F2);

Readln (F2);

For i := 1 to N do

Begin

Read (F1, x);

Read (F2, y);

If Fa[x] <> Fb[y] Then Print ('NO');

Fa[x] := i;

Fb[y] := i;

End;

Print ('YES');

End;

Begin

Main;

End

Bài 3:

Cho hai dãy số {an}, {bm} (1≤ N, M≤1000, 1≤ ai,bi ≤ 1000)

Input: SEQLMAX.IN

- Dòng đầu ghi có N, M

- Dòng hai ghi dãy {an}

- Dòng ba ghi dãy {bm}

Ouput: SEQLMAX.OUT

- Ghi Lmax là độ dài lớn nhất tìm được

Thuật giải:

- Dùng cách mã hoá ở trên và kết hợp quy hoạch động

F[i, j] là độ dài lớn nhất khi hai dãy con đó kết thúc ở i của {an} và j của {bm}

- Nếu i-Fa (i) = j - Fb(j) thì F[i,j] = F[i-1,j-1] + 1

Ngược lại: F[i,j] = Min{i-Fa (i), j-Fb(j), F[i-1, j-1] + 1}

Program SEQLMAX;

Const

Tfi = 'SEQLMAX.IN';

Tfo = 'SEQLMAX.OUT';

MaxN = 1001;

Type Arr1i = Array [0 MaxN] of Integer;

Var Fa, Fb, Backa, Backb : Arr1i;

F : Array [1 2] of Arr1i;

N, M, lmax : Integer;

Fi, Fo : Text;

Procedure Readlist;

Var i, x : Integer;

Begin

Assign (Fi, Tfi); Reset (Fi);

Readln (Fi, N, M);

For i := 1 to N do

Begin

Read (Fi, x);

Fa[i] := Backa[x];

Backa[x] := i;

End;

For i := 1 to M do

Begin

Read (Fi, x);

Fb[i] := Backb[x];

Backb[x] := i;

End;

Close (Fi);

End;

Function Min (x, y, z : Integer) : Integer;

Begin

If x > y Then x := y;

If x > z Then Min := z Else Min := x;

End;

Procedure Dynamic (Var F1, F2 : Arr1i; x : Integer); Var y : Integer;

Begin

Fillchar ( F2, sizeof (F2), 0);

For y := 1 to M do

Begin

If x - Fa[x] = y - Fb[y] Then F2[y] := F1[y - 1] + 1 Else F2[y] := Min (F1[y - 1] + 1, x - Fa[x], y - Fb[y]);

If F2[y] > lmax Then lmax := F2[y];

End;

End;

Procedure Main;

Var x : Byte; i : Integer;

Begin

Readlist;

lmax := 0;

x := 1;

Fillchar ( F, sizeof (F), 0);

For i := 1 to N do

Begin

x := 3 - x;

Dynamic (F[3 - x], F[x], i);

End;

End;

Begin

Assign (Fo, Tfo); Rewrite (Fo);

Main;

Writeln (Fo, lmax);

Close (Fo);

End

Và các bạn thử làm bài CODE IOI2003 với thuật giải trên Đây là bài khá hay và khá khó

ở IOI 2003, quả thật thật khó ăn 50/100 số điểm bài này, nhưng nếu đưa về thuật giải mã hoá thì hoàn toàn dễ Bài này, tôi xin chỉ đưa ra code (độ phức tạp là O(N^2)) vì cách quy hoặch động khá giống với bài trên còn hàm mã hoá chỉ khác đôi chút các bạn hãy thử nghĩ xem:

Program CODE_;

Const Tfi = 'CODE.20.IN';

Tfo = 'CODE.OUT';

MaxN = 1001;

limit = 1000;

Type St30 = String[30];

St9 = String[9];

Exp = Record x, y, z : St9; End;

ReCode = Record x, y, z : Integer; End;

Arr1Ex = Array [0 MaxN] of Exp;

Arr1code = Array [0 MaxN] of ReCode;

Arr1Q = Array [0 3*MaxN] of St9;

Arr1i = Array [0 3*MaxN] of Integer;

Var C : Array [1 2] of Arr1Code;

Ex : Array [1 2] of Arr1Ex;

Back : Arr1i;

Q : Array [1 2] of Arr1Q;

N, Sod : Array [1 2] of Integer;

F : Array [0 MaxN, 0 MaxN] of Integer;

Result : Integer;

Fi, Fo : Text;

Procedure Read_One (Var Ex : Arr1Ex; Var Sod : Integer);

Var i : Integer;

St : String;

Begin

For i := 1 to Sod do

With Ex[i] do

Begin

Readln (Fi, St);

While Pos (' ', St) <> 0 do Delete (St, Pos(' ', St), 1);

x := Copy (St, 1, Pos ('=', St) - 1);

Delete (St, 1, Pos ('=', St));

y := Copy (St, 1, Pos ('+', St) - 1);

Delete (St, 1, Pos ('+', St));

z := St;

End;

End;

Procedure Readlist;

Begin

Assign (Fi, Tfi); Reset (Fi);

Readln (Fi, N[1], N[2]);

Read_One (Ex[1], N[1]);

Read_One (Ex[2], N[2]);

Close (Fi);

End;

Procedure InitQ (Var Ex : Arr1Ex; Var Q : Arr1Q; Var N : Integer; Var Sod : Integer); Var i : Integer;

Begin

For i := 1 to N do

With Ex[i] do

Begin

Q[3*i - 2] := x;

Q[3*i - 1] := y;

Q[3*i ] := z;

End;

Sod := 3 * N;

End;

Procedure SwapS9 (Var s1, s2 : St9);

Var s : St9;

Begin

s := s1; s1 := s2; s2 := s;

End;

Procedure Sort (l, r : Integer; Var Q : Arr1Q);

Var i, j : Integer;

d : St9;

Begin

If l >= r Then Exit;

i := l;

j := r;

d := Q[l + Random (r - l + 1)];

Repeat

While Q[i] < d do i := i + 1;

While Q[j] > d do j := j - 1;

If i <= j Then

Begin

SwapS9 (Q[i], Q[j]);

i := i + 1;

j := j - 1;

End;

Until i > j;

Sort (i, r, Q);

Sort (l, j, Q);

End;

Procedure Sort_Del (Var Q : Arr1Q; Var Sod : Integer);

Var i, j : Integer;

Begin

Sort (1, Sod, Q);

j := 1;

For i := 2 to Sod do

If Q[i] <> Q[j] Then

Begin

Inc (j);

Q[j] := Q[i];

End;

Sod := j;

End;

Procedure Main_One;

Var i : Integer;

Begin

For i := 1 to 2 do

Begin

InitQ (Ex[i], Q[i], N[i], Sod[i]);

Sort_Del (Q[i], Sod[i]);

End;

End;

Function Binary (Cd, Ct : Integer; Var Q : Arr1Q; Var s : St9) : Integer; Var i : Integer;

Begin

While Cd <= Ct do

Begin

i := (Cd + Ct) div 2;

If Q[i] = s Then

Begin

Binary := i;

Exit;

End Else

If Q[i] > s Then Ct := i - 1 Else Cd := i + 1;

End;

End;

Procedure Swapi (Var x, y : Integer);

Var i : Integer;

Begin

i := x; x := y; y := i;

End;

Procedure SwapCode (Var Ex : Arr1Ex; Var Q : Arr1Q; Var C : Arr1Code; Var N, Sod : Integer);

Var v1, v2, v3 : Integer;

i : Integer;

Begin

Fillchar ( Back, sizeof (Back), 0);

For i := 1 to N do

With Ex[i] do

Begin

v1 := Binary (1, Sod, Q, x);

v2 := Binary (1, Sod, Q, y);

v3 := Binary (1, Sod, Q, z);

C[i].x := Back[v1];

Back[v1] := 2*i - 1;

If Back[v2] > Back[v3] Then Swapi (v2, v3);

C[i].y := Back[v2];

Back[v2] := 2*i;

C[i].z := Back[v3];

Back[v3] := 2*i;

Swapi (C[i].y, C[i].z);

End;

End;

Procedure Main_Two;

Var i : Integer;

Begin

For i := 1 to 2 do

SwapCode (Ex[i], Q[i], C[i], N[i], Sod[i]);

End;

Function Min (x, y : Integer) : Integer;

Begin

If x < y Then Min := x Else Min := y;

End;

Function Row (x : Integer) : Integer;

Begin

If x mod 2 = 0 Then Row := x div 2 Else Row := (x - 1) div 2 + 1; End;

Function Same (c1, c2 : ReCode; i, j : Integer) : Integer;

Var l1, l2, l3 : Integer;

Begin

If (c1.x mod 2 = c2.x mod 2) and (i - Row (c1.x) = j - Row (c2.x)) Then l1 := limit

Else l1 := Min (i - Row (c1.x), j - Row (c2.x));

If (c1.y mod 2 = c2.y mod 2) and (i - row (c1.y) = j - row (c2.y)) Then l2 := limit Else l2 := Min (i - row (c1.y), j - row (c2.y));

If (c1.z mod 2 = c2.z mod 2) and (i - row (c1.z) = j - row (c2.z)) Then l3 := limit Else l3 := Min (i - row (c1.z), j - row (c2.z));

If l1 > l2 Then l1 := l2;

If l1 > l3 Then l1 := l3;

If l1 > 0 Then Same := l1 Else Same := 0;

End;

Procedure Main_three;

Var i, j : Integer;

Begin

Fillchar ( F, sizeof (F), 0);

Result := 0;

For i := 1 to N[1] do

For j := 1 to N[2] do

Begin

F[i, j] := Min (Same (C[1, i], C[2, j], i, j), F[i - 1, j - 1] + 1);

If F[i, j] > Result Then Result := F[i, j];

End;

End;

Procedure Print;

Begin

Assign (Fo, Tfo); Rewrite (Fo);

Writeln (Fo, Result);

Close (Fo); End;

Begin

Readlist; Main_One; Main_Two; Main_Three; Print;

End