PCG32II

General FreeBASIC programming questions.
jj2007
Posts: 1818
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

PCG32II

Postby jj2007 » Jun 14, 2020 0:41

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?
adeyblue
Posts: 37
Joined: Nov 07, 2019 20:08

Re: PCG32II

Postby adeyblue » Jun 14, 2020 2:25

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
MrSwiss
Posts: 3657
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: PCG32II

Postby MrSwiss » Jun 14, 2020 3:57

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?

Since the PCG32 generator is a Function with one result, there cannot be a infinite loop.
(Unless, of course, you are creating the call inside a endless loop.)
Provoni
Posts: 393
Joined: Jan 05, 2014 12:33
Location: Belgium

Re: PCG32II

Postby Provoni » Jun 14, 2020 5:45

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?

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.
deltarho[1859]
Posts: 2756
Joined: Jan 02, 2017 0:34
Location: UK

Re: PCG32II

Postby deltarho[1859] » Jun 14, 2020 6:09

jj2007 wrote:Most PRNGs cannot, technically speaking, produce the same number twice

What do you mean by number?

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: 2756
Joined: Jan 02, 2017 0:34
Location: UK

Re: PCG32II

Postby deltarho[1859] » Jun 14, 2020 7:43

@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.
jj2007
Posts: 1818
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: PCG32II

Postby jj2007 » Jun 14, 2020 8:21

adeyblue wrote:Two in a row happens fairly often with standard CRT rand
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 ;-)
deltarho[1859] wrote:
jj2007 wrote:Most PRNGs cannot, technically speaking, produce the same number twice

What do you mean by number?

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.
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.
dodicat
Posts: 6761
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: PCG32II

Postby dodicat » Jun 14, 2020 9:54

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.

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

 


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.
deltarho[1859]
Posts: 2756
Joined: Jan 02, 2017 0:34
Location: UK

Re: PCG32II

Postby deltarho[1859] » Jun 14, 2020 12:59

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 somebody has a good range() function to get through the boxes then that would be a good generator test I reckon.

I don't. Image
dodicat
Posts: 6761
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: PCG32II

Postby dodicat » Jun 14, 2020 13:16

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

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: 2756
Joined: Jan 02, 2017 0:34
Location: UK

Re: PCG32II

Postby deltarho[1859] » Jun 14, 2020 13:29

Provided that a solution exists a properly implemented brute force method cannot fail.
dodicat
Posts: 6761
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: PCG32II

Postby dodicat » Jun 14, 2020 13:33

OK, my brute force isn't up to spec.
I am going into town now, I shall try later.
Provoni
Posts: 393
Joined: Jan 05, 2014 12:33
Location: Belgium

Re: PCG32II

Postby Provoni » Jun 14, 2020 13:59

Cool boxes program dodicat!

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.

The program is slowed down by drawing functions and whatnot which irrelavates the speed of the RNG.

dodicat can you speed it up?
deltarho[1859]
Posts: 2756
Joined: Jan 02, 2017 0:34
Location: UK

Re: PCG32II

Postby deltarho[1859] » Jun 14, 2020 14:56

Provoni wrote:The program is slowed down by drawing functions and whatnot which irrelavates the speed of the RNG.

Yep!

dodicat wrote:All this random number stuff may be very mathematical in essence, but practically what is needed is a good all round generator.

-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.

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
Sleep

How hard is that?

We 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. Image
jj2007
Posts: 1818
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: PCG32II

Postby jj2007 » Jun 14, 2020 17:16

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'
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).

Return to “General”

Who is online

Users browsing this forum: No registered users and 17 guests