Hi David,
I have a conceptual question: Most PRNGs cannot, technically speaking, produce the same number twice, since that would mean an infinite loop, right?
I guess PractRand doesn't care, but a real random number generator would allow sequences such as 10, 1, 7, 7, 7, 5, 2.
Your 2cts?
PCG32II
Re: PCG32II
Two in a row happens fairly often with standard CRT rand. Three in a row not so much.
Code: Select all
dim as double r1, r2
dim as ulong x
do
Randomize x,1
r1 = Rnd()
r2 = Rnd()
if r1 = r2 then
Print "Found same number start (" & Str(r1) & ") with seed at " & Str(x) & "/" & Hex(x) & " next two are " & Str(Rnd()) & ", " & Str(Rnd())
Sleep
end if
x += 1
if((x mod &h100000) = 0) Then
print "Counter passed ", Hex(x)
End if
Loop while (x <> 0)
C:\shared\FBSamples>testfb
Found same number start (0.407928466796875) with seed at 3415/D57 next two are 0.22967529296875, 0.893463134765625
Found same number start (0.871368408203125) with seed at 11727/2DCF next two are 0.646392822265625, 0.844390869140625
Found same number start (0.1943359375) with seed at 56796/DDDC next two are 0.278289794921875, 0.4473876953125
Found same number start (0.517333984375) with seed at 101865/18DE9 next two are 0.91021728515625, 0.05035400390625
Found same number start (0.303741455078125) with seed at 155246/25E6E next two are 0.958831787109375, 0.604278564453125
Re: PCG32II
Since the PCG32 generator is a Function with one result, there cannot be a infinite loop.jj2007 wrote:I have a conceptual question: Most PRNGs cannot, technically speaking, produce the same number twice, since that would mean an infinite loop, right?
(Unless, of course, you are creating the call inside a endless loop.)
Re: PCG32II
There is an internal state which gets transformed into the random number. I presume that many different internal states can transform to the same random number. The internal state may not produce the same number twice.jj2007 wrote: Hi David,
I have a conceptual question: Most PRNGs cannot, technically speaking, produce the same number twice, since that would mean an infinite loop, right?
I guess PractRand doesn't care, but a real random number generator would allow sequences such as 10, 1, 7, 7, 7, 5, 2.
Your 2cts?
-
deltarho[1859]
- Posts: 4309
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: PCG32II
What do you mean by number?jj2007 wrote:Most PRNGs cannot, technically speaking, produce the same number twice
If you mean output number, 32-bit say, then that cannot be repeated if the PRNG has a period of 32 bits. If the PRNG has a period of 64-bit then it can produce a 32-bit output more than once; 2^32 times, in fact.
If you mean internal state, as mentioned by Provoni, then that cannot be repeated within the period. A internal state repeat means we are repeating a sequence; and, I suppose, that is what you mean by an infinite loop.
PCG32 has an internal state of 64-bits and outputs 32 bits. The beauty of the PCG family is that we can have different internal state configurations giving rise to different sequences unlike Mersenne Twister, for example, which only has one sequence. However, Mersenne Twister has an internal state of 19,936 bits (623x32) producing a huge period compared with PCG32's 64-bit period. FB's Mersenne Twister is poorly implemented providing an input of only 32-bit. My RndMT will accept 623x32-bit input allowing access to every possible entry point to the sequence.
-
deltarho[1859]
- Posts: 4309
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: PCG32II
@jj2007
I didn't comment on your second sentence.
If in the same period those three 7's in 10,1,7,7,7,5,2 will have been generated by three different internal states. PractRand doesn't concern itself with 'collisions', per se, but it does concern itself with how those collisions are scattered in the sequence. Too many consecutive 32-bit 'collisions' would be regarded as suspicious.
I didn't comment on your second sentence.
If in the same period those three 7's in 10,1,7,7,7,5,2 will have been generated by three different internal states. PractRand doesn't concern itself with 'collisions', per se, but it does concern itself with how those collisions are scattered in the sequence. Too many consecutive 32-bit 'collisions' would be regarded as suspicious.
Re: PCG32II
Thanks, interesting example. Under the hood, the lower DWORD of r1 and r2 is always zero. It seems CRT rand is a particularly lousy PRNG ;-)adeyblue wrote:Two in a row happens fairly often with standard CRT rand
Yes, that's what I meant - the internal number must be a sequence that cannot repeat itself directly after; so the solution is a 64-bit internal number that outputs only 32 bits. Thanks David & Provoni.deltarho[1859] wrote:What do you mean by number?jj2007 wrote:Most PRNGs cannot, technically speaking, produce the same number twice
If you mean output number, 32-bit say, then that cannot be repeated if the PRNG has a period of 32 bits. If the PRNG has a period of 64-bit then it can produce a 32-bit output more than once; 2^32 times, in fact.
If you mean internal state, as mentioned by Provoni, then that cannot be repeated within the period. A internal state repeat means we are repeating a sequence; and, I suppose, that is what you mean by an infinite loop.
PCG32 has an internal state of 64-bits and outputs 32 bits.
Re: PCG32II
I realise that deltarho[] is our resident random number guy.
All this random number stuff may be very mathematical in essence, but practically what is needed is a good all round generator.
From recent deliberations with badidea about the shapes for the tetris game.
https://en.wikipedia.org/wiki/Polyomino
I find it difficult to get a generator to fullfill the task of brute forcing out each pattern from 3 to eight boxes.
I only use rnd once, in the function range() at line 90.
But I had to fiddle about to get rnd to perform.
The fiddling is done at line 301.
For boxes 3 to 7 the result is very fast, for eight boxes just less than 1 minute.
Just work your way down the menu, double click the box to continue.
If somebody has a good range() function to get through the boxes then that would be a good generator test I reckon.
All this random number stuff may be very mathematical in essence, but practically what is needed is a good all round generator.
From recent deliberations with badidea about the shapes for the tetris game.
https://en.wikipedia.org/wiki/Polyomino
I find it difficult to get a generator to fullfill the task of brute forcing out each pattern from 3 to eight boxes.
Code: Select all
#include "fbgfx.bi"
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
Function range(f As Long,l As Long) As Long
Return Int(Rnd*((l+1)-(f)))+(f)
End Function
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=range(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)
If num=6 Then Randomize 0,2 Else Randomize 0
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)
Do
tot+=1
n=range(1,(num*num))
Do
z+=1
If z=1 Then i=n Else i=closest(b(),n)
If tot=1 Then pt(1).p(z)=b(i) Else temp.p(z)=b(i)
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())
Locate 35,120
Print "results "
Locate 37,120
Print Ubound(pt);"/";str(max)
If Inkey=Chr(27) Then screenunlock:Exit Do
Loop Until Ubound(pt)=max
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
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
But I had to fiddle about to get rnd to perform.
The fiddling is done at line 301.
For boxes 3 to 7 the result is very fast, for eight boxes just less than 1 minute.
Just work your way down the menu, double click the box to continue.
If somebody has a good range() function to get through the boxes then that would be a good generator test I reckon.
-
deltarho[1859]
- Posts: 4309
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: PCG32II
Brute forcing using random numbers is not very efficient. As your code stands, for 8 boxes I got to 704/704 in 52 seconds. I then added 'Randomize , 5' at the head of the code. With Windows, that is using CryptGenRandom, most folk would reckon I'd be here until Christmas before I saw 704/704. Nope - 52 seconds.
If we wanted to break a password via a dictionary attack we do not select words from the dictionary at random - goodness knows how many times the same word could be selected. What we use is a sequential selection - that is we start at word number one and work our way through one after the other. See Brute-force search.
If we wanted to break a password via a dictionary attack we do not select words from the dictionary at random - goodness knows how many times the same word could be selected. What we use is a sequential selection - that is we start at word number one and work our way through one after the other. See Brute-force search.
I don't.If somebody has a good range() function to get through the boxes then that would be a good generator test I reckon.
Re: PCG32II
Going through one by one doesn't work.
I have already tried randomize 5.
Here is sequential in newrange() as long
kicks out at 6 and 8
I have already tried randomize 5.
Here is sequential in newrange() as long
kicks out at 6 and 8
Code: Select all
#include "fbgfx.bi"
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
function newrange as long
static as long _3,_4,_5,_6,_7,_8
select case as const num
case 3
_3+=1:if _3 >9 then _3=1
return _3
case 4
_4+=1:if _4 >16 then _4=1
return _4
case 5
_5+=1:if _5 >25 then _5=1
return _5
case 6
_6+=1:if _6 >36 then _6=1
return _6
case 7
_7+=1:if _7 >49 then _7=1
return _7
case 8
_8+=1:if _8 >64 then _8=1
return _8
end select
end function
Function range(f As Long,l As Long) As Long
Return Int(Rnd*((l+1)-(f)))+(f)
End Function
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=range(1,Ubound(a))
'print 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)
If num=6 Then Randomize 0,2 Else Randomize 0
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)
Do
tot+=1
n=newrange'range(1,(num*num))
Do
z+=1
If z=1 Then i=n Else i=closest(b(),n)
If tot=1 Then pt(1).p(z)=b(i) Else temp.p(z)=b(i)
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())
Locate 35,120
Print "results "
Locate 37,120
Print Ubound(pt);"/";str(max)
If Inkey=Chr(27) Then screenunlock:Exit Do
Loop Until Ubound(pt)=max
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
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
-
deltarho[1859]
- Posts: 4309
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: PCG32II
Provided that a solution exists a properly implemented brute force method cannot fail.
Re: PCG32II
OK, my brute force isn't up to spec.
I am going into town now, I shall try later.
I am going into town now, I shall try later.
Re: PCG32II
Cool boxes program dodicat!
dodicat can you speed it up?
The program is slowed down by drawing functions and whatnot which irrelavates the speed of the RNG.deltarho[1859] wrote: With Windows, that is using CryptGenRandom, most folk would reckon I'd be here until Christmas before I saw 704/704. Nope - 52 seconds.
dodicat can you speed it up?
-
deltarho[1859]
- Posts: 4309
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: PCG32II
Yep!Provoni wrote:The program is slowed down by drawing functions and whatnot which irrelavates the speed of the RNG.
-lang fb has five generators and I have added another five. Om my machine PCG32II is the fastest. From a random number quality perpective none of the FB generators are 'top drawer'; although I am not sure about generator #2, not tested, but that is described as having a "reasonable degree of randomness." in the manual. PCG32II passes PractRand to 16TB, givng 4T of [0,1) floats with a granularity of 32 bits. It has a period of 64 bits which should satisfy most people. Of the ten generators that I have only two are thread safe, PCG32II and MsWs.dodicat wrote:All this random number stuff may be very mathematical in essence, but practically what is needed is a good all round generator.
PCG32II is then a good all round generator.
How easy is it to use?
Code: Select all
'#Console On
#Include "E:\FreeBASIC\PCG\PCG32II.bas" ' Change to your location
Dim as pcg32 pcg
Dim as Ulong i
? "Float [0,1) - 32-bit granularity"
For i = 1 to 6
? pcg.randse
Next
? : ? "Float [0,1) - 53-bit granularity"
For i = 1 to 6
? pcg.randd
Next
? : ? "Range (1 to 50), float"
For i = 1 to 6
? pcg.range(1.,50.)
Next
? : ? "Range (1 to 50), discrete"
For i = 1 to 6
? pcg.range(1,50)
Next
SleepWe don't need to seed the generator - a random seed and random sequence is used when we 'Dim as pcg32 pcg'.
The discrete range function is more than seven times faster than dodicat's discrete range function.
If you only want a few random numbers then a half-baked LCG will do. However, once we get past about 1KB of random floats, ie 4KB of 32-bit numbers, then a half-baked LCG will fail PractRand a split second after we take our finger of the Enter button. If I Copy & Paste any source code from the forum which uses Rnd I do a compile and run test and if that works I replace Rnd with pcg.randse - without even looking at how may random numbers may be used. Some will say that is what a purist does, Paul Doe. So, I am a purist, already.
Re: PCG32II
You might consider an option to seed it, it's useful a) for debugging and b) for encrypting files (you need the seed to decrypt it).deltarho[1859] wrote:We don't need to seed the generator - a random seed and random sequence is used when we 'Dim as pcg32 pcg'