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.
Chúng ta hãy cùng xem 1 số 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 \le 100000, 1 \le ai, bi \le 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).
Yêu cầu:
Hãy tìm hai đoạn con liên tiếp của {an}{bm} tương thích có độ dài dài nhất?
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.