Author Topic: Poisson Disk Sampling - Bridson Algorithm - Blue Noise (Read 11649 times)

ymg · « **Reply #15 on:** May 07, 2015, 03:42:13 AM »

qjchen,

Thanks, I am not too familiar with finite element but it could be.

Sampling function and Noise functions are extensively used in
Texture generation and Graphic Filters (Photoshop).

ymg

ribarm · « **Reply #16 on:** May 07, 2015, 04:45:53 AM »

Anyway it seems that the best thing to overcome this intensive waving is actually to code it for waving... Here is my wave version, but put 1 or 2 waves when asked...

Code - Auto/Visual Lisp: [Select]

;;                                                                            ;
;; Poisson Disk Sampling per Bridson Algorithm                                ;
;;                                                                            ;
;; See: http://www.cs.ubc.ca/~rbridson/docs/bridson-siggraph07-poissondisk.pdf;
;;      http://devmag.org.za/2009/05/03/poisson-disk-sampling/                ;
;;                                                                            ;
;; Will return a Random Set of points with a minimum distance between them    ;
;;                                                                            ;
 
(defun bridson (ll    ur    mindist     /     a     al    cells cellsize
                grid  i     ind   k     p     p1    p2    pl    r
                tcl   x     y
               )
  (setq k        30
        width    (- (car ur) (car ll))
        height   (- (cadr ur) (cadr ll))
        cellSize (/ mindist (sqrt 2))
        x        (ceil (/ width cellsize))
        y        (ceil (/ height cellsize))
        x0       (car ll)
        y0       (cadr ll)
        grid     (vlax-make-safearray vlax-vbInteger (cons 0 x) (cons 0 y))
        p1       (list (rand width) (rand height))
        pl       (list p1)
        al       (list 0)               ; Initialize Active List with index of First Point;
        ind      (mapcar '(lambda (a) (fix (/ a cellsize))) p1)
 
  )
  (init2d grid x y)                     ; Initialize the grid to all -1, then             ;
 
  (vlax-safearray-put-element grid (car ind) (cadr ind) 0)
 
  (setq i 0)
  (while al
    (setq p  (nth (fix (rand (length al))) al)
          p1 (nth p pl)
          p1 (list (car p1) (cadr p1))
    )
    (repeat k
      (setq a   (rand (+ pi pi))
            r   (* mindist (+ 1.0 (rand 1.0)))
            p2  (polar p1 a r)
            ind (mapcar '(lambda (a) (fix (/ a cellsize))) p2)
      )
      (if (and (<= 0 (car p2) width) (<= 0 (cadr p2) height))
        (progn
          (setq cells (ptsaround grid ind))
          (if cells
            (setq tcl (tooclosep p2 cells pl))
            (setq tcl nil)
          )
          (if (not tcl)
            (progn
              (setq i  (1+ i)
                    al (cons i al)
                    pl (append pl (list p2))
              )
 
              (vlax-safearray-put-element grid (car ind) (cadr ind) i)
            )
          )
        )
      )
    )
    (setq al (vl-remove p al))
 
  )
 
  (mapcar '(lambda (a) (list (+ (car a) x0) (+ (cadr a) y0) 0.0))
          pl
  )
)
 
(defun init2d (grid x y / i j)
  (setq i -1)
  (repeat x
    (setq i (1+ i)
          j -1
    )
    (repeat y
      (setq j (1+ j))
      (vlax-safearray-put-element grid i j -1)
    )
  )
)
 
 
(defun ptsaround (grid ind / i j rtn tmp)
 
  (setq j (- (cadr ind) 2))
  (repeat 5
    (setq i (- (car ind) 2))
    (repeat 5
      (if (and (< -1 i x) (< -1 j y))
        (if
          (not (= (setq tmp (vlax-safearray-get-element grid i j)) -1)
          )
           (setq rtn (cons tmp rtn))
        )
      )
      (setq i (1+ i))
    )
    (setq j (1+ j))
  )
  rtn
)
 
(defun tooclosep (p cells pl / pc rtn)
  (while cells
    (setq pc    (nth (car cells) pl)
          cells (cdr cells)
    )
    (if (< (distance pc p) mindist)
      (setq rtn t
            cells nil
      )
    )
  )
  rtn
)
;; Random number generator, Seed must remain global.    LeeMac                ;
;; Will return a real in the range 0...rng                                    ;
 
(defun rand (rng / x)
  (* (/ (setq x    4294967296.0
              seed (rem (1+ (* 1664525.0
                               (cond (seed)
                                     ((getvar 'DATE))
                               )
                            )
                        )
                        x
                   )
        )
        x
     )
     rng
  )
)
 
;; Floor function, Returns the largest integer not greater than x.            ;
(defun floor (x)
  (if (minusp (rem x 1))
    (- (fix x) 1)
    (fix x)
  )
)
;; Ceiling function, Returns the smallest integer not less than x.            ;
(defun ceil (x)
  (if (> (rem x 1) 0)
    (+ (fix x) 1)
    (fix x)
  )
)
 
(defun c:test (/ ** p1 p2 bb md zz nw dw kk jj ii z zi zl i dl dr dlst j k e pl pll)
 
  (vl-load-com)
 
  (command "_.UCS" "_W")
  (setq p1 (getpoint "\nPick a Window Defining Zone: ")
        p2 (getcorner p1)
        ** (vl-cmdf "_.RECTANGLE" "_non" p1 "_non" p2)
        pl (list p1 p2)
        bb (list (apply 'mapcar (cons 'min pl))
                 (apply 'mapcar (cons 'max pl))
           )
        ** (vl-cmdf "_.UCS" "_M" "_non" (car bb))
        bb (mapcar '(lambda (p) (trans p 0 1)) bb)
        md (getdist
             "\nPick or specify Minimum Distance Between Points : "
           )
        zz (getdist
             "\nPick or specify Maximum Elevation above and below 0.0 : "
           )
        ** (initget 7)
        nw (getint
             "\nSpecify number of waves along X axis : "
           )
        ** (entlast)
        pl (bridson (car bb) (cadr bb) md)
        pl (vl-sort pl '(lambda (a b) (< (car a) (car b))))
        kk -1
  )
 
  (repeat nw
    (setq jj 0)
    (setq kk (1+ kk))
    (repeat 16
      (setq jj (1+ jj))
      (setq ii (+ (* kk 16) jj))
      (cond
        ((= jj 1)
         (repeat 5
           (setq z (* zz (rand 1.0) 0.25))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 2)
         (repeat 5
           (setq z (+ (* zz 0.25) (* zz (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 3)
         (repeat 5
           (setq z (+ (* zz 0.5) (* zz (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 4)
         (repeat 5
           (setq z (+ (* zz 0.75) (* zz (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 5)
         (repeat 5
           (setq z (+ (* zz 0.75) (* zz (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 6)
         (repeat 5
           (setq z (+ (* zz 0.5) (* zz (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 7)
         (repeat 5
           (setq z (+ (* zz 0.25) (* zz (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 8)
         (repeat 5
           (setq z (* zz (rand 1.0) 0.25))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 9)
         (repeat 5
           (setq z (* (- zz) (rand 1.0) 0.25))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 10)
         (repeat 5
           (setq z (+ (* (- zz) 0.25) (* (- zz) (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 11)
         (repeat 5
           (setq z (+ (* (- zz) 0.5) (* (- zz) (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 12)
         (repeat 5
           (setq z (+ (* (- zz) 0.75) (* (- zz) (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 13)
         (repeat 5
           (setq z (+ (* (- zz) 0.75) (* (- zz) (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 14)
         (repeat 5
           (setq z (+ (* (- zz) 0.5) (* (- zz) (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 15)
         (repeat 5
           (setq z (+ (* (- zz) 0.25) (* (- zz) (rand 1.0) 0.25)))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
        ((= jj 16)
         (repeat 5
           (setq z (* (- zz) (rand 1.0) 0.25))
           (setq zi (cons ii z))
           (setq zl (cons zi zl))
         )
        )
      )
    )
  )
 
  (setq dw (/ (caadr bb) ii))
  (setq i 0)
  (repeat ii
    (setq i (1+ i))
    (setq dl (* (1- i) dw)
          dr (* i dw)
    )
    (setq dlst (cons (cons i (list dl dr)) dlst))
  )
  (setq dlst (reverse dlst))
  (foreach p pl
    (setq j (vl-some '(lambda ( x ) (if (< (cadr x) (car p) (caddr x)) (car x))) dlst))
    (setq k (acet-list-m-assoc j zl))
    (setq e (cdr (nth (fix (rand (length k))) k)))
    (setq p (list (car p) (cadr p) e))
    (setq pll (cons p pll))
  )
 
  (setq pll (reverse pll))
 
  (mapcar '(lambda (a)
             (entmake (list '(0 . "POINT") '(8 . "Point") (cons 10 a)))
           )
          (mapcar '(lambda (b) (trans b 1 0)) pll)
  )
                                        ;(entdel **)
  (princ)
)
 

M.R.

ymg · « **Reply #17 on:** May 07, 2015, 07:01:01 AM »

Marko,

Nice !!!, here generated with your wave proggie.

Possibilities are endless.

ymg

ribarm · « **Reply #18 on:** May 07, 2015, 07:52:34 AM »

Now that I've posted linear X axis version, here is radial one based on the same algorithm... File is little larger, so I'll attach it...

M.R.

ymg · « **Reply #19 on:** May 07, 2015, 04:26:57 PM »

Marko,

I didn't have a chance yet to test your radial wave but I will.

I was on the Net researching some more on "Perlin Noise"
and I stumbled on this to generate a landscape on a sphere.

I know you like to work with them sphere, so have a look
here: http://freespace.virgin.net/hugo.elias/models/m_landsp.htm

It is again by the same guy Hugo Elias.

ymg

ribarm · « **Reply #20 on:** May 08, 2015, 11:00:48 AM »

I don't know ab spheres, but for a mathematical functions projected on elevations, combination of RND planar distribution and elevations obtained by points 2D data for waves is certainly possible by sinus function... So no need to double RND algorthim - it can be used just for poison 2D distribution... I am curious how no one haven't posted remark ab this... And codes are smaller than I've imagined...

For X axis waving...

Code - Auto/Visual Lisp: [Select]

;;                                                                            ;
;; Poisson Disk Sampling per Bridson Algorithm                                ;
;;                                                                            ;
;; See: http://www.cs.ubc.ca/~rbridson/docs/bridson-siggraph07-poissondisk.pdf;
;;      http://devmag.org.za/2009/05/03/poisson-disk-sampling/                ;
;;                                                                            ;
;; Will return a Random Set of points with a minimum distance between them    ;
;;                                                                            ;
 
(defun bridson (ll    ur    mindist     /     a     al    cells cellsize
                grid  i     ind   k     p     p1    p2    pl    r
                tcl   x     y
               )
  (setq k        30
        width    (- (car ur) (car ll))
        height   (- (cadr ur) (cadr ll))
        cellSize (/ mindist (sqrt 2))
        x        (ceil (/ width cellsize))
        y        (ceil (/ height cellsize))
        x0       (car ll)
        y0       (cadr ll)
        grid     (vlax-make-safearray vlax-vbInteger (cons 0 x) (cons 0 y))
        p1       (list (rand width) (rand height))
        pl       (list p1)
        al       (list 0)               ; Initialize Active List with index of First Point;
        ind      (mapcar '(lambda (a) (fix (/ a cellsize))) p1)
 
  )
  (init2d grid x y)                     ; Initialize the grid to all -1, then             ;
 
  (vlax-safearray-put-element grid (car ind) (cadr ind) 0)
 
  (setq i 0)
  (while al
    (setq p  (nth (fix (rand (length al))) al)
          p1 (nth p pl)
          p1 (list (car p1) (cadr p1))
    )
    (repeat k
      (setq a   (rand (+ pi pi))
            r   (* mindist (+ 1.0 (rand 1.0)))
            p2  (polar p1 a r)
            ind (mapcar '(lambda (a) (fix (/ a cellsize))) p2)
      )
      (if (and (<= 0 (car p2) width) (<= 0 (cadr p2) height))
        (progn
          (setq cells (ptsaround grid ind))
          (if cells
            (setq tcl (tooclosep p2 cells pl))
            (setq tcl nil)
          )
          (if (not tcl)
            (progn
              (setq i  (1+ i)
                    al (cons i al)
                    pl (append pl (list p2))
              )
 
              (vlax-safearray-put-element grid (car ind) (cadr ind) i)
            )
          )
        )
      )
    )
    (setq al (vl-remove p al))
 
  )
 
  (mapcar '(lambda (a) (list (+ (car a) x0) (+ (cadr a) y0) 0.0))
          pl
  )
)
 
(defun init2d (grid x y / i j)
  (setq i -1)
  (repeat x
    (setq i (1+ i)
          j -1
    )
    (repeat y
      (setq j (1+ j))
      (vlax-safearray-put-element grid i j -1)
    )
  )
)
 
 
(defun ptsaround (grid ind / i j rtn tmp)
 
  (setq j (- (cadr ind) 2))
  (repeat 5
    (setq i (- (car ind) 2))
    (repeat 5
      (if (and (< -1 i x) (< -1 j y))
        (if
          (not (= (setq tmp (vlax-safearray-get-element grid i j)) -1)
          )
           (setq rtn (cons tmp rtn))
        )
      )
      (setq i (1+ i))
    )
    (setq j (1+ j))
  )
  rtn
)
 
(defun tooclosep (p cells pl / pc rtn)
  (while cells
    (setq pc    (nth (car cells) pl)
          cells (cdr cells)
    )
    (if (< (distance pc p) mindist)
      (setq rtn t
            cells nil
      )
    )
  )
  rtn
)
;; Random number generator, Seed must remain global.    LeeMac                ;
;; Will return a real in the range 0...rng                                    ;
 
(defun rand (rng / x)
  (* (/ (setq x    4294967296.0
              seed (rem (1+ (* 1664525.0
                               (cond (seed)
                                     ((getvar 'DATE))
                               )
                            )
                        )
                        x
                   )
        )
        x
     )
     rng
  )
)
 
;; Floor function, Returns the largest integer not greater than x.            ;
(defun floor (x)
  (if (minusp (rem x 1))
    (- (fix x) 1)
    (fix x)
  )
)
;; Ceiling function, Returns the smallest integer not less than x.            ;
(defun ceil (x)
  (if (> (rem x 1) 0)
    (+ (fix x) 1)
    (fix x)
  )
)
 
(defun c:test (/ ** p1 p2 bb md zz nw dw e pl pll)
 
  (vl-load-com)
 
  (command "_.UCS" "_W")
  (setq p1 (getpoint "\nPick a Window Defining Zone: ")
        p2 (getcorner p1)
        ** (vl-cmdf "_.RECTANGLE" "_non" p1 "_non" p2)
        pl (list p1 p2)
        bb (list (apply 'mapcar (cons 'min pl))
                 (apply 'mapcar (cons 'max pl))
           )
        ** (vl-cmdf "_.UCS" "_M" "_non" (car bb))
        bb (mapcar '(lambda (p) (trans p 0 1)) bb)
        md (getdist
             "\nPick or specify Minimum Distance Between Points : "
           )
        zz (getdist
             "\nPick or specify Maximum Elevation above and below 0.0 : "
           )
        ** (initget 7)
        nw (getint
             "\nSpecify number of waves along X axis : "
           )
        ** (entlast)
        pl (bridson (car bb) (cadr bb) md)
        pl (vl-sort pl '(lambda (a b) (< (car a) (car b))))
  )
 
  (setq dw (/ (caadr bb) nw))
  (foreach p pl
    (setq e (* zz (sin (* (/ (rem (car p) dw) dw) 2.0 pi))))
    (setq p (list (car p) (cadr p) e))
    (setq pll (cons p pll))
  )
 
  (setq pll (reverse pll))
 
  (mapcar '(lambda (a)
             (entmake (list '(0 . "POINT") '(8 . "Point") (cons 10 a)))
           )
          (mapcar '(lambda (b) (trans b 1 0)) pll)
  )
                                        ;(entdel **)
  (princ)
)
 

For radial waving...

Code - Auto/Visual Lisp: [Select]

;;                                                                            ;
;; Poisson Disk Sampling per Bridson Algorithm                                ;
;;                                                                            ;
;; See: http://www.cs.ubc.ca/~rbridson/docs/bridson-siggraph07-poissondisk.pdf;
;;      http://devmag.org.za/2009/05/03/poisson-disk-sampling/                ;
;;                                                                            ;
;; Will return a Random Set of points with a minimum distance between them    ;
;;                                                                            ;
 
(defun bridson (ll    ur    mindist     /     a     al    cells cellsize
                grid  i     ind   k     p     p1    p2    pl    r
                tcl   x     y
               )
  (setq k        30
        width    (- (car ur) (car ll))
        height   (- (cadr ur) (cadr ll))
        cellSize (/ mindist (sqrt 2))
        x        (ceil (/ width cellsize))
        y        (ceil (/ height cellsize))
        x0       (car ll)
        y0       (cadr ll)
        grid     (vlax-make-safearray vlax-vbInteger (cons 0 x) (cons 0 y))
        p1       (list (rand width) (rand height))
        pl       (list p1)
        al       (list 0)               ; Initialize Active List with index of First Point;
        ind      (mapcar '(lambda (a) (fix (/ a cellsize))) p1)
 
  )
  (init2d grid x y)                     ; Initialize the grid to all -1, then             ;
 
  (vlax-safearray-put-element grid (car ind) (cadr ind) 0)
 
  (setq i 0)
  (while al
    (setq p  (nth (fix (rand (length al))) al)
          p1 (nth p pl)
          p1 (list (car p1) (cadr p1))
    )
    (repeat k
      (setq a   (rand (+ pi pi))
            r   (* mindist (+ 1.0 (rand 1.0)))
            p2  (polar p1 a r)
            ind (mapcar '(lambda (a) (fix (/ a cellsize))) p2)
      )
      (if (and (<= 0 (car p2) width) (<= 0 (cadr p2) height))
        (progn
          (setq cells (ptsaround grid ind))
          (if cells
            (setq tcl (tooclosep p2 cells pl))
            (setq tcl nil)
          )
          (if (not tcl)
            (progn
              (setq i  (1+ i)
                    al (cons i al)
                    pl (append pl (list p2))
              )
 
              (vlax-safearray-put-element grid (car ind) (cadr ind) i)
            )
          )
        )
      )
    )
    (setq al (vl-remove p al))
 
  )
 
  (mapcar '(lambda (a) (list (+ (car a) x0) (+ (cadr a) y0) 0.0))
          pl
  )
)
 
(defun init2d (grid x y / i j)
  (setq i -1)
  (repeat x
    (setq i (1+ i)
          j -1
    )
    (repeat y
      (setq j (1+ j))
      (vlax-safearray-put-element grid i j -1)
    )
  )
)
 
 
(defun ptsaround (grid ind / i j rtn tmp)
 
  (setq j (- (cadr ind) 2))
  (repeat 5
    (setq i (- (car ind) 2))
    (repeat 5
      (if (and (< -1 i x) (< -1 j y))
        (if
          (not (= (setq tmp (vlax-safearray-get-element grid i j)) -1)
          )
           (setq rtn (cons tmp rtn))
        )
      )
      (setq i (1+ i))
    )
    (setq j (1+ j))
  )
  rtn
)
 
(defun tooclosep (p cells pl / pc rtn)
  (while cells
    (setq pc    (nth (car cells) pl)
          cells (cdr cells)
    )
    (if (< (distance pc p) mindist)
      (setq rtn t
            cells nil
      )
    )
  )
  rtn
)
;; Random number generator, Seed must remain global.    LeeMac                ;
;; Will return a real in the range 0...rng                                    ;
 
(defun rand (rng / x)
  (* (/ (setq x    4294967296.0
              seed (rem (1+ (* 1664525.0
                               (cond (seed)
                                     ((getvar 'DATE))
                               )
                            )
                        )
                        x
                   )
        )
        x
     )
     rng
  )
)
 
;; Floor function, Returns the largest integer not greater than x.            ;
(defun floor (x)
  (if (minusp (rem x 1))
    (- (fix x) 1)
    (fix x)
  )
)
;; Ceiling function, Returns the smallest integer not less than x.            ;
(defun ceil (x)
  (if (> (rem x 1) 0)
    (+ (fix x) 1)
    (fix x)
  )
)
 
(defun c:test (/ ** p1 p2 bb md zz wl cp dd nw ch f e pl pll)
 
  (vl-load-com)
 
  (command "_.UCS" "_W")
  (setq p1 (getpoint "\nPick a Window Defining Zone: ")
        p2 (getcorner p1)
        ** (vl-cmdf "_.RECTANGLE" "_non" p1 "_non" p2)
        pl (list p1 p2)
        bb (list (apply 'mapcar (cons 'min pl))
                 (apply 'mapcar (cons 'max pl))
           )
        ** (vl-cmdf "_.UCS" "_M" "_non" (car bb))
        bb (mapcar '(lambda (p) (trans p 0 1)) bb)
        md (getdist
             "\nPick or specify Minimum Distance Between Points : "
           )
        zz (getdist
             "\nPick or specify Maximum Elevation above and below 0.0 : "
           )
        wl (getdist
             "\nPick or specify Length of wave period : "
           )
        cp (getpoint
             "\nPick or specify center point of radial waving : "
           )
        dd (car (vl-sort (list (distance cp (car bb)) (distance cp (list (caadr bb) (cadar bb))) (distance cp (cadr bb)) (distance cp (list (caar bb) (cadadr bb)))) '>))
        ** (initget 7)
        nw (getint
             (strcat
               "\nSpecify number of waves along radial axis (must be > "
               (itoa (fix (/ dd wl)))
               ") : "
             )
           )
        ** (entlast)
  )
  (while (<= nw (fix (/ dd wl)))
    (initget 7)
    (setq nw (getint
              (strcat
                "\nSpecify number of waves along radial axis (must be > "
                (itoa (fix (/ dd wl)))
                ") : "
              )
            )
    )
  )
 
  (setq
        pl (bridson (car bb) (cadr bb) md)
        pl (vl-sort pl '(lambda (a b) (< (distance cp a) (distance cp b))))
  )
 
  (initget 1 "Up Down Top Bottom")
  (setq ch (getkword "\nSpecify starting waving option [Up/Down/Top/Bottom] : "))
  (cond
    ( (eq ch "Up")
      (defun f ( x ) (sin x))
    )
    ( (eq ch "Down")
      (defun f ( x ) (- (sin x)))
    )
    ( (eq ch "Top")
      (defun f ( x ) (sin (+ x (* 0.5 pi))))
    )
    ( (eq ch "Bottom")
      (defun f ( x ) (sin (- x (* 0.5 pi))))
    )
  )
 
  (foreach p pl
    (setq e (* zz (f (* (/ (rem (distance cp p) wl) wl) 2.0 pi))))
    (setq p (list (car p) (cadr p) e))
    (setq pll (cons p pll))
  )
 
  (setq pll (reverse pll))
 
  (mapcar '(lambda (a)
             (entmake (list '(0 . "POINT") '(8 . "Point") (cons 10 a)))
           )
          (mapcar '(lambda (b) (trans b 1 0)) pll)
  )
                                        ;(entdel **)
  (princ)
)
 

M.R.

ymg · « **Reply #21 on:** May 08, 2015, 12:12:15 PM »

Quote

... I am curious how no one haven't posted remark ab this...

Marko,

I posted Bridson in 2013, never generated any interest.

Seems to be changing.

ymg

danallen · « **Reply #22 on:** May 08, 2015, 12:32:16 PM »

for me this post caught my attention showing how an algorithm can differentiate two kinds of random (with a picture!)
http://www.theswamp.org/index.php?topic=45379.msg544989#msg544989

Quote from: ymg on May 08, 2015, 12:12:15 PM

Quote
I posted Bridson in 2013, never generated any interest.

ymg · « **Reply #23 on:** May 08, 2015, 01:01:31 PM »

Quote from: dan allen on May 08, 2015, 12:32:16 PM

for me this post caught my attention showing how an algorithm can differentiate two kinds of random (with a picture!)
http://www.theswamp.org/index.php?topic=45379.msg544989#msg544989

Dan,

Guess the saying "A Picture is Worth a Thousand Words" holds.

ymg

ribarm · « **Reply #24 on:** May 08, 2015, 01:05:40 PM »

Quote from: ribarm on May 08, 2015, 11:00:48 AM

I am curious how no one haven't posted remark ab this...

What I mean, I've used RND twice in my previous versions and I thought that someone will notice that I could use sine function instead of imitating waves with RND for elevations...

ymg · « **Reply #25 on:** May 08, 2015, 01:25:55 PM »

Marko,

You can apply just about any function.

Random is interesting to get variety.

ymg

ribarm · « **Reply #26 on:** May 09, 2015, 05:07:21 AM »

Here is my attempt to implement any function... I didn't know how to separate trigonometric func like sinus from other non-trigonometric, so I've constructed strange (if (or ... ) trigonometric non-trigonometric) statement... I've tested it for only (sin x) and (expt x 2) and it worked... If someone sees something that should be different or have strange results, please post remark...

For X axis elevation distribution :

Code - Auto/Visual Lisp: [Select]

;;                                                                            ;
;; Poisson Disk Sampling per Bridson Algorithm                                ;
;;                                                                            ;
;; See: http://www.cs.ubc.ca/~rbridson/docs/bridson-siggraph07-poissondisk.pdf;
;;      http://devmag.org.za/2009/05/03/poisson-disk-sampling/                ;
;;                                                                            ;
;; Will return a Random Set of points with a minimum distance between them    ;
;;                                                                            ;
 
(defun bridson (ll    ur    mindist     /     a     al    cells cellsize
                grid  i     ind   k     p     p1    p2    pl    r
                tcl   x     y
               )
  (setq k        30
        width    (- (car ur) (car ll))
        height   (- (cadr ur) (cadr ll))
        cellSize (/ mindist (sqrt 2))
        x        (ceil (/ width cellsize))
        y        (ceil (/ height cellsize))
        x0       (car ll)
        y0       (cadr ll)
        grid     (vlax-make-safearray vlax-vbInteger (cons 0 x) (cons 0 y))
        p1       (list (rand width) (rand height))
        pl       (list p1)
        al       (list 0)               ; Initialize Active List with index of First Point;
        ind      (mapcar '(lambda (a) (fix (/ a cellsize))) p1)
 
  )
  (init2d grid x y)                     ; Initialize the grid to all -1, then             ;
 
  (vlax-safearray-put-element grid (car ind) (cadr ind) 0)
 
  (setq i 0)
  (while al
    (setq p  (nth (fix (rand (length al))) al)
          p1 (nth p pl)
          p1 (list (car p1) (cadr p1))
    )
    (repeat k
      (setq a   (rand (+ pi pi))
            r   (* mindist (+ 1.0 (rand 1.0)))
            p2  (polar p1 a r)
            ind (mapcar '(lambda (a) (fix (/ a cellsize))) p2)
      )
      (if (and (<= 0 (car p2) width) (<= 0 (cadr p2) height))
        (progn
          (setq cells (ptsaround grid ind))
          (if cells
            (setq tcl (tooclosep p2 cells pl))
            (setq tcl nil)
          )
          (if (not tcl)
            (progn
              (setq i  (1+ i)
                    al (cons i al)
                    pl (append pl (list p2))
              )
 
              (vlax-safearray-put-element grid (car ind) (cadr ind) i)
            )
          )
        )
      )
    )
    (setq al (vl-remove p al))
 
  )
 
  (mapcar '(lambda (a) (list (+ (car a) x0) (+ (cadr a) y0) 0.0))
          pl
  )
)
 
(defun init2d (grid x y / i j)
  (setq i -1)
  (repeat x
    (setq i (1+ i)
          j -1
    )
    (repeat y
      (setq j (1+ j))
      (vlax-safearray-put-element grid i j -1)
    )
  )
)
 
 
(defun ptsaround (grid ind / i j rtn tmp)
 
  (setq j (- (cadr ind) 2))
  (repeat 5
    (setq i (- (car ind) 2))
    (repeat 5
      (if (and (< -1 i x) (< -1 j y))
        (if
          (not (= (setq tmp (vlax-safearray-get-element grid i j)) -1)
          )
           (setq rtn (cons tmp rtn))
        )
      )
      (setq i (1+ i))
    )
    (setq j (1+ j))
  )
  rtn
)
 
(defun tooclosep (p cells pl / pc rtn)
  (while cells
    (setq pc    (nth (car cells) pl)
          cells (cdr cells)
    )
    (if (< (distance pc p) mindist)
      (setq rtn t
            cells nil
      )
    )
  )
  rtn
)
;; Random number generator, Seed must remain global.    LeeMac                ;
;; Will return a real in the range 0...rng                                    ;
 
(defun rand (rng / x)
  (* (/ (setq x    4294967296.0
              seed (rem (1+ (* 1664525.0
                               (cond (seed)
                                     ((getvar 'DATE))
                               )
                            )
                        )
                        x
                   )
        )
        x
     )
     rng
  )
)
 
;; Floor function, Returns the largest integer not greater than x.            ;
(defun floor (x)
  (if (minusp (rem x 1))
    (- (fix x) 1)
    (fix x)
  )
)
;; Ceiling function, Returns the smallest integer not less than x.            ;
(defun ceil (x)
  (if (> (rem x 1) 0)
    (+ (fix x) 1)
    (fix x)
  )
)
 
(defun c:test (/ ** p1 p2 bb md zz nw f fun dw r h e pl pll)
 
  (vl-load-com)
 
  (command "_.UCS" "_W")
  (setq p1 (getpoint "\nPick a Window Defining Zone: ")
        p2 (getcorner p1)
        ** (vl-cmdf "_.RECTANGLE" "_non" p1 "_non" p2)
        pl (list p1 p2)
        bb (list (apply 'mapcar (cons 'min pl))
                 (apply 'mapcar (cons 'max pl))
           )
        ** (vl-cmdf "_.UCS" "_M" "_non" (car bb))
        bb (mapcar '(lambda (p) (trans p 0 1)) bb)
        md (getdist
             "\nPick or specify Minimum Distance Between Points : "
           )
        zz (getdist
             "\nPick or specify Maximum Elevation above and below 0.0 : "
           )
        ** (initget 7)
        nw (getint
             "\nSpecify number of Periods along X axis : "
           )
        ** (entlast)
        pl (bridson (car bb) (cadr bb) md)
        pl (vl-sort pl '(lambda (a b) (< (car a) (car b))))
  )
 
  (setq f (getstring t "\nSpecify function in ALISP notation with \"x\" as parameter...\nSpecification must have starting open and ending close brackets : "))
  (defun fun ( x ) (eval (read f)))
  (setq dw (/ (caadr bb) nw))
  (mapcar '(lambda ( x / k )
      (setq k 0)
      (repeat x
        (setq k (1+ k))
        (if (or
              (equal (fun (* k (/ (* 2.0 pi) x))) 0.0 1e-8)
              (equal (fun (* k (/ (* 2.0 pi) x))) -1.0 1e-8)
              (equal (fun (* k (/ (* 2.0 pi) x))) 1.0 1e-8)
            )
          (setq r (cons t r))
          (setq r (cons nil r))
        )
      )
    )
    '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
  )
  (if (apply 'or r)
      (foreach p pl
        (setq e (* zz (/ (if (< 0.0 (rem (car p) (* 2.0 dw)) dw) (fun (* (/ (rem (car p) dw) dw) 2.0 pi)) (fun (- (* (/ (rem (car p) dw) dw) 2.0 pi) (* 2.0 pi)))))))
        (setq p (list (car p) (cadr p) e))
        (setq pll (cons p pll))
      )
    (progn
      (setq h (max (abs (fun dw)) (abs (fun 0.0))))
      (foreach p pl
        (setq e (* zz (/ (if (< 0.0 (rem (car p) (* 2.0 dw)) dw) (fun (rem (car p) dw)) (fun (- (rem (car p) dw) dw))) h)))
        (setq p (list (car p) (cadr p) e))
        (setq pll (cons p pll))
      )
    )
  )
 
  (setq pll (reverse pll))
 
  (mapcar '(lambda (a)
             (entmake (list '(0 . "POINT") '(8 . "Point") (cons 10 a)))
           )
          (mapcar '(lambda (b) (trans b 1 0)) pll)
  )
                                        ;(entdel **)
  (princ)
)
 

For radial elevation distribution :

Code - Auto/Visual Lisp: [Select]

;;                                                                            ;
;; Poisson Disk Sampling per Bridson Algorithm                                ;
;;                                                                            ;
;; See: http://www.cs.ubc.ca/~rbridson/docs/bridson-siggraph07-poissondisk.pdf;
;;      http://devmag.org.za/2009/05/03/poisson-disk-sampling/                ;
;;                                                                            ;
;; Will return a Random Set of points with a minimum distance between them    ;
;;                                                                            ;
 
(defun bridson (ll    ur    mindist     /     a     al    cells cellsize
                grid  i     ind   k     p     p1    p2    pl    r
                tcl   x     y
               )
  (setq k        30
        width    (- (car ur) (car ll))
        height   (- (cadr ur) (cadr ll))
        cellSize (/ mindist (sqrt 2))
        x        (ceil (/ width cellsize))
        y        (ceil (/ height cellsize))
        x0       (car ll)
        y0       (cadr ll)
        grid     (vlax-make-safearray vlax-vbInteger (cons 0 x) (cons 0 y))
        p1       (list (rand width) (rand height))
        pl       (list p1)
        al       (list 0)               ; Initialize Active List with index of First Point;
        ind      (mapcar '(lambda (a) (fix (/ a cellsize))) p1)
 
  )
  (init2d grid x y)                     ; Initialize the grid to all -1, then             ;
 
  (vlax-safearray-put-element grid (car ind) (cadr ind) 0)
 
  (setq i 0)
  (while al
    (setq p  (nth (fix (rand (length al))) al)
          p1 (nth p pl)
          p1 (list (car p1) (cadr p1))
    )
    (repeat k
      (setq a   (rand (+ pi pi))
            r   (* mindist (+ 1.0 (rand 1.0)))
            p2  (polar p1 a r)
            ind (mapcar '(lambda (a) (fix (/ a cellsize))) p2)
      )
      (if (and (<= 0 (car p2) width) (<= 0 (cadr p2) height))
        (progn
          (setq cells (ptsaround grid ind))
          (if cells
            (setq tcl (tooclosep p2 cells pl))
            (setq tcl nil)
          )
          (if (not tcl)
            (progn
              (setq i  (1+ i)
                    al (cons i al)
                    pl (append pl (list p2))
              )
 
              (vlax-safearray-put-element grid (car ind) (cadr ind) i)
            )
          )
        )
      )
    )
    (setq al (vl-remove p al))
 
  )
 
  (mapcar '(lambda (a) (list (+ (car a) x0) (+ (cadr a) y0) 0.0))
          pl
  )
)
 
(defun init2d (grid x y / i j)
  (setq i -1)
  (repeat x
    (setq i (1+ i)
          j -1
    )
    (repeat y
      (setq j (1+ j))
      (vlax-safearray-put-element grid i j -1)
    )
  )
)
 
 
(defun ptsaround (grid ind / i j rtn tmp)
 
  (setq j (- (cadr ind) 2))
  (repeat 5
    (setq i (- (car ind) 2))
    (repeat 5
      (if (and (< -1 i x) (< -1 j y))
        (if
          (not (= (setq tmp (vlax-safearray-get-element grid i j)) -1)
          )
           (setq rtn (cons tmp rtn))
        )
      )
      (setq i (1+ i))
    )
    (setq j (1+ j))
  )
  rtn
)
 
(defun tooclosep (p cells pl / pc rtn)
  (while cells
    (setq pc    (nth (car cells) pl)
          cells (cdr cells)
    )
    (if (< (distance pc p) mindist)
      (setq rtn t
            cells nil
      )
    )
  )
  rtn
)
;; Random number generator, Seed must remain global.    LeeMac                ;
;; Will return a real in the range 0...rng                                    ;
 
(defun rand (rng / x)
  (* (/ (setq x    4294967296.0
              seed (rem (1+ (* 1664525.0
                               (cond (seed)
                                     ((getvar 'DATE))
                               )
                            )
                        )
                        x
                   )
        )
        x
     )
     rng
  )
)
 
;; Floor function, Returns the largest integer not greater than x.            ;
(defun floor (x)
  (if (minusp (rem x 1))
    (- (fix x) 1)
    (fix x)
  )
)
;; Ceiling function, Returns the smallest integer not less than x.            ;
(defun ceil (x)
  (if (> (rem x 1) 0)
    (+ (fix x) 1)
    (fix x)
  )
)
 
(defun c:test (/ ** p1 p2 bb md zz wl cp dd nw f fun r h e pl pll)
 
  (vl-load-com)
 
  (command "_.UCS" "_W")
  (setq p1 (getpoint "\nPick a Window Defining Zone: ")
        p2 (getcorner p1)
        ** (vl-cmdf "_.RECTANGLE" "_non" p1 "_non" p2)
        pl (list p1 p2)
        bb (list (apply 'mapcar (cons 'min pl))
                 (apply 'mapcar (cons 'max pl))
           )
        ** (vl-cmdf "_.UCS" "_M" "_non" (car bb))
        bb (mapcar '(lambda (p) (trans p 0 1)) bb)
        md (getdist
             "\nPick or specify Minimum Distance Between Points : "
           )
        zz (getdist
             "\nPick or specify Maximum Elevation above and below 0.0 : "
           )
        wl (getdist
             "\nPick or specify Length of wave period : "
           )
        cp (getpoint
             "\nPick or specify center point of radial waving : "
           )
        dd (car (vl-sort (list (distance cp (car bb)) (distance cp (list (caadr bb) (cadar bb))) (distance cp (cadr bb)) (distance cp (list (caar bb) (cadadr bb)))) '>))
        ** (initget 7)
        nw (getint
             (strcat
               "\nSpecify number of waves along radial axis (must be > "
               (itoa (fix (/ dd wl)))
               ") : "
             )
           )
        ** (entlast)
  )
  (while (<= nw (fix (/ dd wl)))
    (initget 7)
    (setq nw (getint
              (strcat
                "\nSpecify number of waves along radial axis (must be > "
                (itoa (fix (/ dd wl)))
                ") : "
              )
            )
    )
  )
 
  (setq
        pl (bridson (car bb) (cadr bb) md)
        pl (vl-sort pl '(lambda (a b) (< (distance cp a) (distance cp b))))
  )
 
  (setq f (getstring t "\nSpecify function in ALISP notation with \"x\" as parameter...\nSpecification must have starting open and ending close brackets : "))
  (defun fun ( x ) (eval (read f)))
  (mapcar '(lambda ( x / k )
      (setq k 0)
      (repeat x
        (setq k (1+ k))
        (if (or
              (equal (fun (* k (/ (* 2.0 pi) x))) 0.0 1e-8)
              (equal (fun (* k (/ (* 2.0 pi) x))) -1.0 1e-8)
              (equal (fun (* k (/ (* 2.0 pi) x))) 1.0 1e-8)
            )
          (setq r (cons t r))
          (setq r (cons nil r))
        )
      )
    )
    '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
  )
  (if (apply 'or r)
      (foreach p pl
        (setq e (* zz (/ (if (< 0.0 (rem (distance cp p) (* 2.0 wl)) wl) (fun (* (/ (rem (distance cp p) wl) wl) 2.0 pi)) (fun (- (* (/ (rem (distance cp p) wl) wl) 2.0 pi) (* 2.0 pi)))))))
        (setq p (list (car p) (cadr p) e))
        (setq pll (cons p pll))
      )
    (progn
      (setq h (max (abs (fun wl)) (abs (fun 0.0))))
      (foreach p pl
        (setq e (* zz (/ (if (< 0.0 (rem (distance cp p) (* 2.0 wl)) wl) (fun (rem (distance cp p) wl)) (fun (- (rem (distance cp p) wl) wl))) h)))
        (setq p (list (car p) (cadr p) e))
        (setq pll (cons p pll))
      )
    )
  )
 
  (setq pll (reverse pll))
 
  (mapcar '(lambda (a)
             (entmake (list '(0 . "POINT") '(8 . "Point") (cons 10 a)))
           )
          (mapcar '(lambda (b) (trans b 1 0)) pll)
  )
                                        ;(entdel **)
  (princ)
)
 

Thanks, M.R.

ribarm · « **Reply #27 on:** May 10, 2015, 07:21:40 AM »

It seems that no one doesn't check 2 last posted lisps... There was a problem with circle/sphere function and no one reported... It should work now... You should have checked with function (+- (sqrt (abs (- (expt r 2) (expt x 2))))) where r is radius (period length or elevation above and below 0.0)... How disappointing...

News:

Author Topic: Poisson Disk Sampling - Bridson Algorithm - Blue Noise (Read 11649 times)

ymg

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ribarm

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ymg

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ribarm

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ymg

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ribarm

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ymg

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

danallen

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ymg

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ribarm

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ymg

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ribarm

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise

ribarm

Re: Poisson Disk Sampling - Bridson Algorithm - Blue Noise