So sánh kết quả tổ hợp chập 6 năm 2024

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