(03/01/2020, 09:10)berduş yazdı: 1 - neden r1=4?
2 - diyelim ki farkı bulduk sonuç=8 dağılım orantısal olmadığı için bizde bir sana bir bana bir ona yaptık, yani en büyükten başlayıp en küçüğe 1er 1er dağıtıp tekrar en başa dönüp kalanı yine 1er 1er dağıttık bu doğru dağılım olur mu?
13 --> 2
5 --> 2
4 --> 2
3 --> 1
1 --> 1
gibi
r1=4 olmasının bir anlamı yok. örnekleme yaparken unutulmuş bir sayı.
evet aslında mantık bu şekilde olacak, büyük olan geri kalandan büyük payı alacak.
8 8 6 5 1 =28 28-18=10
3 3 2 1 1 =10
---------------------------------------------------------------------
8 8 6 5 1 =28
3 2 2 2 1 =10 --------------------------------->>>>>>>>>>>>> her ikiside olur. ama 1 daima 1 olmak zorunda...
Peki kalan=0 ise
15 --> ?
0 --> ?
1 --> ?
1 --> ?
1 --> ?
Yada kalan=1 ise
16 --> ?
0 --> ?
1 --> ?
1 --> ?
1 --> ?
Yada 0dan küçükse
Acikcasi dagilimin nasil olmasi gerektigine dair daha ayrintili bilgi verirseniz daha iyi olur.
Değer P=0 ise 0,
P=1 ise 1 olacak.
Ancak diğer dağılımlar çok önemli değil sadece. P değerlerinin büyüklük değerine gore karşı değeri büyük olacak.
Örneğinzdeki gibi KALAN 1 ise bu değeri buyuk olan sayıya verecek. Diğerlerinin değeri 0 olacak
Örneğin
Kalan 2 olsaydı
1 in bir tanesini en buyuk sayıya diğerini herhangi bir sayıya veya Kalan 2 yi en büyük sayıya vermesinin sakıncası yok.
Kısaca 0 olmayan her P değeri için değer vermesinin sakıncası yok.
Kalan 0 veya 18 den kucuk ise hiç R değeri vermeyecek tüm değerler 0 olacak.
Aslında sizin söylediğiniz çok mantıklı geldi bana dolu olan P değerlerine dağıtılacak sayı var ise küçükten başlayarak dağıtması. Ve bunu sayılar büyüdükçe arttırması çok mantıklı geliyor.h
aşağıdaki procedürü forma ekleyip ister butondan ister "Form geçerli olduğunda" olayından çağırabilirsiniz
dilerim işinize yarar
Private Sub Dagilim()
Dim Kalan, x, CtlDeger, Toplam As Integer
Dim MtnDizi, CtlAdi As String
Dim xDizi() As String
Kalan = 0
Toplam = 0
MtnDizi = ""
For x = 1 To 5
Toplam = Toplam + Nz(Controls("P" & x), 0) 'P alanlarındaki değerleri Topla
MtnDizi = MtnDizi & ";P" & x & Nz(Controls("P" & x), 0) 'diziye aktarabilmek için PAlanAdı+değeri
Controls("R" & x) = 0 'Ralanlarının ilk değerini 0 yap
Next x
MtnDizi = Mid(MtnDizi, 2) 'diziye aktarılacak metindeki ilk ";" kaldır
Kalan = Toplam - 18
xDizi = Split(MtnDizi, ";") 'diziye aktar
'hy Dizi_Sırala_______________________________________Küçükten Büyüge
First = LBound(xDizi)
Last = UBound(xDizi)
For i = First To Last - 1
For j = i + 1 To Last
If CInt(Mid(xDizi(i), 3)) > CInt(Mid(xDizi(j), 3)) Then
Temp = xDizi(j)
xDizi(j) = xDizi(i)
xDizi(i) = Temp
End If
Next j
Next i
'hy Dizi_Sırala_______________________________________Bitti
If Kalan < 1 Then Exit Sub
Do While Kalan > 0 'kalan >0 olduğu sürece 1er 1er dağıtmak için
For i = UBound(xDizi) To 0 Step -1 '
CtlAdi = Mid(xDizi(i), 2, 1) 'hangi alan P1 mi p2 mi......
CtlDeger = Mid(xDizi(i), 3) 'dizi değeri
If Kalan = 0 Then Exit For
If CtlDeger > 1 Then 'Px değeri 1 den büyükse
Controls("R" & CtlAdi).Value = Nz(Controls("R" & CtlAdi).Value) + 1 'Rx'e 1 ekle
Kalan = Kalan - 1 'kalanı azalt
End If
If CtlDeger = 1 And Nz(Controls("R" & CtlAdi).Value) = 0 Then 'Px=1 ve Rx=0 ise Rx'e 1 ekle
Controls("R" & CtlAdi).Value = Nz(Controls("R" & CtlAdi).Value) + 1
Kalan = Kalan - 1
End If
Next i
Loop
End Sub