Random numbers not the same

New to FreeBASIC? Post your questions here.
STBasic
Posts: 156
Joined: Feb 17, 2006 11:51
Location: Manchester, England

Random numbers not the same

Could anybody help me with a little problem.

How can i get random numbers that are not same as the last one

Say i have 200 numbers to be randomize but i don't wont the same number to come out twice.

I have tried this with randomize timer but i get the same number twice.

Code: Select all

Dim n as integer
Dim x as integer
Dim a as integer
n=200
Randomize timer
For k=1 to n
a=int(rnd*n/2)
Locate k+1,30
Print a
Next k

I know this looks crude just trying this do not need anything fancy
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Random numbers not the same

Perhaps

Code: Select all

Dim n as integer
Dim x as integer
Dim a as integer
dim lasta as integer
Randomize timer
n=200
lasta=int(rnd*n/2)

For k as long =1 to n
do
a=int(rnd*n/2)
loop until a<>lasta
'Locate k+1,30
Print a;

lasta=a
Next k
print
sleep

counting_pine
Posts: 6172
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Random numbers not the same

How can you print 200 unique numbers between 0 and 99?!

It sounds like possibly what you want is a shuffling algorithm?

Code: Select all

Dim n as integer
Dim x as integer
Dim a as integer
dim k as integer
n=20
dim arr(1 to n) as integer
for k = 1 to n: arr(k) = k: next k

Randomize timer
For k=1 to n
swap arr(k), arr(k + int(rnd * (n-k+1)))
Next k

For k=1 to n
Locate k+1,30
Print arr(k)
Next k
deltarho
Posts: 2003
Joined: Jan 02, 2017 0:34
Location: UK

Re: Random numbers not the same

@dodicat

Your code is only stopping a repeat of the last 'a' and not all the 'a's calculated so far.

@counting_pine

To cover all possible permutations of shuffling 20 elements ( ie 20! ) we need a random number generator with at least 64 seed bits and none of the FB generators have that. PCG32II has 64 seed bits but if we move on to 200 elements then PCG32II will not pass muster either. FB's Mersenne Twister may look good because of its internal state but it is still only seeded with 32 bits. My RndMt, on the other hand, seeds the whole internal state and can cope with 2080 elements. My CMWC4096 can cope with 10,940 elements. For a very large number of elements, the best bet is to use a CPRNG such as CryptoRNDII; albeit not cryptographically safe because future random numbers are taken from a pre-filled buffer.
counting_pine
Posts: 6172
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Random numbers not the same

OK - but it sounds like the aim here isn't to ensure every permutation can be returned, only to ensure that what's returned is a valid permutation.
(I could be wrong about this though, it depends on how you interpret the question.)
xlucas
Posts: 268
Joined: May 09, 2014 21:19
Location: Argentina

Re: Random numbers not the same

So... you have k numbers (in your example, k = 200) and on each of n iterations, you want one of those numbers, so that the same number won't come up again.

If k is always going to be 200, which is not big, then I think what counting_pine suggested is the best approach. Also, as deltarho said, if you were to require that all permutations be possible, you'd need something better than RND.

Now, to be precise, shuffling would be for the case in which n = k, but as long as n <= k, you can do something similar, like this:

Code: Select all

Dim As Short i, j, n, k = 200
Dim number(1 To k) As Short, numbers As Short

numbers = k
For i = 1 To k
number(i) = k
Next i

For i = 1 To n
Dim j As Short

r = Int(Rnd * numbers) + 1
Print number(r) '<--- This is your number

'Now remove number from list
For j = r To numbers - 1
number(j) = number(j + 1)
Next j
numbers -= 1
Next i

This will work when k is small. If k is very large, two problems will become important: you'll need a lot of memory and the procedure to remove numbers from the list will be too slow. In those cases, the best you can do (as long as n is not too big) is something like this:

Code: Select all

#define MAXN 1000
Dim printed(1 To MAXN) As Short, prnums As Short = 0
Dim As Short i, j
Dim As Short n = 200
Dim As LongInt k = 150000

For i = 1 To n
Dim r As Short
Dim alreadyprinted As Boolean

Do
r = Int(Rnd * k) + 1
For j = 1 To prnums
If r = printed(j) Then alreadyprinted = True : Exit For
Next j
Loop Until Not alreadyprinted

Print r

'Add r to the list
prnums += 1
printed(prnums) = r
Next i

I can't think of anything better right now. Also notice that, if k is really large, you will absolutely need something better than RND or else some numbers will never come up. And, of course, if both n and k are really big, the cost in time and memory is unescapable.

Another problem with the last algorithm here is that it's skipping items from the RND series. Depending on the method, this might break the even distribution of pseudo-random numbers. In most cases, this won't be a problem, but... it's worth taking into account.

My programming is a little rusty. Haven't done much in a few months. I apologise if there're some bugs there. I think the idea is clear, though.
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Random numbers not the same

Your question I thought was ambiguous, but obviously on a second read I was mistaken.
There are some good 64 bit generators on the forum.
See posts by deltarho
Here is another (not combining two 32 bit generators)

Code: Select all

'any ulongint generator
type Rand
a as ulongint
b as ulongint
c as ulongint
d as ulongint
end type

function ranulong(x as rand) as ulongint
dim e as ulongint = x.a - ((x.b shl 7) or (x.b shr (64 - 7)))
x.a = x.b xor ((x.c shl 13) or (x.c shr (64 - 13)))
x.b = x.c + ((x.d shl 37) or (x.d shr (64 - 37)))
x.c = x.d + e
x.d = e + x.a
return x.d
end function

function randouble(x as rand) as double
return ranulong(x)/18446744073709551615ull
end function

sub init(x as rand, byval seed as ulongint=100)
dim i as ulongint
x=type(4058668781,seed,seed,seed)
for i as ulongint=1 to 20
ranulong(x)
next
end sub

'=========
dim shared as rand z
init(z)
'========

function range overload(f as longint,l as longint) as longint
return (ranulong(z) mod ((l-f)+1)) + f
end function

function range overload(f as ulongint,l as ulongint) as ulongint
return (ranulong(z) mod ((l-f)+1)) + f
end function
print "ulongint range"
for n as ulongint=1 to 10
print range(18446744073709551600ull,18446744073709551615ull)
next
print
print "longint range"
for n as ulongint=1 to 10
print range(-9223372036854775700ll , 9223372036854775700ll)
next
print
print "random ulongint"
for n as ulongint=1 to 10
print ranulong(z)
next
print
init(z)
print "random float"
for n as ulongint=1 to 10
print randouble(z)-randouble(z)
next
print
init(z)
print "random float reset"
for n as ulongint=1 to 10
print randouble(z)-randouble(z)
next
print "Done"

sleep

deltarho
Posts: 2003
Joined: Jan 02, 2017 0:34
Location: UK

Re: Random numbers not the same

I have mentioned this before - a 64 bit generator by Donald Knuth.

Code: Select all

Function GetSeed() As Ulongint
Return (Cast( Ulongint, Rnd*(2^32) ) Shl 32) Or Cast( Ulongint, Rnd*(2^32) )
End Function

Randomize , 5 : GetSeed  ' Cryptographic seed

Dim As Ulong i
Dim As Ulongint Rand
Dim As Double KnuthRnd

Rand = GetSeed
For i = 1 To 20
Rand = 6364136223846793005ull * Rand + 1442695040888963407ull ' Update Rand
KnuthRnd = Rand/2^64 ' Normalize Rand
Print KnuthRnd
Next
Print

' Average in (0,1]
Dim As Double tot
For i = 1 To 1e8
Rand = 6364136223846793005ull * Rand + 1442695040888963407ull
KnuthRnd = Rand/2^64
tot += KnuthRnd
Next
Print tot/1e8

' Speed in MHz
Dim As Double t
t = Timer
For i = 1 To 1e8
Rand = 6364136223846793005ull * Rand + 1442695040888963407ull
KnuthRnd = Rand/2^64
Asm nop
Next
t = Timer - t
Print Int(100/t);"MHz"

Sleep

Typical output on my machine

Code: Select all

0.7546832101270091
0.2257556050896815
0.5019957433491101
0.6845841476166172
0.01846738786594555
0.4315327921131013
0.9344990754593936
0.8256533226510067
0.6113566327198048
0.2886902044251758
0.3521498022153156
0.5588265902448508
0.7608470215521037
0.3485270866212065
0.9322378229490408
0.3168745920926526
0.5081393506738462
0.7008838035189822
0.6987475140215899
0.01220968445364038

0.5000015594802951
564MHz

PractRand is not sympathetic to it, rejecting at 8Kb, noted by the 'Glass is half empty brigade' of which I am a fully paid up member. However, 'Glass is half full brigade' would say that requesting less than 8Kb sees PractRand unable to contradict the null hypothesis that the numbers generated are random and a lot of code on this forum use less than 8KB. FB's Mersenne Twister comes in at 85MHz and is only a 32-bit generator.
counting_pine
Posts: 6172
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Random numbers not the same

@deltarho, with respect: I agree, there are surely cases where it's useful to be able to seed a PRNG with more than 32 bits.
But in this thread, such a function is almost off-topic, and any ideas conveyed here are more easily lost.
deltarho
Posts: 2003
Joined: Jan 02, 2017 0:34
Location: UK

Re: Random numbers not the same

counting_pine wrote:,such a function is almost off-topic,

Agreed. I got side tracked by dodicat's post.
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Random numbers not the same

Bloody heck, we are getting prickly.
if that's the case then all posts would be about three deep.
Anyway my method for filling an array with unique numbers.

Code: Select all

Sub QuickSort(array() As integer,begin As Integer,Finish As integer)
Dim As Integer i=begin,j=finish
Dim As integer x =array(((I+J)\2))
While  I <= J
While array(I) < X
I+=1
Wend
While array(J) > X
J-=1
Wend
If I<=J Then
Swap array(I),array(J)
I+=1
J-=1
End If
Wend
If J > begin Then QuickSort(array(),begin,J)
If I < Finish Then QuickSort(array(),I,Finish)
End Sub

function checkarray(a() as integer) as boolean
quicksort(a(),lbound(a),ubound(a))
for n as long=lbound(a) to ubound(a)-1
if a(n)=a(n+1) then return 0
next
return 1
end function

Sub shuffle(a() As integer)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
For n As Integer = lbound(a) To ubound(a)-1
Swap a(n), a(range(n,ubound(a)))
Next n
End Sub

dim as integer p(1 to 100000)
var k=150000
var max=1000

for n as long=lbound(p) to ubound(p) 'create a random array
p(n)=Int(Rnd * k) + 1
next

quicksort(p(),lbound(p),ubound(p)) 'put into ascending order

redim as integer q(lbound(p) to ubound(p))'create a new array

dim as integer counter
for n as long=lbound(p) to ubound(p)-1
if p(n)<>p(n+1) then counter+=1: q(counter)=p(n)'fill with unique numbers
next n

redim preserve q(1 to counter) 'or 1 to your required size

print checkarray(q()) 'should always be true

shuffle(q()) 'a good mix up

for n as long=lbound(q) to lbound(q) + 100
print q(n);
next n

print "  ...  "
print
print "Number of repeats found (and cleared)  in ";ubound(p);"  was   ";ubound(p)-ubound(q)
sleep

STBasic
Posts: 156
Joined: Feb 17, 2006 11:51
Location: Manchester, England

Re: Random numbers not the same

Hi Thanks for the help.

As said in one post I would like all the numbers to appear on screen.

ideally split in two, so half on part of the screen and the second half on other side of the screen
counting_pine
Posts: 6172
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Random numbers not the same

Hi STBasic, is this closer to what you want? It shuffles the numbers and prints them in two columns:

Code: Select all

Dim x as integer, a as integer, k as integer
Const n=20
dim arr(1 to n) as integer
for k = 1 to n: arr(k) = k: next k

Randomize
For k=1 to n
swap arr(k), arr(k + int(rnd * (n-k+1)))
Next k

For k=1 to n
Print arr(k);
if k mod 2 = 1 then print tab(30); else print
Next k
deltarho
Posts: 2003
Joined: Jan 02, 2017 0:34
Location: UK

Re: Random numbers not the same

I am looking at

Code: Select all

For k=1 to n
Swap arr(k), arr(k + Int(Rnd * (n-k+1)))
Next k

When k = n we get Swap arr(n), Swap arr(n)

This is not problematic and will have no noticeable impact on performance but, nonetheless, we are doing something when there is no need.

So the For loop should be to n-1 and not n.

However, when Rnd = 0 we get Swap arr(k), Swap arr(k) for all k. Rnd = 0 will be very rare, over four billion to one against, but when true we do not get a full shuffle.

The maximum value of Int(Rnd * (n-k+1))) is n-k giving us Swap arr(k), Swap arr(n) which is OK.

Starting from scratch.

With the Knuth Shuffle we Swap arr(1) with arr(2) to arr(n)
We Swap arr(2) with arr(3) to arr(n).
We Swap arr(3) with arr(4) to arr(n).
and so on.
Finally, we Swap arr(n-1) with arr(n)

That translates to

Swap arr(k), arr(k + 1 + Int(Rnd * (n-k))

When Rnd = 0 we get Swap arr(k), Swap arr(k+1)

The maximum value of Int(Rnd * (n-k)) is n-k-1 giving us Swap arr(k), Swap arr(n) which is OK.

So, it seems that the only real issue with the original code is when Rnd = 0. We get what the opening post wants so the question is "Am I being pedantic". Well, yes, but another application using a Knuth Shuffle may rely on no element not being shuffled.

BTW, if we correct the Swap statement but allow the For loop to go to n we are in trouble - Swap arr(n), Swap arr(n+1)!

Added: I should have finished with the revised code.

Code: Select all

For k = 1 to n - 1
Swap arr(k), arr(k + 1 + Int(Rnd * (n-k)))
Next k
dodicat
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Random numbers not the same

I can modularize my method.

Code: Select all

Sub QuickSort(array() As Integer,begin As Integer,Finish As Integer)
Dim As Integer i=begin,j=finish
Dim As Integer x =array(((I+J)\2))
While  I <= J
While array(I) < X
I+=1
Wend
While array(J) > X
J-=1
Wend
If I<=J Then
Swap array(I),array(J)
I+=1
J-=1
End If
Wend
If J > begin Then QuickSort(array(),begin,J)
If I < Finish Then QuickSort(array(),I,Finish)
End Sub

Function checkarray(a() As Integer) As boolean
quicksort(a(),Lbound(a),Ubound(a))
For n As Long=Lbound(a) To Ubound(a)-1
If a(n)=a(n+1) Then Return 0
Next
Return 1
End Function

Sub shuffle(a() As Integer)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
For n As Integer = Lbound(a) To Ubound(a)-1
Swap a(n), a(range(n,Ubound(a)))
Next n
End Sub

Sub fillarray(p() As Integer,arraysize As Integer,maxvalue As Integer)
Redim p(1 To arraysize)
For n As Long=Lbound(p) To Ubound(p) 'create a random array
p(n)=Int(Rnd * maxvalue) + 1
Next
End Sub

Sub setuniquearray(p() As Integer,Byref maxsize As Integer)
quicksort(p(),Lbound(p),Ubound(p)) 'put into ascending order
Redim As Integer q(Lbound(p) To Ubound(p))'create a new array
Dim As Integer counter
For n As Long=Lbound(p) To Ubound(p)-1
If p(n)<>p(n+1) Then counter+=1: q(counter)=p(n)'fill with unique numbers
Next n
Redim Preserve q(1 To counter)'resize q to significant elements
Print checkarray(q())
If counter<maxsize Then maxsize=counter
Print "arraysize  ";maxsize
shuffle(q())
Redim Preserve q(1 To maxsize)
Redim p(1 To maxsize)
For n As Long=1 To maxsize
p(n)=q(n)
Next
Erase q
End Sub

'===============================
const initialarraysize=100000  'big enough for purpose I reckon.
Var maxvalue=150000  'the bigger this number the higher the average, each number < than maxvalue
Var maxnumber=200    'array size required (even number)
dim as integer max= maxnumber 'take a copy
redim as integer q()

fillarray(q(),initialarraysize,maxvalue)
setuniquearray(q(),maxnumber)

Dim As Integer half=maxnumber\2

For n As Long=Lbound(q) To half
Print n;":",  q(n),,,,q(n+half)
Next n

if max<>maxnumber then print "wanted "; max;"  got  ";maxnumber

Sleep