RealRand

I made this, because i thought i got better random numbers than ran, and dont say its not really random, because i know that :wave:

VB Code:

Private Declare Function GetTickCount& Lib "kernel32" ()
 
Private Sub Command1_Click()
   Call RealRand(1, 5000) 'change to lowerbound,upperbound
End Sub
 
Private Function RealRand(Lowb As Integer, upb As Integer)
Randomize
Dim t As Long
Dim p As Integer
t = GetTickCount
   Do Until t >= Lowb And t <= upb
   t = t / (Rnd * 100)
   DoEvents
     '  t = t / Int(upb - Lowb) * Rnd
        If t < Lowb Then
              t = upb * Rnd
        End If
   Loop
                MsgBox t
End Function

tell me if its better or worse or wahtever

Looks better to me :)

I'll be using this one from now on.

There is a test for randomness, in Liberty BASIC we would have a graphic box and then plot the points - the one that looked the most spread out was the most random :)
Can you do a test like that in VB?

Cheers,

RyanJ

hmm..is there a graph control in vb?

And heres another way, without API

VB Code:

Private Sub Command1_Click()
   Call RealRand(1, 5) 'change to lowerbound,upperbound
End Sub
 
Private Function RealRand(Lowb As Integer, upb As Integer)
Randomize
Dim t As String
t = Replace(Time, "PM", vbNullString)
t = Replace(t, "AM", vbNullString)
t = Replace(t, ":", vbNullString)
t = t * t * Rnd
   Do Until t >= Lowb And t <= upb
   t = t / (Rnd * 100)
         DoEvents
   If t < Lowb Then t = upb * Rnd
   Loop
                MsgBox CInt(t)
End Function

Quote:

---

Originally Posted by |2eM!x

hmm..is there a graph control in vb?

---

Nope, it was not a graph control, LB does not support controls in the way VB does :)

It was basically like the picture box - Hang on I'll see if I can compile it and upload it to my website :)

Edit: Here you go: http://allfreesoftware.helphousehost...nd_Example.zip

Cheers,

RyanJ

i almost had it with mschart, but i have to go to work now so...not happening

I did a test, and I found that Rnd (the original is better)

The test code:

VB Code:

Private Declare Function GetTickCount& Lib "kernel32" ()
 
Private Function RealRand(Lowb As Integer, upb As Integer) As Long
    Dim T As Long
    Dim P As Integer, Q As Single
    
    Randomize
    T = GetTickCount
    
    Do Until T >= Lowb And T <= upb
        Q = (Rnd * 100) + 1
        T = T / Q
        DoEvents
        '  T = T / Int(upb - Lowb) * Rnd
        
        If T < Lowb Then
            T = upb * Rnd
        End If
    Loop
    
    RealRand = T
End Function
 
Private Sub Form_Load()
    Dim Arr(500) As Byte, K As Long, Q As Long
    
    Me.ScaleMode = vbPixels
    
    Picture1.ScaleMode = vbPixels
    Picture1.Width = 500
    Picture1.Height = 125
    Picture1.AutoRedraw = True
    
    Show
    DoEvents
    
    Do
        ' Get random value
        
        'K = RealRand(0, 500)
        K = Fix(500 * Rnd)
        
        ' Increment color
        Arr(K) = Arr(K) + 1
        
        ' draw line
        Picture1.Line (K, 0)-(K, Picture1.ScaleHeight), RGB(Arr(K), Arr(K), Arr(K))
        
        ' Finish if reached 255
        If Arr(K) = 255 Then Exit Do
        
        Q = Q + 1
        If (Q Mod 10) = 0 Then Picture1.Refresh
    Loop
    
    For K = 0 To 500
        Picture1.Line (K, 0)-(K, Picture1.ScaleHeight), RGB(Arr(K), Arr(K), Arr(K))
    Next K
    Picture1.Refresh
    
    MsgBox "Done !"
End Sub

The black color means we never got that number, and white color it means we got that number many times.

With ReadRnd:
http://www.vbforums.com/attachment.p...chmentid=37268

And with VB's Rnd:
http://www.vbforums.com/attachment.p...chmentid=37269

Seems that VB's Rnd is a lot more even...

cool! ill work on a better one soon enough :D

Quote:

---

Originally Posted by |2eM!x

cool! ill work on a better one soon enough :D

---

I will work on a better one too :) but after work, cuz it will take some time to make it...

To give you a hint on how i'll do it: You need to keep track of the random numbers you had (with a bolean array).
Whenever you get a number, mark the item in the array as "True", and if it's already True, then find another Rnd number that is False.
When all of them are True, reset them.

I'm gonna make a class that will do this.

we've been doing some neat stuff in this codebank havent we :p

i really like making these functions and junk!

ill work on mine later tonight/tommorrow (got finals to take!)

VB Code:

Option Explicit
Private Declare Function GetTickCount& Lib "kernel32" ()
 
Private Sub Command1_Click()
Call RealRand(1, 500)
End Sub
 
Private Function RealRand(Lowerbound As Integer, Upperbound As Integer)
Dim t As Long
    t = GetTickCount * Rnd ^ 10 / 100
        Do Until (t >= Lowerbound) And (t <= Upperbound)
            t = t * Rnd
            If t < Lowerbound Then t = t / Rnd: If t = 0 Then t = GetTickCount
        Loop
        MsgBox t
End Function

is that better? also, if you have an array with all the numbers used already, is that really random :D

VB Code:

Private Declare Function GetTickCount& Lib "kernel32" ()
 
Private Function RealRand(Lowerbound As Integer, Upperbound As Integer)
Dim t As Long
    t = GetTickCount * Rnd ^ 10 / 100
        Do Until (t >= Lowerbound) And (t <= Upperbound)
            t = t * Rnd
            If t < Lowerbound Then t = t / Rnd: If t = 0 Then t = GetTickCount
        Loop
Picture2.Line (t, 0)-(t, Picture2.ScaleHeight), RGB((t), (t), (t))
Picture2.Refresh
End Function
 
Private Sub Form_Load()
    Dim Arr(500) As Byte, K As Long, Q As Long
        Me.ScaleMode = vbPixels
    
    Picture1.ScaleMode = vbPixels
    Picture1.Width = 500
    Picture1.Height = 125
    Picture1.AutoRedraw = True
     Picture2.ScaleMode = vbPixels
    Picture2.Width = 500
    Picture2.Height = 125
    Picture2.AutoRedraw = True
        Show
    DoEvents
        Do
        ' Get random value
                'K = RealRand(0, 500)
        K = Fix(Rnd * 500)
        
        ' Increment color
        Arr(K) = Arr(K) + 1
        
        ' draw line
        Picture1.Line (K, 0)-(K, Picture1.ScaleHeight), RGB(Arr(K), Arr(K), Arr(K))
        
        ' Finish if reached 255
        If Arr(K) = 255 Then Exit Do
                Q = Q + 1
        If (Q Mod 10) = 0 Then Picture1.Refresh
    Loop
        For K = 0 To 500
        Call RealRand(0, 500)
    Next K
    Picture1.Refresh
    
    MsgBox "Done !"
End Sub

im using that to draw the fancy pictures, and im getting closer :)

OK, here it is...

The class (Also attached):

VB Code:

Option Explicit
 
Private Declare Function GetTickCount& Lib "kernel32" ()
 
Private RndArr() As Integer, RndMax As Long, LOVal As Long
Private RndCount As Long, CurrStep As Byte, MaxStep As Integer
 
Public Sub Init(ByVal LOBound As Long, ByVal HIBound As Long, Optional ByVal MaximumStep As Integer = 1)
    LOVal = LOBound
    RndMax = HIBound - LOBound
    
    ReDim RndArr(RndMax - 1)
    CurrStep = 1
    MaxStep = MaximumStep
    
    If MaxStep <= 0 Then MaxStep = 1
    
    Randomize
    Randomize GetTickCount * Rnd
End Sub
 
Public Function GetNextRndVal() As Long
    Dim RndVal As Long, K As Long
    
    Do
        RndVal = Fix(RndMax * Rnd)
    Loop Until RndArr(RndVal) < MaxStep
    
    RndArr(RndVal) = RndArr(RndVal) + 1
    RndCount = RndCount + 1
    
    If RndCount >= RndMax * MaxStep Then
        For K = 0 To UBound(RndArr)
            RndArr(K) = 0
        Next K
        
        RndCount = 0
        CurrStep = 1
    End If
    
    GetNextRndVal = LOVal + RndVal
End Function

And teh test:

VB Code:

Option Explicit
 
Private Sub Form_Load()
    Dim Arr(500) As Byte, K As Long, Q As Long
    Dim EvenRnd As New clsEvenRnd
    
    EvenRnd.Init 0, 500, 1
    
    Me.ScaleMode = vbPixels
    
    Picture1.ScaleMode = vbPixels
    Picture1.Width = 500
    Picture1.Height = 125
    Picture1.AutoRedraw = True
    
    Show
    DoEvents
    
    Do
        ' Get random value
        
        'K = RealRand(0, 500)
        'K = Fix(500 * Rnd)
        K = EvenRnd.GetNextRndVal
        
        ' Increment color
        Arr(K) = Arr(K) + 1
        
        ' draw line
        Picture1.Line (K, 0)-(K, Picture1.ScaleHeight), RGB(Arr(K), Arr(K), Arr(K))
        
        ' Finish if reached 255
        If Arr(K) = 255 Then Exit Do
        
        Q = Q + 1
        If (Q Mod 10) = 0 Then Picture1.Refresh
    Loop
    
    For K = 0 To 500
        Picture1.Line (K, 0)-(K, Picture1.ScaleHeight), RGB(Arr(K), Arr(K), Arr(K))
    Next K
    Picture1.Refresh
    
    MsgBox "Done !"
End Sub

The thing that makes a the bigest diference on numbers generated depends on the MaximumStep in the Init sub.

For example when it's 1, like this:
EvenRnd.Init 0, 500, 1

It means that it will return random number between 0 and 500 and NONE of them repeat until all 500 are returned, then it repeates the whole process again.

If it's like this (for eample):
EvenRnd.Init 0, 500, 2
It means that after the same nuber is returned 2 times it won't be returned again until after 1000 numbers are returned. For example you may get the same number 2 times in a row, but you won't get the numbers again until all other numbers are taken also (all others are returned 2 tiems also).

The greater the MaximumStep is, the closer you get to the VB's Rnd

I can't think of a better explanation to give, but if you try the code, and play with the numbers, I'm sure you will understand.

Actually I think best way to understand it is to try with small ranges like:
EvenRnd.Init 0, 4, 1
Then try
EvenRnd.Init 0, 4, 2
Then
EvenRnd.Init 0, 4, 3

Return ~10 numbers for each

And see the numbers you get, I'm sure you will understand it that way.

great job! i wish i could rate you, but alas your other projects have taken that spot up :p