Cần công thức tính một dạng Tổ hợp

One Response

1. hands says:

   31/12/2022 at 4:37 pm

   Chả cần dùng đít to đít nhỏ đít thon gì cả. Thuật toán hoàn toàn đơn giản (giải thích trong hàm). Số vòng lặp luôn bằng số phần tử cần chọn. Dĩ nhiên phần tử được chọn sẽ không được phép chọn trong các lần tiếp theo, tức phải loại bỏ. Dùng đít to đít nhỏ với Exists hoặc không (bẫy lỗi) sẽ gặp trường hợp trùng thì "phí" một vòng lặp, tức số vòng lặp có thể > số phần tử cần chọn. Hàm dưới đây không dùng thêm công cụ nào cả.

   Function Draw(Arr, Amount As Long)
   ' hàm chọn lần lượt Amount phần tử của mảng Arr. Việc chọn phần tử của mảng Arr đồng nghĩa
   với việc chọn chỉ số của phần
   ' tử đó trong mảng
   ' Ta dùng vòng lặp có Amount bước. Trong mỗi bước ta chọn 1 chỉ số, tức 1 phần tử. Ta loại phần
   tử được chọn
   ' khỏi lần chọn tiếp theo bằng cách ghi phần tử thứ k trong mảng nguồn vào vị trí có chỉ số vừa
   được chọn và tăng
   ' thêm 1 đơn vị cận dưới của khoảng chỉ số thao tác trong vòng lặp sau. Bằng cách này trong mỗi
   vòng lặp ta chỉ
   ' chọn trong những phần tử chưa được chọn. Luôn có Amount vòng lặp. Dùng từ điển có thể số
   vòng lặp sẽ > Amount
   Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
       If Amount > UBound(Arr) - LBound(Arr) + 1 Then Exit Function
       original = Arr
   
   ReDim tmpArr(1 To Amount)
       d = LBound(original)
       c = UBound(original)
       Randomize
       For k = 1 To Amount
           ' chọn chỉ số trong khoảng chỉ số hiện thời
           index = Int(Rnd() * (c - d + 1)) + d
           ' ghi phần tư được chọn vào mảng kết quả
           tmpArr(k) = original(index)
           ' loại phân tử vừa chọn bằng cách thay thế nó bằng phần tử thứ k trong mảng nguồn,
           ' tức phần tử có chỉ số k + LBound(Arr) - 1
           original(index) = original(k + LBound(original) - 1)
           ' tăng cận dưới của khoảng chỉ số thao tác
           d = d + 1
       Next k
       Draw = tmpArr
   End Function

   Các phần tử của mảng không nhất thiết là số. VD. đó là danh sách mã, danh sách học sinh không trùng.

   Quả đúng là 1 giải thuật rất thông minh
   Đã test thử với 100000 số, lấy ra 60000 số.. so sánh với hàm UniqueRandomNum trước đây thì cái của bạn nhanh hơn ít nhất 7 lần
   Tuy nhiên nếu dùng, chắc phải sửa lại đôi chút, vì:
   – Biến Arr là cái ta không có sẳn
   – Nếu Arr lấy từ CSDL của Excel thì Arr luôn là mảng 2 chiều
   vân vân…
   Nhưng nói chung cũng không quan trọng lắm —> Giải thuật vẫn thế —> Tốc độ cao mới là cái đáng để học hỏi từ code này
   Ẹc… Ẹc…

   NDU có thể cụ thể code thành 1 file ex giúp được không. Chỉ cần lấy 3 số ngẫu nhiên không trùng từ Arr=Array(1,2,3,4,5,9).
   Và cụ thể phần thay cận dưới giúp.
   Sao tôi gán code trên vào file mà vẫn trùng.
   Cám ơn nhiều.

   Bạn thử up file bạn đã thử xem sao,

   biết đâu ít ra mọi người học được cái lỗi đó

   Không biết tôi có làm sai chỗ nào.
   Function Draw(Arr, Amount As Long)
   ' hàm ch?n l?n lu?t Amount ph?n t? c?a m?ng Arr. Vi?c ch?n ph?n t? c?a m?ng Arr d?ng nghia'
   'v?i vi?c ch?n ch? s? c?a ph?n'
   ' t? dó trong m?ng
   ' Ta dùng vòng l?p có Amount bu?c. Trong m?i bu?c ta ch?n 1 ch? s?, t?c 1 ph?n t?. Ta lo?i ph?n'
   't? du?c ch?n
   ' kh?i l?n ch?n ti?p theo b?ng cách ghi ph?n t? th? k trong m?ng ngu?n vào v? trí có ch? s? v?a
   'du?c ch?n và tang
   ' thêm 1 don v? c?n du?i c?a kho?ng ch? s? thao tác trong vòng l?p sau. B?ng cách này trong m?i
   'vòng l?p ta ch?
   ' ch?n trong nh?ng ph?n t? chua du?c ch?n. Luôn có Amount vòng l?p. Dùng t? di?n có th? s?
   'vòng l?p s? > Amount
   Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
   If Amount > UBound(Arr) – LBound(Arr) + 1 Then Exit Function
   original = Arr

   ReDim tmpArr(1 To Amount)
   d = LBound(original)
   c = UBound(original)
   Randomize
   For k = 1 To Amount
   ' ch?n ch? s? trong kho?ng ch? s? hi?n th?i
   'index = Int(Rnd() * (c – d + 1)) + d
   index = Int(Rnd() * (c – d – k + 2)) + d + k – 1
   ' ghi ph?n tu du?c ch?n vào m?ng k?t qu?
   tmpArr(k) = original(index)
   ' lo?i phân t? v?a ch?n b?ng cách thay th? nó b?ng ph?n t? th? k trong m?ng ngu?n,'
   ' t?c ph?n t? có ch? s? k + LBound(Arr) – 1
   original(index) = original(k + LBound(original) – 1)
   ' tang c?n du?i c?a kho?ng ch? s? thao tác'
   d = d + 1
   Next k
   Draw = tmpArr
   End Function
   Sub Test1()
   Dim sArr(), i&, iSo&
   sArr = Array(1, 2, 3, 4, 5, 9)
   iSo = 3
   For i = 1 To iSo
   Cells(i, 2) = Draw(sArr, iSo)(i)
   Next i
   End Sub

   Thay sub trên thành

   Sub Test1()
   Dim sArr(), tArr(), i&, iSo&
   sArr = Array(1, 2, 3, 4, 5, 9)
   iSo = 3
   tArr = Draw(sArr, iSo)
   For i = 1 To iSo
   Cells(i, 2) = tArr(i)
   Next i
   End Sub

   Tại sao thế thì tôi không biết, nhưng làm theo bài thì phải vậy

   Thuật toán của siwtom tôi hiểu lờ mờ rằng:
   Sau khi lấy được phần tử kết quả thứ k trong trong vòng lặp gán vào tmp, thì thay phần tử đó trong original bằng giá trị phần tử thứ k trong original.

   Nhưng công thức rnd() vẫn lấy từ đầu đến cuối của original, nên vẫn còn khả năng lấy lần 2, lần 3.

   Nếu công thức rnd() chỉ lấy từ phần tử k+1 trở xuống, thì mới không trùng.

   Nghĩa là thay câu:

   index = Int(Rnd() * (c – d + 1)) + d
   bằng

   index = Int(Rnd() * (c – k + 1)) + k

   thêm bớt 1 theo lbound gì đó thành:

   index = Int(Rnd() * (c – (k – Lbound(original) + 1) + 1)) + k – Lbound(original) + 1

   Không biết tôi có làm sai chỗ nào.
   Function Draw(Arr, Amount As Long)
   ' hàm ch?n l?n lu?t Amount ph?n t? c?a m?ng Arr. Vi?c ch?n ph?n t? c?a m?ng Arr d?ng nghia'
   'v?i vi?c ch?n ch? s? c?a ph?n'
   ' t? dó trong m?ng
   ' Ta dùng vòng l?p có Amount bu?c. Trong m?i bu?c ta ch?n 1 ch? s?, t?c 1 ph?n t?. Ta lo?i ph?n'
   't? du?c ch?n
   ' kh?i l?n ch?n ti?p theo b?ng cách ghi ph?n t? th? k trong m?ng ngu?n vào v? trí có ch? s? v?a
   'du?c ch?n và tang
   ' thêm 1 don v? c?n du?i c?a kho?ng ch? s? thao tác trong vòng l?p sau. B?ng cách này trong m?i
   'vòng l?p ta ch?
   ' ch?n trong nh?ng ph?n t? chua du?c ch?n. Luôn có Amount vòng l?p. Dùng t? di?n có th? s?
   'vòng l?p s? > Amount
   Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
   If Amount > UBound(Arr) – LBound(Arr) + 1 Then Exit Function
   original = Arr

   ReDim tmpArr(1 To Amount)
   d = LBound(original)
   c = UBound(original)
   Randomize
   For k = 1 To Amount
   ' ch?n ch? s? trong kho?ng ch? s? hi?n th?i
   'index = Int(Rnd() * (c – d + 1)) + d
   index = Int(Rnd() * (c – d – k + 2)) + d + k – 1
   ' ghi ph?n tu du?c ch?n vào m?ng k?t qu?
   tmpArr(k) = original(index)
   ' lo?i phân t? v?a ch?n b?ng cách thay th? nó b?ng ph?n t? th? k trong m?ng ngu?n,'
   ' t?c ph?n t? có ch? s? k + LBound(Arr) – 1
   original(index) = original(k + LBound(original) – 1)
   ' tang c?n du?i c?a kho?ng ch? s? thao tác'
   d = d + 1
   Next k
   Draw = tmpArr
   End Function
   Sub Test1()
   Dim sArr(), i&, iSo&
   sArr = Array(1, 2, 3, 4, 5, 9)
   iSo = 3
   For i = 1 To iSo
   Cells(i, 2) = Draw(sArr, iSo)(i)
   Next i
   End Sub

   Đương nhiên là sai rồi —> Đầu tiên phải lấy ngẫu nhiên không trùng cho vào 1 biến array trước, xong mới for.. next theo biến array này
   Tuy nhiên, nếu là tôi thì tôi sẽ sửa lại 1 chút cho phù hợp với CSDL trên Excel (mảng 2 chiều)

   Function Draw(Arr, Amount As Long)
   Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
   If Amount > UBound(Arr) – LBound(Arr) + 1 Then Exit Function
   original = Arr
   ReDim tmpArr(1 To Amount, 1 To 1)
   d = LBound(original)
   c = UBound(original)
   Randomize
   For k = 1 To Amount
   index = Int(Rnd() * (c – d – k + 2)) + d + k – 1
   tmpArr(k, 1) = original(index)
   original(index) = original(k + LBound(original) – 1)
   d = d + 1
   Next k
   Draw = tmpArr
   End Function

   Sub Test1()
   Dim sArr(), Amount As Long, rArr
   sArr = Array(1, 2, 3, 4, 5, 9)
   Amount = 3
   rArr = Draw(sArr, Amount)
   Range("B1").Resize(Amount).Value = rArr
   End Sub
   ——————

   Là vầy sư phụ à:
   – Ta có mảng Arr
   – Duyệt từ 1 đến Amount
   – Dùng Rnd để tính vị trí k
   – Lấy phần từ thứ k của Arr cho vào mảng khác
   – Lấy phần từ thứ nhất của Arr thế vào phần tử thứ k
   ===> Đó là lần quét đầu tiên
   – Đến lần quét thứ 2 sẽ lấy phần tử thứ hai của Ar thế vào phần tử thứ k
   vân vân…
   Và chắc chắn 100% sẽ không có chuyện trùng, ngoại trừ trường hợp mảng Arr có trùng

   Hiểu rồi, phải lấy hết kết quả mới gán. Tôi thì khi gán nó chạy UDF => trùng là đương nhiên.
   Sao tôi thay thử amount=4 thì báo lỗi. <4 thi OK

   tmpArr(k, 1) = original(index)
   Cám ơn nhiều.

   Thí dụ Arr = (1, 2, 3, 4, 5, 6)

   k= 1, index = 2, tmp(1) = 2
   original trở thành: (1, 1, 3 ,4, 5, 6)

   k = 2, index = 1, tmp(2) = 1
   original trở thành (1, 1, 3 ,4, 5, 6) (không đổi vì thay 1 = 1)

   k = 3, index = 2 tmp(3) = 1

   qua 3 vòng lặp đã có 2 giá trị trùng.Dùng code đầu tiên của siwtom đi! Tôi cảm thấy không mấy tin tưởng về code sửa lại sau đó

   Function Draw(Arr, Amount As Long)
   Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
   If Amount > UBound(Arr) – LBound(Arr) + 1 Then Exit Function
   original = Arr
   ReDim tmpArr(1 To Amount, 1 To 1)
   d = LBound(original)
   c = UBound(original)
   Randomize
   For k = 1 To Amount
   index = Int(Rnd() * (c – d + 1)) + d
   tmpArr(k, 1) = original(index)
   original(index) = original(k + LBound(original) – 1)
   d = d + 1
   Next k
   Draw = tmpArr
   End Function

   Nhưng nếu e bỏ d=d+1 thì OK với cả 2 code.

   Không thể nào sư phụ à! Vì cái này:

   index = Int(Rnd() * (c – d + 1)) + d
   ………………..
   d = d + 1

   Nên index của lần lập thứ 2 không thể = 1 được (số ngẫu nhiên từ 2 trở đi mà)

   Cũng thí dụ trên:
   Khi k = 2, Nếu Rnd chỉ lấy từ phần tử thứ 2 trở về sau: có thể lấy 1 trong các số đen (1, 1, 3 ,4, 5, 6)
   Khi k =3, nếu Rnd chỉ lấy từ phần tử thứ 3 trở về sau, thì không lấy 1 đỏ được. Chỉ có thể lấy các số đen: Arr(1, 1, 3 ,4, 5, 6)

   Function Draw(Arr, Amount As Long)
   Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
   If Amount > UBound(Arr) – LBound(Arr) + 1 Then Exit Function
   original = Arr
   ReDim tmpArr(1 To Amount)
   d = LBound(original)
   c = UBound(original)
   Randomize
   For k = 1 To Amount
   index = Int(Rnd() * (c – d – k + 2)) + d + k – 1
   tmpArr(k) = original(index)
   original(index) = original(k + LBound(original) – 1)
   d = d + 1
   Next k
   Draw = tmpArr
   End Function

   Sub Test1()
   Dim sArr(), tArr(), i&, iSo&
   sArr = Array(1, 2, 3, 4, 5, 9)
   iSo = 4
   tArr = Draw(sArr, iSo)
   For i = 1 To iSo
   Cells(i, 2) = tArr(i)
   Next i
   End Sub
   Vậy thêm dòng
   If index > c Then index = c
   Thì OK. Code của NDU cũng vậy.

   bạn phải lấy post gốc của siwtom ở bài [URL='https://www.giaiphapexcel.com/forum/showthread.php?66810-C%E1%BA%A7n-c%C3%B4ng-th%E1%BB%A9c-t%C3%ADnh-m%E1%BB%99t-d%E1%BA%A1ng-T%E1%BB%95-h%E1%BB%A3p&p=408551#post408551'%5D#8 hoặc như của Ndu… ở bài [URL='https://www.giaiphapexcel.com/forum/showthread.php?66810-C%E1%BA%A7n-c%C3%B4ng-th%E1%BB%A9c-t%C3%ADnh-m%E1%BB%99t-d%E1%BA%A1ng-T%E1%BB%95-h%E1%BB%A3p&p=409722#post409722'%5D#25

   chú ý câu lệnh này
   index = Int(Rnd() * (c – d + 1)) + d ''KHÔNG CÓ k trong đó
   ………
   d=d+1 ''thì cần cái này

   ————–
   trường hợp có k trong nó (câu lệnh tính index trên) như bài [URL='https://www.giaiphapexcel.com/forum/showthread.php?66810-C%E1%BA%A7n-c%C3%B4ng-th%E1%BB%A9c-t%C3%ADnh-m%E1%BB%99t-d%E1%BA%A1ng-T%E1%BB%95-h%E1%BB%A3p&p=408570#post408570'%5D#10 siwtom thì khi đó xóa d=d+1 (nhưng siwtom đã nói không nên dùng cách này)

   http://www.giaiphapexcel.com/diendan/threads/c%E1%BA%A7n-c%C3%B4ng-th%E1%BB%A9c-t%C3%ADnh-m%E1%BB%99t-d%E1%BA%A1ng-t%E1%BB%95-h%E1%BB%A3p.66810/post-409707

   Reply