Poisson disk sampling

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
paul doe
Posts: 1265
Joined: Jul 25, 2017 17:22
Location: Argentina

Poisson disk sampling

Postby paul doe » Oct 15, 2020 3:28

Interestingly enough, there's no FreeBasic implementation for this. Since I needed one for my fetish project, here it is:

poisson-sampler.bi

Code: Select all

#ifndef __POISSON_SAMPLER_BI__
#define __POISSON_SAMPLER_BI__

#include once "fb-linkedlist.bi"
#include once "fb-vector.bi"

namespace Poisson
  '' Just a coordinate that represents a sample
  type SamplePoint
    declare constructor()
    declare constructor( byval as single, byval as single )
   
    as single x, y
  end type
 
  constructor SamplePoint() : end constructor
 
  constructor SamplePoint( byval nx as single, byval ny as single )
    x = nx : y = ny
  end constructor
 
  /'
    Like a normal queue or stack, just returns a random element.
    Dynamically grows but never shrinks.
  '/
  type RandomQueue
    declare constructor()
    declare constructor( byval as uinteger )
    declare destructor()
   
    declare property count() as uinteger
   
    declare sub push( byref as SamplePoint )
    declare function pop() as SamplePoint
   
    private:
      declare sub resize( byval as uinteger )
     
      as SamplePoint _rqueue( any )
      as uinteger _
        _size, _initialSize, _count
  end type
 
  constructor RandomQueue()
    constructor( 256 )
  end constructor
 
  constructor RandomQueue( byval aSize as uinteger )
    _size = iif( aSize < 16, 16, aSize )
    _initialSize = _size
   
    redim _rqueue( 0 to _size - 1 )
  end constructor
 
  destructor RandomQueue()
  end destructor
 
  property RandomQueue.count() as uinteger
    return( _count )
  end property
 
  sub RandomQueue.resize( byval newSize as uinteger )
    _size = iif( newSize < _initialSize, _initialSize, newSize )
    redim preserve _rqueue( 0 to _size - 1 )
  end sub
 
  sub RandomQueue.push( byref value as SamplePoint )
    _count += 1
   
    if( _count > _size - 1 ) then
      resize( _size + _initialSize )
    end if
   
    _rqueue( _count - 1 ) = value
  end sub
 
  function RandomQueue.pop() as SamplePoint
    dim as SamplePoint item = SamplePoint( infinity, infinity )
   
    if( _count > 0 ) then
      dim as uinteger index = cuint( rnd() * ( _count - 1 ) )
     
      item = _rqueue( index )
      _rqueue( index ) = _rqueue( _count - 1 )
      _count -= 1
    end if
   
    return( item )
  end function
 
  /'
    Accelerator grid structure.
   
    Used to accelerate lookups for closest points when looking
    for the next sample.
  '/
  type AccelGrid
    declare constructor( byval as uinteger, byval as uinteger )
    declare destructor()
   
    declare property width() as uinteger
    declare property height() as uinteger
   
    declare function points( _
      byval as uinteger, byval as uinteger ) byref as Fb.LinkedList
    declare sub add( byref as SamplePoint, byref as SamplePoint )
   
    as Fb.LinkedList _grid( any, any )
    as uinteger _w, _h, _cellSize
  end type
 
  constructor AccelGrid( byval w as uinteger, byval h as uinteger )
    _w = iif( w < 1, 1, w )
    _h = iif( h < 1, 1, h )
   
    redim _grid( 0 to w - 1, 0 to h - 1 )
  end constructor
 
  destructor AccelGrid()
    for y as integer = 0 to _h - 1
      for x as integer = 0 to _w - 1
        do while( _grid( x, y ).count > 0 )
          delete( cast( SamplePoint ptr, _grid( x, y ).removeFirst() ) )
        loop
      next
    next
  end destructor
 
  property AccelGrid.width() as uinteger
    return( _w )
  end property
 
  property AccelGrid.height() as uinteger
    return( _h )
  end property
 
  function AccelGrid.points( _
    byval x as uinteger, byval y as uinteger ) byref as Fb.LinkedList
   
    return( _grid( x, y ) )
  end function
 
  sub AccelGrid.add( byref l as SamplePoint, byref p as SamplePoint )
    _grid( int( l.x ), int( l.y ) ).addLast( new SamplePoint( p.x, p.y ) )
  end sub
 
  '' Returns a sample in the accelerator grid coordinates
  function sampleToGrid( _
    byref p as SamplePoint, byval cellSize as single ) as SamplePoint
   
    return( SamplePoint( int( p.x / cellSize ), int( p.y / cellSize ) ) )
  end function
 
  '' Generates a random point within the anulus of the given point and
  '' the given radius.
  function generateRandomPointAround( _
    byref p as SamplePoint, byval minDist as single ) as SamplePoint
   
    static as const single cPi = 4.0f * atn( 1.0f )
   
    dim as single _
      r1 = rnd(), r2 = rnd(), _
      radius = minDist * ( r1 + 1 ), _
      angle = 2 * cPi * r2
   
    return( SamplePoint( _
      p.x + radius * cos( angle ), _
      p.y + radius * sin( angle ) ) )
  end function
 
  '' Returns the squared distance between two sample points
  function distanceSq( _
    byref p1 as SamplePoint, byref p2 as SamplePoint ) as single
   
    return( ( ( p2.x - p1.x ) ^ 2 + ( p2.y - p1.y ) ^ 2 ) )
  end function
 
  function inNeighborhood( _
      byref g as AccelGrid, _
      byref p as SamplePoint, _
      byval minDist as single, _
      byval cellSize as single ) _
    as boolean
   
    for y as integer = -2 to 2
      for x as integer = -2 to 2
        with sampleToGrid( p, cellSize )
          dim as integer _
            xx = .x + x, _
            yy = .y + y
         
          if( _
            xx >= 0 andAlso xx <= g.width - 1 andAlso _
            yy >= 0 andAlso yy <= g.height - 1 ) then
           
            var byref cell = g.points( xx, yy )
            var n = cell.first
           
            do while( n <> 0 )
              dim as SamplePoint ptr cp = *n
             
              if( distanceSq( *cp, p ) <= minDist ^ 2 ) then
                return( true )
              end if
             
              n = n->forward
            loop
          end if
        end with
      next
    next
   
    return( false )
  end function
 
  function sample( _
      byval w as integer, _
      byval h as integer, _
      byval min_dist as single, _
      byval new_points_count as integer ) _
    as Fb.Vector ptr
   
    dim as single cellSize = min_dist / sqr( 2 )
   
    var g = AccelGrid( _
      cuint( w / cellSize ) + 1, cuint( h / cellSize ) + 1 )
   
    var processList = RandomQueue()
    var samplePoints = new Fb.Vector()
   
    var firstPoint = SamplePoint( _
      int( rnd() * ( w - 1 ) ), int( rnd() * ( h - 1 ) ) )
   
    processList.push( firstPoint )
    samplePoints->add( new SamplePoint( firstPoint.x, firstPoint.y ) )
    g.add( sampleToGrid( firstPoint, cellSize ), firstPoint )
   
    do while( processList.count > 0 )
      var p = processList.pop()
     
      for i as integer = 0 to new_points_count - 1
        var newPoint = generateRandomPointAround( p, min_dist )
       
        if( cbool( _
          newPoint.x >= 0 andAlso newPoint.x <= w - 1 andAlso _
          newPoint.y >= 0 andAlso newPoint.y <= h - 1 ) andAlso _
          not inNeighborhood( g, newPoint, min_dist, cellSize ) ) then
         
          processList.push( newPoint )
          samplePoints->add( new SamplePoint( newPoint.x, newPoint.y ) )
          g.add( sampleToGrid( newPoint, cellSize ), newPoint )
        end if
      next
    loop
   
    return( samplePoints )
  end function
end namespace

#endif


Reference link:
http://devmag.org.za/2009/05/03/poisson-disk-sampling/

EDIT: small bug fix. Should not try to generate invalid (out of range) samples when the minimum distance is too large relative to the sample area.
Last edited by paul doe on Oct 15, 2020 21:12, edited 1 time in total.
UEZ
Posts: 618
Joined: May 05, 2017 19:59
Location: Germany

Re: Poisson disk sampling

Postby UEZ » Oct 15, 2020 6:40

Very interesting stuff - thanks for sharing.
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Poisson disk sampling

Postby dodicat » Oct 15, 2020 9:04

Thanks paul doe.
I got it up and running OK
A Poisson distribution example is frequently quoted as being the pattern of destruction caused by doodlebugs in London in WW2.
I cannot argue with this, in fact I cannot dwell too long thinking about it.
However another example often quoted is (cowpats in a grass field), which obviously must have been thought up by city dwellers because I definitely disagree with that.
Anybody living in the countryside knows that there are far greater concentrations of pats (of you know what) at troughs and gates.
Maybe Poisson throughout the rest of the field, but where do you draw the field border?
But that problem in Scotland has been solved, there are no longer cowpats in fields.
The dairy cattle are kept inside all year now in most farms, the grass fields are now devoted to silage crops with the pats going back as slurry.
Thus of course I have stopped consuming Scottish dairy products.
I have probably drifted off topic, but statistics is there to represent bits of the real world.
Anyway thanks paul doe.
paul doe
Posts: 1265
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Poisson disk sampling

Postby paul doe » Oct 15, 2020 10:56

@UEZ: you're welcome. You might find a use for it, since you're interested in graphical demos (it can provide a nicer looking stochastic sampling than 'pure' random.

dodicat wrote:...
I have probably drifted off topic, but statistics is there to represent bits of the real world.
Anyway thanks paul doe.

You're welcome. These kind of distributions do tend to appear in a lot of places in the real world, indeed. There's also some nice ideas I'd like to try (like combining it with Perlin Noise for natural looking clumps of vegetation, say).

Here's a little noise framework I did a while ago:
https://github.com/glasyalabolas/fb-noise

And some examples of mixing them to create your own noise functions can be found on FreeBasic's Discord server:
https://discord.com/channels/456168006872203265/686420676856381523/686421203728203876

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 3 guests