How to "customize" the random generator?

General FreeBASIC programming questions.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

How to "customize" the random generator?

Postby Tourist Trap » Feb 08, 2019 16:33

Edit:
I don't know if this is a difficult question. Anyway here is an update of the program I use that should make it even clearer and simpler to see what I mean very precisely.

Code: Select all

'attempt of a custom random number generator


#include "fbgfx.bi"

'__________________________________here stand the definitions
#macro _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(w, v)
    screenSet (w), (v)
#endMacro
#macro _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(w, v)
    screenCopy (w), (v)
#endMacro

type BUTTON
    declare constructor()
    declare sub TriggerMouseTest()
    declare sub DrawButton()
        as integer  _left
        as integer  _top
        as integer  _width
        as integer  _height
        as string   _text
        as boolean  _hasMouseOver
        as boolean  _hasMouseClick
        as boolean  _hasMouseButtonReleased
end type
constructor BUTTON
    dim as integer scrW, scrH
    screenInfo scrW, scrH
    with THIS
        ._left                      => scrW\2 - 2
        ._top                       => scrH\2 - 2
        ._width                     => scrW\24
        ._height                    => scrH\24
        ._text                      => "default"
        ._hasMouseOver              => FALSE
        ._hasMouseClick             => FALSE
        ._hasMouseButtonReleased    => FALSE
    end with
end constructor
sub BUTTON.TriggerMouseTest()
    dim as integer  whereMouseX, _
                    whereMouseY, _
                    whatMouseButtonClicked
    GetMouse whereMouseX, whereMouseY, , whatMouseButtonClicked
    with THIS
        if whereMouseX>=._left andAlso _
            whereMouseX<(._left+ ._width) andAlso _
            whereMouseY>=._top andAlso _
            whereMouseY<(._top + ._height) then
            if not ._hasMouseOver then
                ._hasMouseOver = TRUE
            end if
        else
            if ._hasMouseOver then
                ._hasMouseOver = FALSE
            end if
        end if
        '
        if ._hasMouseOver andAlso cBool(whatMouseButtonClicked>0) then
            if not ._hasMouseClick then
                ._hasMouseClick = TRUE
            end if
        else
            if ._hasMouseClick then
                ._hasMouseClick             = FALSE
                if ._hasMouseOver then
                    if not ._hasMouseButtonReleased then
                        ._hasMouseButtonReleased    = TRUE
                    else
                        ._hasMouseButtonReleased    = FALSE
                    end if
                end if
            else
                ._hasMouseButtonReleased    = FALSE
            end if
        end if
    end with
end sub
sub BUTTON.DrawButton()
    THIS.TriggerMouseTest()
    '
    dim as long btnColor
    with THIS
        if ._hasMouseButtonReleased then
                btnColor = rgb(100,200,100)
        elseIf ._hasMouseClick then
                btnColor = rgb(100,100,200)
        else
                btnColor = rgb(100,100,100)
        end if
        '
        line (._left,._top)- _
                (._left + ._width - 1,._top + ._height - 1), _
                btnColor, _
                bf
    end with
end sub


type DRAGGABLECIRCLE
    declare constructor()
    declare constructor(byval as integer, _
                        byval as integer, _
                        byval as integer, _
                        byval as ulong, _
                        byval as string)
    declare destructor()
    declare function AddDraggableCirclePtrToFamily() as integer
    declare sub TestDraggablePointForMouse()
    declare sub DrawDraggablePoint()
        as single              _x
        as single              _y
        as single              _radius
        as ulong                _color
        as string               _pointName
        as boolean              _mouseOver
        as boolean              _mouseClick
        as boolean              _dragStarted
        as single              _xAtDragtime
        as single              _yAtDragtime
    'private:
        as integer               _draggableCircleFamilyMemberIndex
    static as integer            draggableCirclePtrFamilyMemberCount
    static as DRAGGABLECIRCLE ptr   familyArrayOfDraggableCirclePtr(any)
end type 'DRAGGABLECIRCLE
'static member initialization_
dim as integer   DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount   => -1
dim as DRAGGABLECIRCLE ptr   DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr(any)
'member method implementation_
constructor DRAGGABLECIRCLE()
    dim as integer scrW, scrH, scrD
    if screenPtr()=0 then
        scrW => 200
        scrH => 200
        scrD => 032
        screenRes scrW, scrH, scrD
        windowTitle "opened by DRAGGABLECIRCLE"
    else
        screenInfo scrW, scrH, scrD
    end if
    with THIS
        ._x             => scrW\2
        ._y             => scrH\2
        ._radius        => 4
        ._color         => iif(scrD=8, 14, rgb(200,200,0))
        ._pointName     => "Default"
        ._mouseOver     => FALSE
        ._mouseClick    => FALSE
        ._dragStarted   => FALSE       
    end with 'THIS
    '
   THIS._draggableCircleFamilyMemberIndex => THIS.AddDraggableCirclePtrToFamily()
   '
end constructor 'DRAGGABLECIRCLE default constructor
constructor DRAGGABLECIRCLE(byval X      as integer, _
                           byval Y      as integer, _
                           byval Radius as integer, _
                           byval Colour as ulong, _
                           byval PointName as string)
    with THIS
        ._x             => X
        ._y             => Y
        ._radius        => Radius
        ._color         => Colour
        ._pointName     => PointName
        ._mouseOver     => FALSE
        ._mouseClick    => FALSE
        ._dragStarted   => FALSE       
    end with 'THIS
    '
   THIS._draggableCircleFamilyMemberIndex => THIS.AddDraggableCirclePtrToFamily()
   '
end constructor 'DRAGGABLECIRCLE(valINT,valINT,valINT,valULNG,valSTR)
destructor DRAGGABLECIRCLE()
   if THIS._draggableCircleFamilyMemberIndex=-1 then exit destructor
   '
   select case DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount
      case is>1
         DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount -= 1
         '
         swap DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
                        DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount - 1), _
             DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
                         THIS._draggableCircleFamilyMemberIndex)
         '
         redim preserve DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
                        uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) - 1)
         '
         for index as integer = 0 to uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr)
            DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr(index)->_draggableCircleFamilyMemberIndex = _
                                                                              index
         next index
      case else
         DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount = 0
         erase DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr      
   end select 'DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount
   '
   THIS._draggableCircleFamilyMemberIndex = -1
end destructor 'DRAGGABLECIRCLE default destructor
function DRAGGABLECIRCLE.AddDraggableCirclePtrToFamily() as integer
   redim preserve DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
               uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) + 1)
   DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount =  _
                  uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) + 1
   DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
               uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) ) = @THIS
   '---->
   return DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount - 1
end function 'INT:=DRAGGABLECIRCLE.AddDraggableCirclePtrToFamily()
sub DRAGGABLECIRCLE.TestDraggablePointForMouse()
   if THIS._draggableCircleFamilyMemberIndex=-1 then exit sub
   '
    dim as integer gmX, gmY, gmBtn1
    getMouse gmX, gmY, , gmBtn1
    '
    if abs(gmX - THIS._x)<=THIS._radius and _
       abs(gmY - THIS._y)<=THIS._radius then
        if not THIS._mouseOver then THIS._mouseOver = TRUE
        if gmBtn1=+1 then
            if not THIS._mouseClick then
                THIS._mouseClick    = TRUE
                dim as boolean otherFamillyMemberHasDragStarted => FALSE
                for index as integer = 0 to DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount - 1
                   if DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr(index)->_dragStarted then
                      otherFamillyMemberHasDragStarted = TRUE
                      exit for
                   end if
                next index
                if not otherFamillyMemberHasDragStarted then
                   THIS._dragStarted = TRUE
                   THIS._xAtDragtime   = gmX
                   THIS._yAtDragtime   = gmY                   
                end if
            end if
        else
            if THIS._mouseClick then
                THIS._mouseClick    = FALSE
                THIS._dragStarted   = FALSE
            end if
        end if
    else
        if THIS._mouseOver then THIS._mouseOver = FALSE
        if THIS._mouseClick and not THIS._dragStarted then
            THIS._mouseClick    = FALSE
        end if
    end if
end sub 'DRAGGABLECIRCLE.TestDraggablePointForMouse()
sub DRAGGABLECIRCLE.DrawDraggablePoint()
    dim as single   constX => THIS._x
    '
   if THIS._draggableCircleFamilyMemberIndex=-1 then
      exit sub
   else
      THIS.TestDraggablePointForMouse()
   end if
    '
    circle (THIS._x,THIS._y), (THIS._radius + 1), THIS._color
    draw string (THIS._x - 8 - (THIS._radius + 1), _
                 THIS._y - 8 - (THIS._radius + 1)), _
                 THIS._pointName, _
                 THIS._color
    '
    if THIS._mouseOver then
        circle (THIS._x,THIS._y), THIS._radius - 1, rgb(0,255,0),,,,f
    end if
    if THIS._mouseClick then
        circle (THIS._x,THIS._y), THIS._radius - 2, rgb(255,0,0),,,,f
    end if
    if THIS._dragStarted then
        dim as integer gmX, gmY, gmBtn1
        getMouse gmX, gmY, , gmBtn1
        if gmX=-1 or gmY=-1 then exit sub
        if ((gmX - THIS._x)^2 + (gmY - THIS._y)^2)>THIS._radius^2 then
            setMouse ( THIS._x + 4*(gmX - THIS._x)/5 ), _
                     ( THIS._y + 4*(gmY - THIS._y)/5 )
            'this below lowers a little the mouse speed
            THIS._x = THIS._x + 3*(gmX - THIS._x)/5
            THIS._y = THIS._y + 3*(gmY - THIS._y)/5
        else
            THIS._x = gmX
            THIS._y = gmY
            setMouse gmX, gmY
        end if       
    end if
    '
    THIS._x = constX
end sub 'DRAGGABLECIRCLE.DrawDraggablePoint()


type TWEAKABLEDISCREETREPARTITIONPANEL
    declare constructor()
    declare destructor()
    declare property ProbabilityAtIndex(byval as integer) as single
    declare property ProbabilitySum() as single
    declare property RandomValue() as single
    declare sub TestMouse()
    declare sub DrawPanel()
    declare function RandomNumberInTheDiscreetRepartion() as single
        as integer              _topLeftCornerX
        as integer              _topLeftCornerY
        as integer              _panelWidth
        as integer              _panelHeight
        as DRAGGABLECIRCLE ptr  _arrayOfDCptr(any)
end type
constructor TWEAKABLEDISCREETREPARTITIONPANEL()
    if screenPtr()=0 then
        screenRes 800, 600, 32
    end if
    '
    dim as integer  scrX, scrY
    screenInfo  scrX, scrY
    '
    with THIS
        ._topLeftCornerX    => scrX\10
        ._topLeftCornerY    => scrY\10
        ._panelWidth        => scrX - 2*._topLeftCornerX
        ._panelHeight       => scrY - 8*._topLeftCornerY
    end with
    '
    redim ._arrayOfDCptr(0 to 63)
    for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
        THIS._arrayOfDCptr(index) = new DRAGGABLECIRCLE
        with *THIS._arrayOfDCptr(index)
            ._x  => THIS._topLeftCornerX + index*THIS._panelWidth/(uBound(THIS._arrayOfDCptr) - lBound(THIS._arrayOfDCptr) + 1)
            ._y  => THIS._topLeftCornerY + THIS._panelHeight - THIS._panelHeight/(uBound(THIS._arrayOfDCptr) - lBound(THIS._arrayOfDCptr) + 1)
            ._pointName => str(index)
        end with
    next index
end constructor
destructor TWEAKABLEDISCREETREPARTITIONPANEL()
    for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
        delete THIS._arrayOfDCptr(index)
    next index
end destructor
property TWEAKABLEDISCREETREPARTITIONPANEL.ProbabilityAtIndex(byval Index as integer) as single
   '
   if Index>=lBound(THIS._arrayOfDCptr) andAlso Index<=uBound(THIS._arrayOfDCptr) then
      return (THIS._topLeftCornerY + THIS._panelHeight - THIS._arrayOfDCptr(index)->_y)/(THIS._panelHeight)
   else
      return 0
   end if
end property
property TWEAKABLEDISCREETREPARTITIONPANEL.ProbabilitySum() as single
   dim as single  sum   => 0
   for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
      sum += THIS.ProbabilityAtIndex(index)
   next index
   return sum
end property
property TWEAKABLEDISCREETREPARTITIONPANEL.RandomValue() as single
   'this should return a value according to its probability
    return rnd()
end property
sub TWEAKABLEDISCREETREPARTITIONPANEL.TestMouse()
    '
end sub
sub TWEAKABLEDISCREETREPARTITIONPANEL.DrawPanel()
    THIS.TestMouse()
    '
    line (THIS._topLeftCornerX, THIS._topLeftCornerY)-step(THIS._panelWidth - 1,THIS._panelHeight - 1), rgb(100,120,100), bf
    line (THIS._topLeftCornerX, THIS._topLeftCornerY)-step(THIS._panelWidth - 1 - 8,THIS._panelHeight - 1), rgb(100,120,190), bf
    draw string (THIS._topLeftCornerX + THIS._panelWidth - 1 - 6, THIS._topLeftCornerY), str(1)
    draw string (THIS._topLeftCornerX + THIS._panelWidth - 1 - 6, THIS._topLeftCornerY + THIS._panelHeight - 1 - 6), str(0)
    for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
        if index=lBound(THIS._arrayOfDCptr) then
            pReset (THIS._arrayOfDCptr(index)->_x, THIS._arrayOfDCptr(index)->_y)
        else
            line (THIS._arrayOfDCptr(index - 1)->_x, THIS._arrayOfDCptr(index - 1)->_y)-(THIS._arrayOfDCptr(index)->_x, THIS._arrayOfDCptr(index)->_y), rgb(100,200,200)
        end if
        THIS._arrayOfDCptr(index)->DrawDraggablePoint()
       
        if THIS._arrayOfDCptr(index)->_y<THIS._topLeftCornerY then THIS._arrayOfDCptr(index)->_y = THIS._topLeftCornerY
        if THIS._arrayOfDCptr(index)->_y>(THIS._topLeftCornerY + THIS._panelHeight) then
                THIS._arrayOfDCptr(index)->_y = (THIS._topLeftCornerY + THIS._panelHeight)
        end if
    next index
end sub


'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
screenRes 800, 500, 32, 2

dim as TWEAKABLEDISCREETREPARTITIONPANEL        tdrp
dim as BUTTON                                   generateBtn
generateBtn._left  => 300
generateBtn._width  => 200

dim as single  randomValue             => any
dim as single  meanValueOther1000shots => 0
dim as integer shootCounter   => 0
do
    _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(0, 1)
         cls
         generateBtn.DrawButton()
         if generateBtn._hasMouseButtonReleased then shootCounter = 0
         tdrp.DrawPanel()
         draw string (94, 300), str("(no way to know if and what initialization is done by user for the randomizer)")

         shootCounter += 1
         randomValue = tdrp.RandomValue
         if shootCounter<1000 then
            meanValueOther1000shots = (shootCounter*meanValueOther1000shots + randomValue*64)/(shootCounter + 1)
         else
            shootCounter = 0
         end if
         draw string (300, 320), "instant value = " & str(randomValue), rgb(0,200,0)
         draw string (340, 340), "mean = " & str(meanValueOther1000shots), rgb(200,200,0)
         
         'show all the individual probabilities and the sum
         for index as integer = lBound(tdrp._arrayOfDCptr) to uBound(tdrp._arrayOfDCptr)
            draw string (40 + (index mod 7)*100, 360 + (index\7)*10), "p(" & str(index) & ") = " & left(str(tdrp.ProbabilityAtIndex(index)), 4)
         next index
         draw string (320, 480), "probability sum = " & str(tdrp.ProbabilitySum), rgb(200,200,0)
    _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(0, 1)
    '
    sleep 15
loop until inkey()=chr(27)

getKey()
'(eof)


Thanks for the attention anyway.
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: How to "customize" the random generator?

Postby Tourist Trap » Feb 09, 2019 13:42

Updated demo code, should make this more understandable.
jj2007
Posts: 1179
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to "customize" the random generator?

Postby jj2007 » Feb 09, 2019 15:55

Perhaps you could explain in three, four words what your program is doing?
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: How to "customize" the random generator?

Postby Tourist Trap » Feb 09, 2019 16:01

jj2007 wrote:Perhaps you could explain in three, four words what your program is doing?

Yes of course. It is supposed to set the probability to get a number from 0 to 63 for each of these numbers. If you move the circles you change this probability for the number concerned.
At first, all the number have 1/64 chances, but you can change it.

In this update, the sum of probability returns to 1 when you move a cursor (I wanted an instant change, but it moves slowly to 1 don't know why, but it does anyway).

Then the question again, is not how to set up all those values, but it is how to make the RND() function reflect the new distribution?..

As a very crude example, if I set the probability of the number 10 to 1, I should only obtain 10 , and the mean will be 10 as well and so on.

Code: Select all

'attempt of a custom random number generator


#include "fbgfx.bi"

'__________________________________here stand the definitions
#macro _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(w, v)
    screenSet (w), (v)
#endMacro
#macro _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(w, v)
    screenCopy (w), (v)
#endMacro

type BUTTON
    declare constructor()
    declare sub TriggerMouseTest()
    declare sub DrawButton()
        as integer  _left
        as integer  _top
        as integer  _width
        as integer  _height
        as string   _text
        as boolean  _hasMouseOver
        as boolean  _hasMouseClick
        as boolean  _hasMouseButtonReleased
end type
constructor BUTTON
    dim as integer scrW, scrH
    screenInfo scrW, scrH
    with THIS
        ._left                      => scrW\2 - 2
        ._top                       => scrH\2 - 2
        ._width                     => scrW\24
        ._height                    => scrH\24
        ._text                      => "default"
        ._hasMouseOver              => FALSE
        ._hasMouseClick             => FALSE
        ._hasMouseButtonReleased    => FALSE
    end with
end constructor
sub BUTTON.TriggerMouseTest()
    dim as integer  whereMouseX, _
                    whereMouseY, _
                    whatMouseButtonClicked
    GetMouse whereMouseX, whereMouseY, , whatMouseButtonClicked
    with THIS
        if whereMouseX>=._left andAlso _
            whereMouseX<(._left+ ._width) andAlso _
            whereMouseY>=._top andAlso _
            whereMouseY<(._top + ._height) then
            if not ._hasMouseOver then
                ._hasMouseOver = TRUE
            end if
        else
            if ._hasMouseOver then
                ._hasMouseOver = FALSE
            end if
        end if
        '
        if ._hasMouseOver andAlso cBool(whatMouseButtonClicked>0) then
            if not ._hasMouseClick then
                ._hasMouseClick = TRUE
            end if
        else
            if ._hasMouseClick then
                ._hasMouseClick             = FALSE
                if ._hasMouseOver then
                    if not ._hasMouseButtonReleased then
                        ._hasMouseButtonReleased    = TRUE
                    else
                        ._hasMouseButtonReleased    = FALSE
                    end if
                end if
            else
                ._hasMouseButtonReleased    = FALSE
            end if
        end if
    end with
end sub
sub BUTTON.DrawButton()
    THIS.TriggerMouseTest()
    '
    dim as long btnColor
    with THIS
        if ._hasMouseButtonReleased then
                btnColor = rgb(100,200,100)
        elseIf ._hasMouseClick then
                btnColor = rgb(100,100,200)
        else
                btnColor = rgb(100,100,100)
        end if
        '
        line (._left,._top)- _
                (._left + ._width - 1,._top + ._height - 1), _
                btnColor, _
                bf
    end with
end sub


type DRAGGABLECIRCLE
    declare constructor()
    declare constructor(byval as integer, _
                        byval as integer, _
                        byval as integer, _
                        byval as ulong, _
                        byval as string)
    declare destructor()
    declare function AddDraggableCirclePtrToFamily() as integer
    declare sub TestDraggablePointForMouse()
    declare sub DrawDraggablePoint()
        as single              _x
        as single              _y
        as single              _radius
        as ulong                _color
        as string               _pointName
        as boolean              _mouseOver
        as boolean              _mouseClick
        as boolean              _dragStarted
        as single              _xAtDragtime
        as single              _yAtDragtime
    'private:
        as integer               _draggableCircleFamilyMemberIndex
    static as integer            draggableCirclePtrFamilyMemberCount
    static as DRAGGABLECIRCLE ptr   familyArrayOfDraggableCirclePtr(any)
end type 'DRAGGABLECIRCLE
'static member initialization_
dim as integer   DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount   => -1
dim as DRAGGABLECIRCLE ptr   DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr(any)
'member method implementation_
constructor DRAGGABLECIRCLE()
    dim as integer scrW, scrH, scrD
    if screenPtr()=0 then
        scrW => 200
        scrH => 200
        scrD => 032
        screenRes scrW, scrH, scrD
        windowTitle "opened by DRAGGABLECIRCLE"
    else
        screenInfo scrW, scrH, scrD
    end if
    with THIS
        ._x             => scrW\2
        ._y             => scrH\2
        ._radius        => 4
        ._color         => iif(scrD=8, 14, rgb(200,200,0))
        ._pointName     => "Default"
        ._mouseOver     => FALSE
        ._mouseClick    => FALSE
        ._dragStarted   => FALSE       
    end with 'THIS
    '
   THIS._draggableCircleFamilyMemberIndex => THIS.AddDraggableCirclePtrToFamily()
   '
end constructor 'DRAGGABLECIRCLE default constructor
constructor DRAGGABLECIRCLE(byval X      as integer, _
                           byval Y      as integer, _
                           byval Radius as integer, _
                           byval Colour as ulong, _
                           byval PointName as string)
    with THIS
        ._x             => X
        ._y             => Y
        ._radius        => Radius
        ._color         => Colour
        ._pointName     => PointName
        ._mouseOver     => FALSE
        ._mouseClick    => FALSE
        ._dragStarted   => FALSE       
    end with 'THIS
    '
   THIS._draggableCircleFamilyMemberIndex => THIS.AddDraggableCirclePtrToFamily()
   '
end constructor 'DRAGGABLECIRCLE(valINT,valINT,valINT,valULNG,valSTR)
destructor DRAGGABLECIRCLE()
   if THIS._draggableCircleFamilyMemberIndex=-1 then exit destructor
   '
   select case DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount
      case is>1
         DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount -= 1
         '
         swap DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
                        DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount - 1), _
             DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
                         THIS._draggableCircleFamilyMemberIndex)
         '
         redim preserve DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
                        uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) - 1)
         '
         for index as integer = 0 to uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr)
            DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr(index)->_draggableCircleFamilyMemberIndex = _
                                                                              index
         next index
      case else
         DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount = 0
         erase DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr      
   end select 'DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount
   '
   THIS._draggableCircleFamilyMemberIndex = -1
end destructor 'DRAGGABLECIRCLE default destructor
function DRAGGABLECIRCLE.AddDraggableCirclePtrToFamily() as integer
   redim preserve DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
               uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) + 1)
   DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount =  _
                  uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) + 1
   DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr( _
               uBound(DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr) ) = @THIS
   '---->
   return DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount - 1
end function 'INT:=DRAGGABLECIRCLE.AddDraggableCirclePtrToFamily()
sub DRAGGABLECIRCLE.TestDraggablePointForMouse()
   if THIS._draggableCircleFamilyMemberIndex=-1 then exit sub
   '
    dim as integer gmX, gmY, gmBtn1
    getMouse gmX, gmY, , gmBtn1
    '
    if abs(gmX - THIS._x)<=THIS._radius and _
       abs(gmY - THIS._y)<=THIS._radius then
        if not THIS._mouseOver then THIS._mouseOver = TRUE
        if gmBtn1=+1 then
            if not THIS._mouseClick then
                THIS._mouseClick    = TRUE
                dim as boolean otherFamillyMemberHasDragStarted => FALSE
                for index as integer = 0 to DRAGGABLECIRCLE.draggableCirclePtrFamilyMemberCount - 1
                   if DRAGGABLECIRCLE.familyArrayOfDraggableCirclePtr(index)->_dragStarted then
                      otherFamillyMemberHasDragStarted = TRUE
                      exit for
                   end if
                next index
                if not otherFamillyMemberHasDragStarted then
                   THIS._dragStarted = TRUE
                   THIS._xAtDragtime   = gmX
                   THIS._yAtDragtime   = gmY                   
                end if
            end if
        else
            if THIS._mouseClick then
                THIS._mouseClick    = FALSE
                THIS._dragStarted   = FALSE
            end if
        end if
    else
        if THIS._mouseOver then THIS._mouseOver = FALSE
        if THIS._mouseClick and not THIS._dragStarted then
            THIS._mouseClick    = FALSE
        end if
    end if
end sub 'DRAGGABLECIRCLE.TestDraggablePointForMouse()
sub DRAGGABLECIRCLE.DrawDraggablePoint()
    dim as single   constX => THIS._x
    '
   if THIS._draggableCircleFamilyMemberIndex=-1 then
      exit sub
   else
      THIS.TestDraggablePointForMouse()
   end if
    '
    circle (THIS._x,THIS._y), (THIS._radius + 1), THIS._color
    draw string (THIS._x - 8 - (THIS._radius + 1), _
                 THIS._y - 8 - (THIS._radius + 1)), _
                 THIS._pointName, _
                 THIS._color
    '
    if THIS._mouseOver then
        circle (THIS._x,THIS._y), THIS._radius - 1, rgb(0,255,0),,,,f
    end if
    if THIS._mouseClick then
        circle (THIS._x,THIS._y), THIS._radius - 2, rgb(255,0,0),,,,f
    end if
    if THIS._dragStarted then
        dim as integer gmX, gmY, gmBtn1
        getMouse gmX, gmY, , gmBtn1
        if gmX=-1 or gmY=-1 then exit sub
        if ((gmX - THIS._x)^2 + (gmY - THIS._y)^2)>THIS._radius^2 then
            setMouse ( THIS._x + 4*(gmX - THIS._x)/5 ), _
                     ( THIS._y + 4*(gmY - THIS._y)/5 )
            'this below lowers a little the mouse speed
            THIS._x = THIS._x + 3*(gmX - THIS._x)/5
            THIS._y = THIS._y + 3*(gmY - THIS._y)/5
        else
            THIS._x = gmX
            THIS._y = gmY
            setMouse gmX, gmY
        end if       
    end if
    '
    THIS._x = constX
end sub 'DRAGGABLECIRCLE.DrawDraggablePoint()


type TWEAKABLEDISCREETREPARTITIONPANEL
    declare constructor()
    declare destructor()
    declare property ActiveIndex() as integer
    declare property ProbabilityAtIndex(byval as integer) as single
    declare property ProbabilitySum() as single
    declare property RandomValue() as single
    declare sub TestMouse()
    declare sub DrawPanel()
    declare function RandomNumberInTheDiscreetRepartion() as single
        as integer              _topLeftCornerX
        as integer              _topLeftCornerY
        as integer              _panelWidth
        as integer              _panelHeight
        as DRAGGABLECIRCLE ptr  _arrayOfDCptr(any)
        as integer              _activeIndex
end type
constructor TWEAKABLEDISCREETREPARTITIONPANEL()
    if screenPtr()=0 then
        screenRes 800, 600, 32
    end if
    '
    dim as integer  scrX, scrY
    screenInfo  scrX, scrY
    '
    with THIS
        ._topLeftCornerX    => scrX\10
        ._topLeftCornerY    => scrY\10
        ._panelWidth        => scrX - 2*._topLeftCornerX
        ._panelHeight       => scrY - 8*._topLeftCornerY
    end with
    '
    redim ._arrayOfDCptr(0 to 63)
    for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
        THIS._arrayOfDCptr(index) = new DRAGGABLECIRCLE
        with *THIS._arrayOfDCptr(index)
            ._x  => THIS._topLeftCornerX + index*THIS._panelWidth/(uBound(THIS._arrayOfDCptr) - lBound(THIS._arrayOfDCptr) + 1)
            ._y  => THIS._topLeftCornerY + THIS._panelHeight - THIS._panelHeight/(uBound(THIS._arrayOfDCptr) - lBound(THIS._arrayOfDCptr) + 1)
            ._pointName => str(index)
        end with
    next index
    THIS._activeIndex   => -1
end constructor
destructor TWEAKABLEDISCREETREPARTITIONPANEL()
    for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
        delete THIS._arrayOfDCptr(index)
    next index
end destructor
property TWEAKABLEDISCREETREPARTITIONPANEL.ActiveIndex() as integer
   THIS._activeIndex = -1
   for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
      if THIS._arrayOfDCptr(index)->_dragStarted then
         THIS._activeIndex = index
         exit for
      end if
   next index
   '
   return THIS._activeIndex
end property
property TWEAKABLEDISCREETREPARTITIONPANEL.ProbabilityAtIndex(byval Index as integer) as single
   '
   if Index>=lBound(THIS._arrayOfDCptr) andAlso Index<=uBound(THIS._arrayOfDCptr) then
      return (THIS._topLeftCornerY + THIS._panelHeight - THIS._arrayOfDCptr(index)->_y)/(THIS._panelHeight)
   else
      return 0
   end if
end property
property TWEAKABLEDISCREETREPARTITIONPANEL.ProbabilitySum() as single
   dim as single  sum   => 0
   for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
      sum += THIS.ProbabilityAtIndex(index)
   next index
   return sum
end property
property TWEAKABLEDISCREETREPARTITIONPANEL.RandomValue() as single
   'this should return a value according to its probability
    return rnd()
end property
sub TWEAKABLEDISCREETREPARTITIONPANEL.TestMouse()
    '
end sub
sub TWEAKABLEDISCREETREPARTITIONPANEL.DrawPanel()
    THIS.TestMouse()
    '
    line (THIS._topLeftCornerX, THIS._topLeftCornerY)-step(THIS._panelWidth - 1,THIS._panelHeight - 1), rgb(100,120,100), bf
    line (THIS._topLeftCornerX, THIS._topLeftCornerY)-step(THIS._panelWidth - 1 - 8,THIS._panelHeight - 1), rgb(100,120,190), bf
    draw string (THIS._topLeftCornerX + THIS._panelWidth - 1 - 6, THIS._topLeftCornerY), str(1)
    draw string (THIS._topLeftCornerX + THIS._panelWidth - 1 - 6, THIS._topLeftCornerY + THIS._panelHeight - 1 - 6), str(0)
    '
    if (uBound(THIS._arrayOfDCptr) - lBound(THIS._arrayOfDCptr) + 1)=0 then exit sub
    '
    for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
        if index=lBound(THIS._arrayOfDCptr) then
            pReset (THIS._arrayOfDCptr(index)->_x, THIS._arrayOfDCptr(index)->_y)
        else
            line (THIS._arrayOfDCptr(index - 1)->_x, THIS._arrayOfDCptr(index - 1)->_y)-(THIS._arrayOfDCptr(index)->_x, THIS._arrayOfDCptr(index)->_y), rgb(100,200,200)
        end if
        THIS._arrayOfDCptr(index)->DrawDraggablePoint()
        '
        if THIS._arrayOfDCptr(index)->_y<THIS._topLeftCornerY then THIS._arrayOfDCptr(index)->_y = THIS._topLeftCornerY
        if THIS._arrayOfDCptr(index)->_y>(THIS._topLeftCornerY + THIS._panelHeight) then
                THIS._arrayOfDCptr(index)->_y = (THIS._topLeftCornerY + THIS._panelHeight)
        end if
    next index
    'see what's the active point
    'distribute the delta to 1 to the inactive others
    if THIS.ActiveIndex<0 then exit sub
    dim as single   sharedDelta => any
    dim as single   deltaTo1    => THIS.ProbabilitySum - 1
    if abs(deltaTo1)>1e-6 then
      sharedDelta = deltaTo1/(uBound(THIS._arrayOfDCptr) - lBound(THIS._arrayOfDCptr) + 1 - 1)
      for index as integer = lBound(THIS._arrayOfDCptr) to uBound(THIS._arrayOfDCptr)
         if not index=THIS._activeIndex then
            THIS._arrayOfDCptr(index)->_y += sharedDelta*THIS._panelHeight
         end if
      next index
    end if
end sub


'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
screenRes 800, 500, 32, 2

dim as TWEAKABLEDISCREETREPARTITIONPANEL        tdrp
dim as BUTTON                                   generateBtn
generateBtn._left  => 300
generateBtn._width  => 200

dim as single  randomValue             => any
dim as single  meanValueOther1000shots => 0
dim as integer shootCounter   => 0
do
    _SETWORKINGSCREENPAGEANDVISIBLESCREENPAGE(0, 1)
         cls
         generateBtn.DrawButton()
         if generateBtn._hasMouseButtonReleased then shootCounter = 0
         tdrp.DrawPanel()
         draw string (94, 300), str("(no way to know if and what initialization is done by user for the randomizer)")

         shootCounter += 1
         randomValue = tdrp.RandomValue
         if shootCounter<1000 then
            meanValueOther1000shots = (shootCounter*meanValueOther1000shots + randomValue*64)/(shootCounter + 1)
         else
            shootCounter = 0
         end if
         draw string (300, 320), "instant value = " & str(randomValue), rgb(0,200,0)
         draw string (340, 340), "mean = " & str(meanValueOther1000shots), rgb(200,200,0)
         
         'show all the individual probabilities and the sum
         for index as integer = lBound(tdrp._arrayOfDCptr) to uBound(tdrp._arrayOfDCptr)
            draw string (40 + (index mod 7)*100, 360 + (index\7)*10), "p(" & str(index) & ") = " & left(str(tdrp.ProbabilityAtIndex(index)), 4)
         next index
         draw string (320, 480), "probability sum = " & str(tdrp.ProbabilitySum), rgb(200,200,0)
         draw string (320, 488), "active cursor = " & str(tdrp.ActiveIndex), rgb(200,200,0)
    _COPYWORKINGSCREENPAGETOVISIBLESCREENPAGE(0, 1)
    '
    sleep 15
loop until inkey()=chr(27)

getKey()
'(eof)
jj2007
Posts: 1179
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to "customize" the random generator?

Postby jj2007 » Feb 09, 2019 16:13

Tourist Trap wrote:It is supposed to set the probability to get a number from 0 to 63 for each of these numbers.
Thanks. Yes, that sounds useful. I've implemented that some time ago (below an excerpt from the help file), using a "probability table", i.e. an array whose values determine how likely a random value will be chosen. A simple way to do that is to choose a wider range, e.g.
0 1 2 3 4 4 4 4 5 6 7 8 9 10 (fourteen entries)

Now, with a Rand(14) you'll get more often the 4 than any other value.

Rand(pt:offset pTable) ; set the probability table: pointer to zero-delimited DWORD array
void Rand(pt) ; return weighted index
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: How to "customize" the random generator?

Postby Tourist Trap » Feb 09, 2019 16:18

jj2007 wrote:0 1 2 3 4 4 4 4 5 6 7 8 9 10 (fourteen entries)

Now, with a Rand(14) you'll get more often the 4 than any other value.

Rand(pt:offset pTable) ; set the probability table: pointer to zero-delimited DWORD array
void Rand(pt) ; return weighted index

Ah that's clever. I'll try to see how to finish my object now with this technic. Thanks for sharing, I would probably never have thought of that one :)
Richard
Posts: 2942
Joined: Jan 15, 2007 20:44
Location: Australia

Re: How to "customize" the random generator?

Postby Richard » Feb 10, 2019 6:34

This code gives random integers, biassed by your arbitrary probability distribution.

Code: Select all

' setup an initial probability distribution
Randomize
Dim As Double dist( 0 To 63 )
For i As Integer = 0 To 63
    dist( i ) = 100/64        ' an arbitrary starting value, here percentage
Next i

' you can arbitrarily change this distribution by changing dist()
'   it does not have to sum to probability of 1 or to 100%
'   but you must recompute integral() and sigma after changes are made
Dim As Double sigma = 0, integral( 0 To 63 )
For i As Integer = 0 To 63
    sigma += dist( i )      ' the cumulative probability
    integral( i ) = sigma   ' the integral of the prob distrib
Next i

' to generate a distributed random integer
Dim As Double target
Dim As Integer i

target = sigma * Rnd

' linear search for target element is slow, a binary search would be faster
' this effectively looks up the inverse cumulative distribution function
For i = 0 To 63
    If target <= integral( i ) Then Exit For
Next i

Print "  index ="; i ' i now holds the distributed integer value
Print " target ="; target
Print "  sigma ="; sigma
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: How to "customize" the random generator?

Postby Tourist Trap » Feb 10, 2019 12:04

Richard wrote:This code gives random integers, biassed by your arbitrary probability distribution.

Hi Richard, I'm sure it must work, but for now I don't see what it does in particular. If I wanted to set 100% of probability on the number 10 for example , how do I modify your example? I'm sorry, don't get it well.
Richard
Posts: 2942
Joined: Jan 15, 2007 20:44
Location: Australia

Re: How to "customize" the random generator?

Postby Richard » Feb 10, 2019 20:58

dist( i ) contains the probability distribution of each integer coming up.
Here is the code with output 10 having 100% chance, all others = 0%.

Code: Select all

' setup an initial Probability Distribution Function
Randomize
Dim As Double dist( 0 To 63 )
For i As Integer = 0 To 63
    dist( i ) = 0    ' an arbitrary starting value, here percentage
Next i

dist( 10 ) = 100    ' you want 100% chance of ten

' you can arbitrarily change this distribution by changing dist()
'   it does not have to sum to probability of 1 or to 100%
'   but you must recompute integral() and sigma after changes are made
Dim As Double sigma, integral( 0 To 63 )
sigma = 0
For i As Integer = 0 To 63
    sigma += dist( i )      ' the cumulative probability
    integral( i ) = sigma   ' the integral of the Prob Dist Funct
Next i

' to generate a distributed random integer
Dim As Double target
Dim As Integer i

target = sigma * Rnd
' linear search for target element is slow, a binary search would be faster
' this effectively looks up the inverse cumulative distribution function
For i = 0 To 63
    If target <= integral( i ) Then Exit For
Next i

Print "  index ="; i    ' i now holds the distributed integer value
Print " target ="; target
Print "  sigma ="; sigma
Tourist Trap
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: How to "customize" the random generator?

Postby Tourist Trap » Feb 10, 2019 21:00

Richard wrote:dist( i ) contains the probability distribution of each integer coming up.
Here is the code with output 10 having 100% chance, all others = 0%.

Code: Select all

' setup an initial Probability Distribution Function
Randomize
Dim As Double dist( 0 To 63 )
For i As Integer = 0 To 63
    dist( i ) = 0    ' an arbitrary starting value, here percentage
Next i

dist( 10 ) = 100    ' you want 100% chance of ten

' you can arbitrarily change this distribution by changing dist()
'   it does not have to sum to probability of 1 or to 100%
'   but you must recompute integral() and sigma after changes are made
Dim As Double sigma, integral( 0 To 63 )
sigma = 0
For i As Integer = 0 To 63
    sigma += dist( i )      ' the cumulative probability
    integral( i ) = sigma   ' the integral of the Prob Dist Funct
Next i

' to generate a distributed random integer
Dim As Double target
Dim As Integer i

target = sigma * Rnd
' linear search for target element is slow, a binary search would be faster
' this effectively looks up the inverse cumulative distribution function
For i = 0 To 63
    If target <= integral( i ) Then Exit For
Next i

Print "  index ="; i    ' i now holds the distributed integer value
Print " target ="; target
Print "  sigma ="; sigma

Thanks Richard, I'll study this carefully and give feedback then :)
Richard
Posts: 2942
Joined: Jan 15, 2007 20:44
Location: Australia

Re: How to "customize" the random generator?

Postby Richard » Feb 10, 2019 21:24

Add this to the end of my code to get 100 integers with the specified PDF.

Code: Select all

Print
For n As Integer = 1 To 100
    target = sigma * Rnd
    For i = 0 To 63
        If target <= integral( i ) Then Exit For
    Next i
    Print i;
Next n
Print
jj2007
Posts: 1179
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to "customize" the random generator?

Postby jj2007 » Feb 11, 2019 5:17

See Plotting random data using a probability table for a visualisation of a deliberately skewed distribution.
dodicat
Posts: 5810
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How to "customize" the random generator?

Postby dodicat » Feb 11, 2019 12:59

A cumulative random generator.
The bigger the number in a range, the more chance of getting it.

Code: Select all


'numerical integration (trapezium method)
Function area(fn As Function(x As Double) As Double,L As Double,U As Double,Ordinates As Integer=10) As Double
    Var h=(U-L)/ordinates,x=L
    Var f=fn(U),Sum=h*(f+fn(L))/2
    For n As Integer=1 To ordinates-1
        x+=h
        Sum+=h*fn(x)
    Next n
    Return Sum
End Function

#define Intrange(f,l) int(Rnd*(((l)+1)-(f)))+(f)

Function norm(x As Double) As Double
    Return 1.784124116152771 * Exp((-x^2/.1)) 'function area between 0 and 1 = .5
End Function


Dim As Long counter
Redim As Double cd(1 To 1000000)
'fill up a look up array of cumulating values from 0 to 1  (ish)
For x As Double=0 To 1 Step 1/1000000
    counter+=1
    cd(counter)= 2*area(@norm,0,x)
Next

'=======================
print "look up array filled, 1000000 elements, press a key"
sleep
randomize
#define Irange(f,l) Int(  cd( Intrange(1,1000000) )*(((l)+1)-(f)))   +(f)
dim as string key

do
cls
    locate 3
Dim As Integer a(1 To intrange(5,20))
Dim As integer d,ub=ubound(a)
For n As Long=1 To 5000000
    d= irange(1,ub) 'required range
    a(d)+=1
Next
print "number","  hits"
For n As Long=1 To ub
    Print n, a(n)
Next
print
print "Press a key or esc to end"
sleep

key=inkey
if key=chr(27) then cls:exit do

loop
print "Done"
Sleep
 
Richard
Posts: 2942
Joined: Jan 15, 2007 20:44
Location: Australia

Re: How to "customize" the random generator?

Postby Richard » Feb 12, 2019 23:34

Here is a cleaned up and documented example of my code.

Code: Select all

'-----------------------------------------------------------------------
' generate integers from a set of { 0 to nmax }, where
'   each outcome has an independently specified probability
'-----------------------------------------------------------------------
'   https://en.wikipedia.org/wiki/Probability_density_function
'   https://en.wikipedia.org/wiki/Cumulative_distribution_function
'   https://en.wikipedia.org/wiki/Percentile
'-----------------------------------------------------------------------
Randomize
Const As Integer nmax = 10      ' 0 to nmax are possible outcomes
Dim As Double pdf( 0 To nmax )  ' Probability Density Function
Dim As Double cdf( 0 To nmax )  ' Cumulative Distribution Function
Dim As Double total             ' Total population, has 100% membership

'-----------------------------------------------------------------------
' binary search for first value in array <= target
Function left_most( a() As Double, Byval target As Double ) As Integer
    Dim As Integer Lo = Lbound( a ), Hi = Ubound( a ), m
    Do While Lo < Hi
        m = ( Lo + Hi ) Shr 1
        If a( m ) < target Then Lo = m + 1 Else Hi = m
    Loop
    Return Lo
End Function

'-----------------------------------------------------------------------
' initialise the Probability Density Function
' You may use whatever arbitrary proportional units you want for probability
'   it does NOT have to total to a probability of 1.000 or to 100%
For i As Integer = 0 To nmax
    pdf( i ) = 0
Next i 

pdf( 1 ) = 1
pdf( 2 ) = 2
pdf( 3 ) = 5
pdf( 4 ) = 9    ' change this value from 9 to 0 or 90
pdf( 5 ) = 5
pdf( 6 ) = 2
pdf( 7 ) = 1

'-----------------------------------------------------------------------
' prepare cdf() to generate distributed integers
' you may arbitrarily change the density distribution by changing pdf()
' BUT you MUST recompute cdf() and total after changes have been made
total = 0   ' will become the range or size of the distribution
For i As Integer = 0 To nmax
    total += pdf( i )  ' the Cumulative Distribution Function is the
    cdf( i ) = total   '   integral of the Probability Density Function
Next i

'-----------------------------------------------------------------------
' demonstrate generation of n integers distributed by the specified pdf()
Dim As Integer count = 400, freq( 0 To nmax )   ' keep track of frequency
Print
For i As Integer = 1 To count
    Dim As Double centile = total * Rnd ' position in ordered population
    Dim As Integer v = left_most( cdf(), centile )  ' first target is outcome
    freq( v ) += 1  ' accumulate the frequency distribution
    Print v;        ' v is the outcome value
Next i
Print

'-----------------------------------------------------------------------
' report the pdf(), cdf() and event frequency actually generated
Print "Value ", "PDF ", "CDF ", "Freq "
count = 0
For i As Integer = 0 To 8
    Print i, pdf( i ), cdf( i ), freq( i )
    count += freq( i )
Next i
Print "   total =", total, total, count; " = count"
Print

'-----------------------------------------------------------------------
Sleep
'-----------------------------------------------------------------------
dodicat
Posts: 5810
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: How to "customize" the random generator?

Postby dodicat » Feb 13, 2019 14:29

Neat and simple Richard.
I thought firstly that getting a bias random spread from a uniform distribution would be trivial, but the more I look into it the less trivial it gets.

I use a cumulative function from a base function which is concave up (for the bias as a central bulge, like Richards)
The base function must have an area of 1 between my chosen end limits in theory, but in practice the area should be a minute amount less than 1.
The cumulative values of the area under the base function are stored in an array of about 1000000 elements.
Pick a random element from the array to generate a biased number. (I pick 5000000 times to see the spread)
I use Simpson's method to get the areas.
Here are five different cumulative areas, uncomment the functions you don't want.

Code: Select all

 

#define dround(n,places) mid((str(int((n)*10^(places)+.5)/10^(places))),1,instr(ltrim(str((n)),"-"),".")+(places)+1)
#define Intrange(f,l) int(Rnd*(((l)+1)-(f)))+(f)
#define BiasRange(f,l) Int(  cd( Intrange(1,1000001) )*(((l)+1)-(f))) +(f)


Const pi=4*Atn(1)
                                         
Function f1(x As Double) As Double     
    Return (1-Cos(2*x))/3.141602653589793
End Function

Function f2(x As Double) As Double
    Return   2.3295*(1-1/(1+x^2))
End Function

Function f3(x As Double) As Double
    Return   3.75*(1-1/(1+x^4))
End Function

Function f4(x As Double) As Double
    Return   1.294330830960394*(1-1/(1+Abs(x)^.5))
End Function

Function f5(x As Double) As Double
    If x>0 Then Return x Else Return -x
End Function

Function Area(fn As Function(x As Double) As Double,L As Double,U As Double,Ordinates As Integer=10) As Double
    Var n=Ordinates
    If n Mod 2=0 Then n=n+1
    Var h=(U-L)/n
    Var Part1=fn(L+.5*h)
    Var Part2=0.0
    For i As Integer=1 To n-1
        Part1+=fn(L+h*i+h/2)
        Part2+=fn(L+h*i)
    Next i
    Function= (h/6)*(fn(L)+fn(U)+Part1*4+Part2*2)
End Function

#macro function1
Dim As Long counter
Redim As Double cd(1 To 1000001)
For x As Double=-pi/2 To pi/2 Step pi/1000000
    counter+=1
    Var a=area(@f1,-pi/2,x)
    cd(counter)= a
Next
Print "array size  ";counter
#endmacro

#macro function2
Dim As Long counter
Redim As Double cd(1 To 1000001)
For x As Double=-1 To 1 Step 2/1000000
    counter+=1
    Var a=area(@f2,-1,x)
    If a>=1 Then Print x,a
    cd(counter)= a
Next
Print "array size  "; counter
#endmacro
#macro function3
Dim As Long counter
Redim As Double cd(1 To 1000001)
For x As Double=-1 To 1 Step 2/1000000
    counter+=1
    Var a=area(@f3,-1,x)
    If a>=1 Then Print x,a
    cd(counter)= a
Next
Print "array size  "; counter
#endmacro

#macro function4
Dim As Long counter
Redim As Double cd(1 To 1000001)
For x As Double=-1 To 1 Step 2/1000000
    counter+=1
    Var a=area(@f4,-1,x)
    If a>=1 Then Print x,a
    cd(counter)= a
Next
Print "array size  "; counter
#endmacro

#macro function5
Dim As Long counter
Redim As Double cd(1 To 1000001)
For x As Double=-1 To 1 Step 2/1000000
    counter+=1
    Var a=area(@f5,-1,x)
    If a>=1 Then Print x,a
    cd(counter)= a
Next
Print "array size  "; counter
#endmacro


'function1 'moderate asymtotic(ish) U
'function2 'sharp U
'function3 'shallow U
'function4 'sharp V
function5  'normal V


'=======================
Print "look up array filled, press a key"
Sleep
Randomize
Dim As String key

Do
    Cls
    Locate 3
    Dim As Integer lower=intrange(-5,20)
    Dim As Integer upper=lower+intrange(3,12)
   
    Dim As Integer a(lower  To  upper)
    Dim As Integer d,ub=Ubound(a),lb=Lbound(a)
    For n As Long=1 To 5000000
        d= BiasRange(lb,ub) 'required range
        a(d)+=1             'tally all hits
    Next
   
    Dim As Double pacc
    Print "number","  hits"
    For n As Long=lb To ub
        Var z=(a(n)/5000000)*100
        pacc+=z
        Print n, a(n),dround(z,2);"%"
    Next
    Print ,,"______"
    Print ,,dround(pacc,5);"%"
    Print
    Print "Press a key or esc to end"
   
    key=Input(1)
    If key=Chr(27) Then Cls:Exit Do
   
Loop
print "Some biased doubles"
for n as long=1 to 10
    print cd(intrange(1,ubound(cd)))
    next
Print "Done"
Sleep

 

Return to “General”

Who is online

Users browsing this forum: No registered users and 4 guests