I have not fully examined the principle because I have no need of it.srvaldez wrote:regarding the jump subs, I guess that you would only call it once or occasionally and thereafter just call next?
Oh no, not another PRNG
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
I am glad you mentioned that.srvaldez wrote:there's a small penalty for overloading
I looked at the speed of range and found that the discrete version was coming in at 90MHz compared with the continuous version coming in at 310MHz.
dodicat's method was found to be very fast compared with traditional code for a range when he introduced it. It seems that MOD is very slow when applied to 64 bits. The bottom 32 bits of 'result' should be random, so I replaced 'result' with 'Culng(result)' and got 310MHz. That is marginally faster than PCG32II in 32-bit mode and much faster in 64-bit mode. Since the discrete version is Long we didn't need 64-bit anyway.
I have edited the xoroshiro128.bas code and mentioned that an edit has occurred.
Overall the speed of xoroshiro128** in 64-bit mode is quite astonishing.
Re: Oh no, not another PRNG
one could probably reduce practrand time using a smaller literal. thanks for sharing the new generator
Code: Select all
type mylit as ushort
const bit_size = len(mylit) * 8
#undef int
#define int as integer
#define func function
#define ret return
func rotl(in as mylit, amount int) as mylit
ret in shl amount or in shr (bit_size - amount)
End Func
func mul_conv(m int) int
ret (bit_size * m + 32) \ 64 '' add "0.5" then truncate divide (FB)
end func
func x128xx as mylit
static As mylit s0, s1, result
static as mylit s(1) = {1,10} '' seed
s0 = s(0)
s1 = s(1)
result = rotl(s0 * mul_conv(5), mul_conv(7)) * mul_conv(9)
s1 xor= s0
s(0) = rotl(s0, mul_conv(24)) xor s1 xor (s1 shl mul_conv(16)) ' a, b
s(1) = rotl(s1, mul_conv(37)) ' c
ret result
end func
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
@dafhi
What has PractRand time got to do with your code?
Why do you rewrite FB's syntax so much, your code becomes unreadable?
I fail to see the point of your code other than to obfuscate the fact that it isn't doing anything that using FB's syntax would do.
What has PractRand time got to do with your code?
Why do you rewrite FB's syntax so much, your code becomes unreadable?
I fail to see the point of your code other than to obfuscate the fact that it isn't doing anything that using FB's syntax would do.
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
Looking at the code further the engine, x128xx, which should run quickly calls rotl three times. rotl has an overhead - a rotl definition does not!
Re: Oh no, not another PRNG
I inlined rotl and the compile time took about 5 times longer, have not bench it to see if it's worth it
Re: Oh no, not another PRNG
I have fixed my tetris so box 1 is always a vertical row.
This gives an even start for tests.
The random numbers to fill the tetris, if a bit skew, seems to work well.
So I start with a simple skew generator.(line 119)
I also have deltarho[]'s generator in place, you can test it, just un comment the approprtiate #defines, and comment my generator out.
The range function is always called Irange()
I define a resetseed so different box numbers start from the same seed position, but this is not important, it can be defined blank for other generators.
I have been timing 8 box fills.
My little skew generator takes about 10 seconds (-O3).
You can test any generator, if it is half decent it will plod through 8 boxes, it might take a couple of minutes, but it should get through them.
This gives an even start for tests.
The random numbers to fill the tetris, if a bit skew, seems to work well.
So I start with a simple skew generator.(line 119)
I also have deltarho[]'s generator in place, you can test it, just un comment the approprtiate #defines, and comment my generator out.
The range function is always called Irange()
I define a resetseed so different box numbers start from the same seed position, but this is not important, it can be defined blank for other generators.
I have been timing 8 box fills.
My little skew generator takes about 10 seconds (-O3).
You can test any generator, if it is half decent it will plod through 8 boxes, it might take a couple of minutes, but it should get through them.
Code: Select all
#include "fbgfx.bi"
/'
static inline uint64_t rotl(const uint64_t x, int k) {
return (x << k) | (x >> (64 - k));
}
static uint64_t s[2];
uint64_t next(void) {
const uint64_t s0 = s[0];
uint64_t s1 = s[1];
const uint64_t result = rotl(s0 * 5, 7) * 9;
s1 ^= s0;
s[0] = rotl(s0, 24) ^ s1 ^ (s1 << 16); // a, b
s[1] = rotl(s1, 37); // c
return result;
}
'/
#define Make64Bit ( Cast( Ulongint, Rnd*(2^32) ) Shl 32) Or Cast( Ulongint, Rnd*(2^32) )
#define rotl(x,k) ( (x Shl k) Or (x Shr(64-k)) ) ' Note the extra parentheses
#macro Engine
s0 = This.s(0)
s1 = This.s(1)
result = rotl(s0*5, 7)*9
s1 Xor= s0
This.s(0) = rotl(s0,24) Xor s1 Xor (s1 shl 16)
This.s(1) = rotl(s1,37)
#endmacro
' Generator is Sebastian Vigna's xoroshiro128**
Type xoroshiro128
Public:
Declare Constructor
Declare Sub MyRandomize( seed as string )
Declare Function rand() As Ulongint
Declare Function randD() As Double
Declare Function range overload( Byval One As Long, Byval Two As Long ) As Long
Declare Function range overload ( byval One as double, Byval Two as double ) as double
Declare Sub GetSnapshot()
Declare Sub SetSnapshot()
Private:
As Ulongint s(0 To 1)
As Ulongint snapshot(0 to 1)
End Type
Private Function Get64Bit() As Ulongint
Dim As Ulongint dummy = Make64Bit
Return rotl(dummy, 16)
End Function
Private Sub xoroshiro128.MyRandomize( seed as string )
Dim As Ulong i
' If seed = "" then use cryptographic random numbers else use Mersenne Twister
If seed = "" Then Randomize , 5 Else Randomize Val(seed), 3
This.s(0) = Get64Bit
This.s(1) = Get64Bit
' Warm up generator - essential
For i = 1 To 8192
this.rand()
Next i
End Sub
Private Function xoroshiro128.rand() As ulongint
Dim As Ulongint s0, s1, result
Engine
Return result
End Function
Private Function xoroshiro128.randD() As Double
Dim As ulongint s0, s1, result
Engine
Return result/2^64
End Function
Private Function xoroshiro128.range( Byval One As Long, Byval Two As Long ) As Long
Dim As ulongint s0, s1, result
Engine
Return Clng(result Mod ( Two-One+1 )) + One ' By dodicat
End Function
Private Function xoroshiro128.range( Byval One As Double, Byval Two As Double ) As Double
Dim As Ulongint s0, s1, result
Engine
Return result/2^64*( Two - One ) + One
End Function
Private Sub xoroshiro128.GetSnapshot()
This.snapshot(0) = This.s(0)
This.snapshot(1) = This.s(1)
End Sub
Private Sub xoroshiro128.SetSnapshot()
This.s(0) = This.snapshot(0)
This.s(1) = This.snapshot(1)
End Sub
Constructor xoroshiro128
This.MyRandomize( "" )
This.GetSnapshot
End Constructor
Dim Shared As xoroshiro128 x128
'#undef Rnd
'#define Rnd x128.randD
'my own generater (skew)
'======================
#include "crt.bi"
#define resetseed randomize 0,1
#define _r_(l,f) Rnd*(l-f)+f
#define rnd2 log10(_r_(1,9.99999999999999))
#define Irange(f,l) Int(Rnd2*(((l)+1)-(f)))+(f)
'========================
'#define Irange(f,l) Int(Rnd*(((l)+1)-(f)))+(f)
'#define Irange x128.range
resetseed
Dim Shared As Long num '3 to 8 tested only
Dim Shared As Long sz
Dim Shared As Long max
Sub sizer
Select Case num
Case 8:sz=4:max=704
Case 7:sz=8:max=196
Case 6:sz=17:max=60
Case 5:sz=33:max=18
Case 4:sz=55:max=7
Case 3:sz=60:max=2
End Select
End Sub
Redim Shared As Long a(0)
Type Tab
As Long x,y,w,h
As zString * 100 caption
Declare Sub Draw(As Ulong,As Ulong)
Declare Function in(As Long,As Long) As Long
Declare Sub click()
End Type
Sub tab.click
Dim As fb.event e
Do
e.type=0
If Screenevent(@e) Then
If e.type=fb.EVENT_MOUSE_DOUBLE_CLICK Then Exit Do
End If
Sleep 1
Loop
End Sub
Type ltab
As Tab m 'main uppermost
As Tab t(Any) 'the sub tabs
As Long exflag 'expand flag
As Long subflag(Any) 'do something at each sub tab
Declare Sub expand() 'drop the sub tabs
Declare Sub checkmouse(As Long,As Long,As Long)'contract the sub tabs when not in use
Declare Sub freetabs() 'hide the tabs
End Type
Sub tab.draw(bc As Ulong,ic As Ulong)'bc border colour, ic fill colour
Line(x,y)-(x+w,y+h),ic,bf
Line(x,y)-(x+w,y+h),bc,b
Var L=Len(caption)*8
Var spx=(x+w/2-L/2),spy=(y+h/2-4)
..draw String(spx,spy),caption,0
End Sub
Sub ltab.expand 'drop the sub tabs
For z As Long=Lbound(t) To Ubound(t)
t(z).draw(4,7)
Next
End Sub
Function tab.in(mx As Long,my As Long) As Long 'Is mouse in a tab?
Return mx>=x And mx<=x+w And my>=y And my<=y+h
End Function
Sub ltab.checkmouse(mx As Long,my As Long,mb As Long=0)'Free the sub tabs when clear
If this.m.in(mx,my) Then exflag=1:Return
For z As Long=Lbound(t) To Ubound(t)
If this.t(z).in(mx,my) Then exflag=1:Return
Next z
exflag=0
End Sub
Sub ltab.freetabs()'hide the sub tabs
exflag=0
End Sub
Type box
As Long x,y
As Long w
As Long done
End Type
Type pattern
As box p(1 To num)
Declare Sub Draw(As Long,As Long)
End Type
Sub pattern.draw(xp As Long,yp As Long)
For n As Long=1 To num
Line(p(n).x+xp,p(n).y+yp)-(p(n).x+xp+p(n).w,p(n).y+yp+p(n).w),5,bf
Line(p(n).x+xp,p(n).y+yp)-(p(n).x+xp+p(n).w,p(n).y+yp+p(n).w),2,b
Next n
End Sub
Function overlaps(p As pattern) As Long
For n1 As Long=1 To num-1
For n2 As Long=n1+1 To num
If n1<>n2 Then
If p.p(n1).x= p.p(n2).x And p.p(n1).y= p.p(n2).y Then Return 1
End If
Next n2
Next n1
Return 0
End Function
Function closest(pts() As box,n As Long) As Long
#define inside(x) x>=Lbound(pts) And x<= Ubound(pts)
If inside((n+num)) Then
If pts(n+num).done=0 Then
Redim Preserve a(1 To Ubound(a)+1)
a(Ubound(a))=n+num
End If
End If
If inside((n+1)) Then
If pts(n+1).done=0 Then
If (n) Mod num <> 0 Then
Redim Preserve a(1 To Ubound(a)+1)
a(Ubound(a))=n+1
End If
End If
End If
If inside((n-num)) Then
If pts(n-num).done=0 Then
Redim Preserve a(1 To Ubound(a)+1)
a(Ubound(a))=n-num
End If
End If
If inside((n-1)) Then
If pts(n-1).done=0 Then
If (n) Mod (num) <>1 Then
Redim Preserve a(1 To Ubound(a)+1)
a(Ubound(a))=n-1
End If
End If
End If
Var j=Irange(1,Ubound(a))
Return a(j)
End Function
Sub CreateGrid(b() As box)
Redim b(1 To num*num)
Dim As Long ctr,kx,ky
For x As Long=1 To num
kx=x*sz
For y As Long=1 To num
ky=y*sz
ctr+=1
b(ctr)=Type(kx,ky,sz)
Next y
Next x
End Sub
Sub settopleft(p As pattern)
Dim As Long x=900,y=900
For n As Long=1 To num
If x>p.p(n).x Then x=p.p(n).x
If y>p.p(n).y Then y=p.p(n).y
Next n
For n As Long=1 To num
p.p(n).x-=x
p.p(n).y-=y
Next n
End Sub
Function flipover(p As pattern,flag As String="") As pattern
Dim As pattern ret=p
For n As Long=1 To num
If flag="" Then
ret.p(n).x=-p.p(n).x
ret.p(n).y=-p.p(n).y
End If
If flag="x" Then ret.p(n).x=-p.p(n).x 'unused
If flag="y" Then ret.p(n).y=-p.p(n).y 'unused
Next n
settopleft(ret)
Return ret
End Function
Sub inverse(p As pattern)
#macro rot1(pivotx,pivoty,px,py,a)
rotx=-a*(py-pivoty)+pivotx
roty=a*(px-pivotx)+pivoty
#endmacro
Var m=num\2
Dim As Long px=p.p(m).x,py=p.p(m).y,rotx,roty
Dim As Long f=p.p(1).y,n,test 'make vert horiz
For n = 2 To num
If p.p(n).y<>f Then Exit For
Next n
If n>num Then
For n As Long=1 To num
rot1(px,py,p.p(n).x,p.p(n).y,-1)
p.p(n).x=rotx
p.p(n).y=roty
Next n
settopleft(p)
End If
End Sub
Function IsUnique(pt() As pattern,p As pattern) As Long
#macro rot1(pivotx,pivoty,px,py,a)
rotx=-a*(py-pivoty)+pivotx
roty=a*(px-pivotx)+pivoty
#endmacro
Dim As Long test
#macro gettest(x1,x2)
test=0
For n1 As Long=1 To num
For n2 As Long=1 To num
If x1.p(n1).x=x2.p(n2).x And x1.p(n1).y=x2.p(n2).y Then test+=1
Next n2
Next n1
#endmacro
For n As Long=1 To Ubound(pt)
gettest(pt(n),p)
If test =num Then Return 0
Next n
'sort out the flippers e.t.c.
test=0
Dim As pattern rot
Var m=num\2
Dim As Long px=p.p(m).x,py=p.p(m).y,rotx,roty
For n As Long=1 To num
rot1(px,py,p.p(n).x,p.p(n).y,1)
rot.p(n).x=rotx:rot.p(n).y=roty
Next n
settopleft(rot)
test=0
For n As Long=1 To Ubound(pt)
gettest(pt(n),rot)
If test =num Then Return 0
Next n
For n As Long=1 To num
rot1(px,py,p.p(n).x,p.p(n).y,-1)
rot.p(n).x=rotx:rot.p(n).y=roty
Next n
settopleft(rot)
test=0
For n As Long=1 To Ubound(pt)
gettest(pt(n),rot)
If test =num Then Return 0
Next n
rot=flipover(p,"")
test=0
For n As Long=1 To Ubound(pt)
gettest(pt(n),rot)
If test =num Then Return 0
Next n
#macro invert
Dim As Long f=p.p(1).y,n 'make horiz vert optional
For n = 2 To num
If p.p(n).y<>f Then Exit For
Next n
If n>num Then
For n As Long=1 To num
rot1(px,py,p.p(n).x,p.p(n).y,-1)
p.p(n).x=rotx
p.p(n).y=roty
Next n
settopleft(p)
test=0
For n As Long=1 To Ubound(pt)
gettest(pt(n),rot)
If test =num Then Return 0
Next n
End If
#endmacro
'invert optional
Return 1
End Function
Sub drawpatterns(pt() As pattern)
Dim As Integer xres,yres
Screeninfo xres,yres
Dim As Long count
For x As Long=0 To xres-sz*num Step sz*num
For y As Long=0 To yres-sz*num Step sz*num
count+=1
If count>Ubound(pt) Then Exit For,For
pt(count).draw(x,y)
Line (x,y) -(x+num*sz,y+num*sz),15,b
Next
Next
End Sub
Sub setup(b() As box,pt() As pattern)
dim as double t=timer
Redim As box b(1 To num*num)
CreateGrid(b())
Dim As Long n,i,z,tot
Dim As Long x,y
Dim As pattern temp
Redim pt(1 To 1)
dim as long lastubound
dim as pattern start
for n as long=1 to num
start.p(n)=b(n)
next n
Do
tot+=1
n=Irange(1,(num*num))
Do
z+=1
If z=1 Then i=n Else i=closest(b(),n)
If tot=1 Then
pt(1)=start
exit do
'pt(1).p(z)=b(i)
Else
temp.p(z)=b(i)
end if
b(i).done=1
n=i
Loop Until z=num
If tot=1 Then
settopleft(pt(1))
'inverse(pt(1)) ''optional
End If
If tot>1 Then
settopleft(temp)
If IsUnique(pt(),temp) And overlaps(temp)=0 Then
Redim Preserve pt(1 To Ubound(pt)+1)
pt(Ubound(pt))=temp
End If
End If
For k As Long=1 To Ubound(b)
b(k).done=0
Next k
z=0
Redim a(0)
Var _div=2
If num=3 Then _div=num*num
'If tot Mod num*num\_div=0 Then drawpatterns(pt())
if ubound(pt)<>lastubound then drawpatterns(pt())
Locate 35,120
lastubound=ubound(pt)
Print "results "
Locate 37,120
Print Ubound(pt);"/";str(max)
If Inkey=Chr(27) Then screenunlock:Exit Do
Loop Until Ubound(pt)=max
locate 39,120
print csng(timer-t)
End Sub
Function fbmain() As Long
Redim As box b()
Redim As pattern pt()
Print "Please wait . . ."
Screen 20
Dim As ltab M
'====================== ==============
Redim M.t(1 To 7)
#macro setupmenu()
Redim M.subflag(Lbound(M.t) To Ubound(M.t))
With M
.m.x=1024-100
.m.y=0
.m.w=100
.m.h=25
.m.caption="Menu"
For z As Long=Lbound(M.t) To Ubound(M.t)
With .t(z)
.x=1024-100
.y=25+(z-1)*25
.w=100
.h=25
If z=1 Then .caption="3 Boxes"
If z=2 Then .caption="4 Boxes"
If z=3 Then .caption="5 Boxes"
If z=4 Then .caption="6 Boxes"
If z=5 Then .caption="7 Boxes"
If z=6 Then .caption="8 Boxes"
If z=7 Then .caption="Quit"
End With
Next z
End With
#endmacro
setupmenu()
'=========================================
Dim As Integer mx,my,mb,flag
Dim As String i
Dim As Long fps
Do
i=Inkey
Getmouse mx,my,,mb
screenlock
Cls
' ============== MENU OPERATIONS =====================
Dim As Tab click=Type(950,700,70,40,"ClickX2")
M.m.draw(4,7)
If M.m.in(mx,my) And mb=1 Then M.exflag=1:resetseed
If M.exflag Then M.expand: M.checkmouse(mx,my,mb)
For z As Long=Lbound(M.t) To Ubound(M.t)
If z>Ubound(M.t) Then Exit For
If M.t(z).in(mx,my) And mb=1 And M.exflag And flag=0 Then
flag=1
Select Case z
Case 1
num=3
Cls
M.freetabs()
sizer
Windowtitle str(num)+ " Boxes"
screenunlock
setup(b(),pt())
drawpatterns(pt())
click.draw(15,6)
click.click
screenlock
Case 2
num=4
Cls
M.freetabs()
sizer
Windowtitle str(num)+ " Boxes"
screenunlock
setup(b(),pt())
drawpatterns(pt())
click.draw(15,6)
click.click
screenlock
Case 3
num=5
Cls
M.freetabs()
sizer
Windowtitle str(num)+ " Boxes"
screenunlock
setup(b(),pt())
drawpatterns(pt())
click.draw(15,6)
click.click
screenlock
Case 4
num=6
Cls
M.freetabs()
sizer
Windowtitle str(num)+ " Boxes"
screenunlock
setup(b(),pt())
drawpatterns(pt())
click.draw(15,6)
click.click
screenlock
Case 5
num=7
Cls
M.freetabs()
sizer
Windowtitle str(num)+ " Boxes"
screenunlock
setup(b(),pt())
drawpatterns(pt())
click.draw(15,6)
click.click
Case 6
num=8
Cls
M.freetabs()
sizer
Windowtitle str(num)+ " Boxes"
screenunlock
setup(b(),pt())
drawpatterns(pt())
click.draw(15,6)
click.click
screenlock
Case 7
End
End Select
End If
Next z
flag=mb
screenunlock
Sleep 1,1
Loop Until i=Chr(27) Or i=Chr(256)+"k"
Return 0
End Function
End fbmain
Re: Oh no, not another PRNG
Hi dodicat
just ran your code compiled with -O2 and -O3, -O2 is about 3% faster than -O3
just ran your code compiled with -O2 and -O3, -O2 is about 3% faster than -O3
Re: Oh no, not another PRNG
Thanks for testing srvaldez.
Using deltarho[]'s rnd.
i.e.
#undef Rnd
#define Rnd x128.randD
And still using the skew (log10) generator, it is very fast, about six seconds here for 8 numbers, which beats the c generator (randomize 0,1)
Using deltarho[]'s rnd.
i.e.
#undef Rnd
#define Rnd x128.randD
And still using the skew (log10) generator, it is very fast, about six seconds here for 8 numbers, which beats the c generator (randomize 0,1)
Re: Oh no, not another PRNG
ah okay. hard for me to tell sometimes ;)deltarho[1859] wrote:@dafhi
Why do you rewrite FB's syntax so much, your code becomes unreadable?
what i meant was tack two 16 bits (UShort first definition) and if practrand hits 4 gigs, there's a good chance the overall structure of the generator is a solid candidate for a full-width test. In that case I'd go with the more pure version.deltarho[1859] wrote:@dafhi
Looking at the code further the engine, x128xx, which should run quickly calls rotl three times. rotl has an overhead - a rotl definition does not!
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
Patient: Doctor, it hurts when I do this.dafhi wrote:ah okay. hard for me to tell sometimes ;)
Doctor: Don't do it then!
Mersenne Twister fails PractRand V0.94 at 256GB.if practrand hits 4 gigs, there's a good chance the overall structure of the generator is a solid candidate for a full-width test.
Re: Oh no, not another PRNG
it's 64 bit tho right? the framework i presented is 16.
edit: so, tack 2 16's to simulate a 32. if pract passes to 4 Gigs, that's what i mean
edit: so, tack 2 16's to simulate a 32. if pract passes to 4 Gigs, that's what i mean
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
When did you do that?dafhi wrote:it's 64 bit tho right? the framework i presented is 16.
What does that mean?what i meant was tack two 16 bits
I am sorry dafhi, you will need to show me what command line you are using because I have no idea what you are talking about.
This is what I am using: <whatever.exe> | rng_test stdin64 -tlmin 1KB -multithreaded
Re: Oh no, not another PRNG
I am an bright for 2 reasons. That should read i d i o t.
1. even if I put two 16's together, the period would not be greater than one 16 bit.
2. much more simply, I could change mylit to ulong. (original post)
been so long since I've used practrand. It was you and dodicat who fleshed out a FB / practrand streame
1. even if I put two 16's together, the period would not be greater than one 16 bit.
2. much more simply, I could change mylit to ulong. (original post)
been so long since I've used practrand. It was you and dodicat who fleshed out a FB / practrand streame
-
- Posts: 4292
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Oh no, not another PRNG
We could have saved some time had you posted the command line you were using. Very often an example says more than trying to explain something without one: "A picture is worth a thousand words".
At PowerBASIC they have two text smileys: One says "Failing code not shown"; the other says "Compilable example needed". They get used too often.
At PowerBASIC they have two text smileys: One says "Failing code not shown"; the other says "Compilable example needed". They get used too often.