Chỉnh hợp chập K của N phần tử là tổng số phép chọn K phần tử có phân biệt thứ tự trong tập hợp N phần tử. Chỉnh hợp là một trong những công thức cơ bản trong bộ môn toán xác suất thống kê, bộ môn này có giá trị áp dụng thực tiễn rất cao, có thể nói xác suất thông kê là một trong những môn toán hữu dụng nhất và được áp dụng rộng rãi nhất trong những loại toán được học thời phổ thông.
Ví dụ đơn giản: Có 6 cách chọn 2 số có phân biệt thứ tự trong tập hợp 3 số 1,2,3
Chỉnh hợp khác tổ hợp ở chỗ chỉnh hợp có phân biệt thứ tự trong mỗi tập hợp con, còn tổ hợp thì không phân biệt thứ tự.
Công thức tính chỉnh hợp
Ý nghĩa thực tiễn của chỉnh hợp
- Áp dụng trong hầu hết các thuật toán xổ số, chỉnh hợp là một phần không thể thiếu trong những thuật toán xổ số phức tạp.
Mã: Option Explicit Dim a, S, sTran&, sVong&, sD& Dim n&, i&, r&, k&, j&, j2&, c&, t&, z&, iKey$, iKey2$ Sub XYZ() Dim sArr(), res(), dic As Object, sDoi& Randomize Set dic = CreateObject("scripting.dictionary") With Sheets("Ten") sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value End With sDoi = UBound(sArr) Call XepLich(res, sArr, dic, sDoi) n = UBound(res) For j = 1 To sVong 'Gan ten cac doi For i = 1 To sTran S = Split(res(i, j), "_") res(i, j) = sArr(CLng(S(0)), 1) & "_" & sArr(CLng(S(1)), 1) Next i If n > sTran Then res(n, j) = sArr(res(n, j), 1) Next j Sheets("Sheet1").Range("B4:X100").ClearContents Sheets("Sheet1").Range("B4").Resize(n, sVong) = res End Sub Private Sub XepLich(res, sArr, dic, sDoi) Dim bDoiLe As Boolean bDoiLe = ((sDoi Mod 2) = 1) If bDoiLe Then sVong = sDoi Else sVong = sDoi - 1 'So vong dau sTran = sDoi \ 2 'So Tran 1 vong sD = sTran * 2 'so Doi 1 vong TuDau: If bDoiLe = True Then ReDim res(1 To sTran + 1, 1 To sVong) a = UniqueRand(sVong) For n = 1 To sVong res(sTran + 1, n) = a(n) Next n Else ReDim res(1 To sTran, 1 To sVong) End If For n = 1 To sVong TroLai: If bDoiLe = True Then a = CreateUniqueRand(sDoi, res(sTran + 1, n)) Else a = UniqueRand(sD) End If k = 0: i = 0 Do While k < sTran i = i + 1 If a(i) <> Empty Then k = k + 1 res(k, n) = a(i) a(i) = Empty For j = i + 1 To sD '*** If a(j) <> Empty Then iKey = KeyValue(res(k, n), a(j)) If dic.exists(iKey) = False Then dic.Add iKey, "" res(k, n) = iKey a(j) = Empty Exit For End If End If Next j If j = sD + 1 Then '*** For r = 1 To k - 1 S = Split(res(r, n), "_") For c = 0 To 1 iKey = KeyValue(res(k, n), S(c)) If dic.exists(iKey) = False Then If c = 0 Then t = S(1) Else t = S(0) For j2 = i + 1 To sD '*** If a(j2) <> Empty Then iKey2 = KeyValue(t, a(j2)) If dic.exists(iKey2) = False Then dic.Remove (res(r, n)) res(r, n) = iKey2: res(k, n) = iKey dic.Add iKey, "": dic.Add iKey2, "" a(j2) = Empty GoTo Thoat End If End If Next j2 End If Next c Next r If r = k Then '**** z = z + 1 If z = 50 Then dic.RemoveAll: z = 0: GoTo TuDau Call RemoveDic(res, dic) GoTo TroLai End If End If End If Thoat: Loop Next n End Sub Private Sub RemoveDic(ByRef res, ByRef dic) For r = 1 To k - 1 dic.Remove (res(r, n)) Next r End Sub Private Function KeyValue(ByVal val_1, ByVal val_2) As String If CLng(val_1) < CLng(val_2) Then KeyValue = val_1 & "_" & val_2 Else KeyValue = val_2 & "_" & val_1 End If End Function Private Function CreateUniqueRand(ByVal n As Long, ByVal notNum) As Variant Dim arr, res, i&, k& arr = UniqueRand(n) ReDim res(1 To n - 1) For i = 1 To n If arr(i) <> notNum Then k = k + 1 res(k) = arr(i) End If Next i CreateUniqueRand = res End Function Private Function UniqueRand(ByVal n As Long) As Variant Dim arr() As Long, i&, RndNum&, tmp& ReDim arr(1 To n) 'Randomize For i = 1 To n RndNum = Int(n * Rnd() + 1) If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum) If arr(n) = 0 Then arr(RndNum) = n Else arr(RndNum) = arr(n) arr(n) = tmp n = n - 1 Next i UniqueRand = arr End Function