Tạo 1 giá trị với xác suất cho sẵn (1 người xem)

taquy762 · 25/12/19

Mình muốn random 1 số từ 1 dãy số với xác suất lấy ra các số trong dãy số đó là khác nhau.

Ví dụ mình cần tạo giá trị ngẫu nhiên từ 1 đến 2 trong một cột, ví dụ, gồm 100 ô, trong đó 70% số ô có giá trị 1, 30% số ô có giá trị 2 . (Tổng xác suất=100%)

Ai giỏi lập trình giúp mình với.

VetMini · 25/12/19

taquy762 đã viết:
...
Ai giỏi lập trình giúp mình với.

Bạn muốn hỏi cách làm hay muốn nhờ viết code giùm?
Cách làm, ví dụ có 5 số (1, 2, 3, 4, 5) với xác xuất là (10%, 10%, 20%, 20%, 40%)
=Index( { 1, 2, 3, 4, 5 }, Match(Randbetween(0, 99), { 0, 10, 20, 40, 60 }, 1))
Cái này diễn ra thành code dễ mà.

taquy762 · 25/12/19

VetMini đã viết:
Bạn muốn hỏi cách làm hay muốn nhờ viết code giùm?
Cách làm, ví dụ có 5 số (1, 2, 3, 4, 5) với xác xuất là (10%, 10%, 20%, 20%, 40%)
=Index( { 1, 2, 3, 4, 5 }, Match(Randbetween(0, 99), { 0, 10, 20, 40, 60 }, 1))
Cái này diễn ra thành code dễ mà.

Bác có thể viết trên file exel được không, em thử làm theo nhưng không được

VetMini · 25/12/19

taquy762 đã viết:
Bác có thể viết trên file exel được không, em thử làm theo nhưng không được

taquy762 · 25/12/19

VetMini đã viết:
View attachment 230437

em đã thử nhưng không được, khi tính lại % các giá trị trong cột thì nó sẽ bị nhảy lung tung và không đúng với xác suất mình cho ban đầu.

Hau151978 · 25/12/19

taquy762 đã viết:
em đã thử nhưng không được, khi tính lại % các giá trị trong cột thì nó sẽ bị nhảy lung tung và không đúng với xác suất mình cho ban đầu.

Bạn đang nói về xác suất thì chưa chắc trong 100 số 1 2 (hay 1 đến 5) như công thức của bác Vetmini các số xuất hiện theo đúng tỷ lệ. Tương tự như khi đánh đề thì xác suất để ra 1 con số ta chọn là 1%, ngày nào ta cũng đánh con số đó nhưng có khi cả năm không trúng.
Nếu bạn muốn tỷ lệ các số ra chính xác thì đây là bài toán lập hoán vị của dãy số.

Phuocam · 25/12/19

Thử:

Mã:

Public Sub NgauNhien()
Dim i As Long, k1 As Long, k2 As Long
Dim temp As Long
Dim arr As Variant
ReDim arr(1 To 100, 1 To 1)
Randomize
For i = 1 To 100
    If k1 = 70 Then
        temp = 2
    ElseIf k2 = 30 Then
        temp = 1
    Else
        temp = Int(Rnd() * 2) + 1
    End If
    
        If temp = 2 Then
            k2 = k2 + 1
        Else
            k1 = k1 + 1
        End If
    arr(i, 1) = temp
    
Next
Range("A1").Resize(100, 1) = arr
End Sub

VetMini · 25/12/19

taquy762 đã viết:
em đã thử nhưng không được, khi tính lại % các giá trị trong cột thì nó sẽ bị nhảy lung tung và không đúng với xác suất mình cho ban đầu.

Bạn hoàn toàn không có khái niệm về xác suất.
không đúng với xác suất mình cho ban đầu [sic]
Muốn biết mô hình có đúng xác suất hay không thì phải chạy khoảng vài ngàn số. Rồi dùng hàm Frequency hoặc vẽ đồ thị histogram để xem.

HieuCD · 26/12/19

phuocam đã viết:

Thử:

Mã:

Public Sub NgauNhien()
Dim i As Long, k1 As Long, k2 As Long
Dim temp As Long
Dim arr As Variant
ReDim arr(1 To 100, 1 To 1)
Randomize
For i = 1 To 100
    If k1 = 70 Then
        temp = 2
    ElseIf k2 = 30 Then
        temp = 1
    Else
        temp = Int(Rnd() * 2) + 1
    End If
   
        If temp = 2 Then
            k2 = k2 + 1
        Else
            k1 = k1 + 1
        End If
    arr(i, 1) = temp
   
Next
Range("A1").Resize(100, 1) = arr
End Sub

Code dài quá !$@!!

Vọt lẹ

HeSanbi · 26/12/19

phuocam đã viết:

Thử:

Mã:

Public Sub NgauNhien()
Dim i As Long, k1 As Long, k2 As Long
Dim temp As Long
Dim arr As Variant
ReDim arr(1 To 100, 1 To 1)
Randomize
For i = 1 To 100
    If k1 = 70 Then
        temp = 2
    ElseIf k2 = 30 Then
        temp = 1
    Else
        temp = Int(Rnd() * 2) + 1
    End If
 
        If temp = 2 Then
            k2 = k2 + 1
        Else
            k1 = k1 + 1
        End If
    arr(i, 1) = temp
 
Next
Range("A1").Resize(100, 1) = arr
End Sub

Code không đúng!

Tỉ lệ giao động cao nhất có thể khi chạy vòng lặp của xác xuất 30% là
30 + 30 + 30 - 1 = 89 %

89 % của 100 vị trí sẽ đổi còn lại 11% tức là từ vị trí 90 cho đến 100 không bao giờ tồn tại số 2

HeSanbi · 26/12/19

taquy762 đã viết:
Mình muốn random 1 số từ 1 dãy số với xác suất lấy ra các số trong dãy số đó là khác nhau.

Ví dụ mình cần tạo giá trị ngẫu nhiên từ 1 đến 2 trong một cột, ví dụ, gồm 100 ô, trong đó 70% số ô có giá trị 1, 30% số ô có giá trị 2 . (Tổng xác suất=100%)

Ai giỏi lập trình giúp mình với.

Bạn copy code bên dưới vào một Public Module và gõ vào một ô bất kì:
=FxHoanVi()
Hoặc =FxHoanVi(70, "1", "2")

-------------------

PHP:

Public Function FxHoanVi(Optional ByVal XacXuat% = 70, _
                         Optional ByVal ParamA$ = 1, _
                         Optional ByVal ParamB$ = 2) As String
   On Error Resume Next
   Randomize
   FxHoanVi = IIf(Rnd() <= 0.5, ParamA, ParamB)
   With Application.Caller
    Call Application.Evaluate("HoanVi(" & XacXuat & ",'[" & _
                        .Parent.Parent.Name & "]" & _
                        .Parent.Name & "'!" & _
                        .Offset(1).Address(0, 0) & "," & _
                                     """" & ParamA & """," & _
                                     """" & ParamB & """," & _
                                     """" & T & """)")
    End With

End Function


Private Sub HoanVi(Optional ByVal XacXuat% = 70, _
                   Optional ByVal RangeResult As Range, _
                   Optional ByVal ParamA$ = 1, _
                   Optional ByVal ParamB$ = 2, _
                   Optional ByVal tParamA$)
  Dim i%, temp%, S$
  ReDim arr(1 To 99, 1 To 1)
  Randomize
  XacXuat = XacXuat + IIf(tParamA = ParamA, -1, 0)
  For i = 1 To 99
    If i <= XacXuat Then GoSub Slot: arr(temp, 1) = ParamA
    If arr(i, 1) <> ParamA Then arr(i, 1) = ParamB
  Next
  RangeResult(1, 1).Resize(99, 1) = arr
Exit Sub
Slot:
  temp = Int(Rnd() * 99) + 1
  If VBA.Strings.InStr(S, "<" & CStr(temp) & ">") Then GoSub Slot
  S = S & "<" & CStr(temp) & ">"
Return
End Sub

VetMini · 26/12/19

HeSanbi đã viết:
Code không đúng! Tỉ lệ giao động cao nhất có thể khi chạy vòng lặp của xác xuất 30% là 30 + 30 + 30 - 1 = 89 % 89 % của 100 vị trí sẽ đổi còn lại 11% tức là từ vị trí 90 cho đến 100 không bao giờ tồn tại số 2

Mệnh đề được bôi đậm ở trên không đúng.
Tôi chạy thử code này 10 lần. Và có đến 7 lần code dừng trước 1000.
Sub ttt()
For i = 1 To 1000
NgauNhien
If Application.Sum([a90:a100]) > 11 Then Exit For ' có ít nhất 1 vị trí từ a90 đến a100 là số 2
Next i
Debug.Print i
End Sub

Lần cuối của 7 lần trên, code dừng lại ở i = 730, và trị 2 có mặt ở hai ô 91 và 94.

Tuy nhiên, tôi không hề nói code ở bài #7 đúng hay sai. Thứ nhất, tôi có biết yêu cầu của thớt là gì đâu. Và thứ hai, code bài #7 không có chú thích cho biết mục đích của nó.

Hau151978 · 26/12/19

Code bài 7 không hẳn là ngẫu nhiên. Ý tưởng code này là nếu có ít hơn 70 số 1 và 30 số 2 thì số tiếp theo là ngẫu nhiên, nếu đã có 70 số 1 thì tất cả các số còn lại là 2 hoặc nếu đã có 30 số 2 thì các số còn lại chắc chắn = 1. Như vậy thì trong 60 số đầu, khả năng cao là sẽ có 30 số 1, 30 số 2 và trong 40 số sau khả năng cao là toàn số 1.

Bài đã được tự động gộp: 26/12/19

Để tạo hoán vị 70 số 1, 30 số 2 ta có thể viết liên tiếp từ A1 đến A100 các số đó, các ô B1 đến B100 dùng hàm =rand() sau đó sort 2 cột này theo cột B.
Để tạo dãy 100 số 1, 2 có xác suất ra số 1 =70% ta cũng dùng hàm rand() ở cột B như trên, ở cột A gõ công thức A1 =if(B1<0.7,1,2) rồi kéo xuống.

Vô danh Tiểu tốt · 26/12/19

Vấn đề này có vẻ bị máy móc áp dụng lý thuyết xác suất không phù hợp.

Tôi xin đặt lại yêu cầu theo hướng sau.
Cho 100 quả bóng kính thước, khối lượng, chất liệu... giống nhau bỏ chung một thùng. Trong đó có 30 quả đánh số (1) và 70 quả đánh số (2). Lấy ngẫu nhiên mỗi lần một quả và bỏ lần lượt vào các ô đánh số thứ tự tăng dần đến hết. Hãy mô phỏng quá trình trên bằng VBA.

Dựa vào ý tưởng này, chúng ta có rất nhiều cách code và tôi xin đưa ra một cách đơn giản:

Mã:

Sub tfo()
    Dim count As Long, i As Long, j As Long, t(100) As Long

    Randomize
    While count < 100
        If Rnd < 0.3 And i < 30 Then
            i = i + 1
            Range("B" & count + 2) =2
            count = count + 1
        Else
            If j < 70 Then
                j = j + 1
                Range("B" & count + 2) = 1
                count = count + 1
            End If
        End If
    Wend
End Sub

Cái này nhìn sơ sơ có vẻ hổng giống logic mà tôi mô tả cho lắm nhưng hình như vẫn là chính cái tôi đề nghị.

Tuy nhiên tồn tại một rủi ro cực nhỏ với đoạn code này mà bác nào tinh ý sẽ phát hiện ra. Việc sửa lại code khi đó cũng không khó.

HieuCD · 26/12/19

HeSanbi đã viết:

Bạn copy code bên dưới vào một Public Module và gõ vào một ô bất kì:
=FxHoanVi()
Hoặc =FxHoanVi(70, "1", "2")

-------------------

PHP:

Public Function FxHoanVi(Optional ByVal XacXuat% = 70, _
                         Optional ByVal ParamA$ = 1, _
                         Optional ByVal ParamB$ = 2) As String
   On Error Resume Next
   Randomize
   FxHoanVi = IIf(Rnd() <= 0.5, ParamA, ParamB)
   With Application.Caller
    Call Application.Evaluate("HoanVi(" & XacXuat & ",'[" & _
                        .Parent.Parent.Name & "]" & _
                        .Parent.Name & "'!" & _
                        .Offset(1).Address(0, 0) & "," & _
                                     """" & ParamA & """," & _
                                     """" & ParamB & """," & _
                                     """" & T & """)")
    End With

End Function


Private Sub HoanVi(Optional ByVal XacXuat% = 70, _
                   Optional ByVal RangeResult As Range, _
                   Optional ByVal ParamA$ = 1, _
                   Optional ByVal ParamB$ = 2, _
                   Optional ByVal tParamA$)
  Dim i%, temp%, S$
  ReDim arr(1 To 99, 1 To 1)
  Randomize
  XacXuat = XacXuat + IIf(tParamA = ParamA, -1, 0)
  For i = 1 To 99
    If i <= XacXuat Then GoSub Slot: arr(temp, 1) = ParamA
    If arr(i, 1) <> ParamA Then arr(i, 1) = ParamB
  Next
  RangeResult(1, 1).Resize(99, 1) = arr
Exit Sub
Slot:
  temp = Int(Rnd() * 99) + 1
  If VBA.Strings.InStr(S, "<" & CStr(temp) & ">") Then GoSub Slot
  S = S & "<" & CStr(temp) & ">"
Return
End Sub

Dùng hàm tự tạo làm chậm Excel, lại thêm Application.Evaluate... sẽ càng ì ạch
Code ngẫu nhiên 30% là số 2 với số lượng phép thử N (=100)

Mã:

Sub ABC()
  Dim i&, k&, r&, N&, Res(), Arr(1 To 100) As Long
 
  N = 100 'So luong du lieu
  ReDim Res(1 To N, 1 To 1)
  For i = 1 To N
    Res(i, 1) = 1
  Next i
  k = Application.Round(N * 0.3, 0)
  Randomize
  For i = 1 To k
    r = Int(Rnd() * N) + 1
    If Arr(r) = 0 Then Res(r, 1) = 2 Else Res(Arr(r), 1) = 2
    If Arr(N) = 0 Then Arr(r) = N Else Arr(r) = Arr(N)
    N = N - 1
  Next
  Range("A1").Resize(100, 1) = Res
End Sub

Phuocam · 26/12/19

phuocam đã viết:
temp = Int(Rnd() * 2) + 1

Cái này là 50/50, sửa lại thành 30/70:
temp = 1 - (Rnd() > 0.7)

Tạo 1 giá trị với xác suất cho sẵn (1 người xem)

Người dùng đang xem chủ đề này

taquy762

Thành viên mới

VetMini

Đang đi tìm hòn đá

taquy762

Thành viên mới

VetMini

Đang đi tìm hòn đá

taquy762

Thành viên mới

Hau151978

Thành viên tích cực

Phuocam

Thành viên mới

VetMini

Đang đi tìm hòn đá

HieuCD

Chuyên gia GPE

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

VetMini

Đang đi tìm hòn đá

Hau151978

Thành viên tích cực

Vô danh Tiểu tốt

Thành viên tiêu biểu

HieuCD

Chuyên gia GPE

Phuocam

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Sinh nhật lần 19 GPE