Author Topic: LM:ConvexHull strange behavior  (Read 1445 times)

0 Members and 1 Guest are viewing this topic.

Giuseppe Beatrice

  • Newt
  • Posts: 42
LM:ConvexHull strange behavior
« on: June 10, 2017, 06:57:49 AM »
I have developed a simple routine to apply the Graham's scan algorithm (LM:ConvexHull function by Lee-Mac), for testing if a point is inside or on a polygon.

(defun c:test_pi ( / p l)
  (if (setq p (getpoint "\nPick 1st point: "))
    (progn (setq p (trans p 1 0)
       l (list p))      
      (while (setq p (getpoint "\nPick next point <Exit>: "))
        (setq p (trans p 1 0)
         l (cons p l)))))
  (setq p (getpoint "\nPick point to verify: "))
  (cond ((equal (LM:ConvexHull l)  (LM:ConvexHull (cons p l))) (print "Point inside or collinear"))))

Well, if I draw a polygon and place the point to verify along an horizontal side of the polygon that lay on the lowest y-coordinate (with object snap's "near"), the result is nil!! :no:
I don't know why, and I'll appreciate every help.
« Last Edit: June 10, 2017, 07:08:43 AM by Giuseppe Beatrice »

ribarm

  • Water Moccasin
  • Posts: 2401
  • Marko Ribar, architect
Re: LM:ConvexHull strange behavior
« Reply #1 on: June 10, 2017, 07:45:06 AM »
I've noticed this lack long time ago, and I've modified Lee's sub, but he never updated it... I think I posted this revision few times, but it stayed on his site unchanged...

Quote
;; Convex Hull  -  Lee Mac
;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.

(defun LM:ConvexHull ( lst / ch p0 )
    (cond
        (   (< (length lst) 4) lst)
        (   (setq p0 (car lst))
            (foreach p1 (cdr lst)
                (if (or (< (cadr p1) (cadr p0))
                        (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0)))
                    )
                    (setq p0 p1)
                )
            )
            (setq lst (vl-remove p0 lst))
            (setq lst (append (list p0) lst))
            (setq lst
                (vl-sort lst
                    (function
                        (lambda ( a b / c d )
                              (if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
                                  (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
                                  (< c d)
                              )

                        )
                    )
                )
            )
            (setq ch (list (cadr lst) (car lst)))
            (foreach pt (cddr lst)
                (setq ch (cons pt ch))
                (while (and (caddr ch) (LM:Clockwise-p (caddr ch) (cadr ch) pt))
                    (setq ch (cons pt (cddr ch)))
                )
            )
            (reverse ch)
        )
    )
)

;; Clockwise-p  -  Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented or collinear

(defun LM:Clockwise-p ( p1 p2 p3 )
    (<  (-  (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
            (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
        )
        1e-8
    )
)

(defun c:chull ( / i l s )
    (if (setq s (ssget '((0 . "POINT"))))
        (progn
            (repeat (setq i (sslength s))
                (setq l (cons (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))) l))
            )
            (setq l (LM:ConvexHull l))
            (entmakex
                (append
                    (list
                       '(000 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                        (cons 90 (length l))
                       '(070 . 1)
                    )
                    (mapcar '(lambda ( x ) (cons 10 x)) l)
                )
            )
        )
    )
    (princ)
)

HTH., M.R.
« Last Edit: June 19, 2019, 12:41:22 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

gile

  • Water Moccasin
  • Posts: 2263
  • Marseille, France
Re: LM:ConvexHull strange behavior
« Reply #2 on: June 10, 2017, 09:32:50 AM »
Hi,

Here's my way (quite old one):

Code - Auto/Visual Lisp: [Select]
  1. ;; Retourne la liste des points formant l'enveloppe convexe de pts
  2. (defun convhull (pts / clockwise p0 acc)
  3.  
  4.   ;; Evalue si les points p1 p2 p3 tournent en sens horaire ou sont alignés
  5.   (defun clockwise (p1 p2 p3)
  6.     (< (sin (- (angle p1 p3) (angle p1 p2))) -1e-9)
  7.   )
  8.  
  9.   ;; recherche du pivot
  10.   (setq p0 (car pts))
  11.   (foreach p (cdr pts)
  12.     (if (or (< (cadr p) (cadr p0))
  13.             (and (= (cadr p) (cadr p0)) (< (car p) (car p0)))
  14.         )
  15.       (setq p0 p)
  16.     )
  17.   )
  18.  
  19.   ;; tri de la liste
  20.   (setq pts (vl-sort pts
  21.                      '(lambda (p1 p2 / d1 d2 c1 c2)
  22.                         (setq d1 (distance p0 p1)
  23.                               d2 (distance p0 p2)
  24.                         )
  25.                         (if (or (= 0 d1)
  26.                                 (= 0 d2)
  27.                                 (equal (setq c1 (/ (- (car p0) (car p1)) d1))
  28.                                        (setq c2 (/ (- (car p0) (car p2)) d2))
  29.                                        1e-9
  30.                                 )
  31.                             )
  32.                           (< d1 d2)
  33.                           (< c1 c2)
  34.                         )
  35.                       )
  36.             )
  37.         acc (list (cadr pts) (car pts))
  38.         pts (cddr pts)
  39.   )
  40.  
  41.   ;; supression des points ne faisant pas partie de l'enveloppe
  42.   (foreach p pts
  43.     (while (and (cdr acc) (clockwise (cadr acc) (car acc) p))
  44.       (setq acc (cdr acc))
  45.     )
  46.     (setq acc (cons p acc))
  47.   )
  48.  
  49.   ;; résultat retourné
  50.   (reverse acc)
  51. )
  52.  
  53. ;; Commande de test
  54. (defun c:ch (/ ss n lst)
  55.   (if (setq ss (ssget '((0 . "POINT"))))
  56.     (progn
  57.       (repeat (setq n (sslength ss))
  58.         (setq lst (cons (cdr (assoc 10 (entget (ssname ss (setq n (1- n)))))) lst))
  59.       )
  60.       (entmake
  61.         (vl-list*
  62.           '(0 . "LWPOLYLINE")
  63.           '(100 . "AcDbEntity")
  64.           '(100 . "AcDbPolyline")
  65.           (cons 90 (length lst))
  66.           '(70 . 1)
  67.           (mapcar '(lambda (p) (list 10 (car p) (cadr p))) (convhull lst))
  68.         )
  69.       )
  70.     )
  71.   )
  72.   (princ)
  73. )
Speaking English as a French Frog

gile

  • Water Moccasin
  • Posts: 2263
  • Marseille, France
Re: LM:ConvexHull strange behavior
« Reply #3 on: June 10, 2017, 11:43:08 AM »
Using a 'functional style' closer to the F# implementation:

Code - Auto/Visual Lisp: [Select]
  1. ;; Returns the convex hull points list (Graham's scan algorithm)
  2. (defun convhull (pts / clockwise getPivot getConvHull)
  3.  
  4.   ;; Evaluates if p1 p2 p3 are clockwise
  5.   (defun clockwise (p1 p2 p3)
  6.     (< (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
  7.           (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
  8.        )
  9.        1e-8
  10.     )
  11.   )
  12.  
  13.   ;; Gets the pivot
  14.   (defun getPivot (p l)
  15.     (if l
  16.       (getPivot
  17.         (if (or (and (= (cadar l) (cadr p)) (< (caar l) (car p)))
  18.                 (< (cadar l) (cadr p))
  19.             )
  20.           (car l)
  21.           p
  22.         )
  23.         (cdr l)
  24.       )
  25.       p
  26.     )
  27.   )
  28.  
  29.   ;; Constructs the points list
  30.   (defun getConvHull (lst acc)
  31.     (if lst
  32.       (if (and (cdr acc) (clockwise (cadr acc) (car acc) (car lst)))
  33.         (getConvHull lst (cdr acc))
  34.         (getConvHull (cdr lst) (cons (car lst) acc))
  35.       )
  36.       acc
  37.     )
  38.   )
  39.  
  40.   ((lambda (p0)
  41.      (reverse
  42.        (getConvHull
  43.          (vl-sort pts
  44.                   '(lambda (p1 p2 / d1 d2 c1 c2)
  45.                      (setq d1 (distance p0 p1)
  46.                            d2 (distance p0 p2)
  47.                      )
  48.                      (if (or (= 0 d1)
  49.                              (= 0 d2)
  50.                              (equal (setq c1 (/ (- (car p0) (car p1)) d1))
  51.                                     (setq c2 (/ (- (car p0) (car p2)) d2))
  52.                                     1e-9
  53.                              )
  54.                          )
  55.                        (< d1 d2)
  56.                        (< c1 c2)
  57.                      )
  58.                    )
  59.          )
  60.          nil
  61.        )
  62.      )
  63.    )
  64.     (getPivot (car pts) (cdr pts))
  65.   )
  66. )
Speaking English as a French Frog

GP

  • Newt
  • Posts: 82
  • Vercelli, Italy
Re: LM:ConvexHull strange behavior
« Reply #4 on: June 11, 2017, 12:02:41 PM »
Hi Giuseppe,
try this (also)...  :-)

Code: [Select]
(defun c:test_pi (/ p l)
    (if (setq p (getpoint "\nPick 1st point: "))
        (progn (setq p (trans p 1 0)
                     l (list p)
               )
               (while (setq p (getpoint "\nPick next point <Exit>: "))
                   (setq p (trans p 1 0)
                         l (cons p l)
                   )
               )
        )
    )
    (setq p (getpoint "\nPick point to verify: "))
    (if (inside_p p l) (print "Point inside or collinear"))
    (princ)
)

(defun inside_p (:p :Lst / Fp cross on)
    (setq Fp (mapcar '+ '(1.0 1.0 0.0) (getvar 'extmax)))
    (setq cross 0)
    (if (not (member :p :Lst))
        (mapcar
            '(lambda (a b)
                 (if (inters :p Fp a b) (setq cross (1+ cross)))
                 (if (equal (+ (distance :p a) (distance :p b)) (distance a b) 1e-8) (setq on t))
             )
             (cons (last :Lst) :Lst) :Lst
        )
        (setq on t)
    )
    (or (not (zerop (rem cross 2))) on)
)

Giuseppe Beatrice

  • Newt
  • Posts: 42
Re: LM:ConvexHull strange behavior
« Reply #5 on: June 12, 2017, 06:45:28 AM »
Thank you all for the quick answers.
I had suspected some bugs in Lee Mac function, but he is for me a "holy monster".
So much thanks again and excuse me for my poor english :woow:

Giuseppe Beatrice

  • Newt
  • Posts: 42
Re: LM:ConvexHull strange behavior
« Reply #6 on: July 24, 2018, 09:13:58 AM »
Hi
I had a strange result from the GP's function INSIDE_P and so I investigate it.
Proved it with:  (INSIDE_P '(0 0) '((-1 -1) (-1 1) (1 1) (1 -1)))   -> result T
Proved it with: (INSIDE_P '(0 0 1) '((-1 -1 1) (-1 1 1) (1 1 0) (1 -1 1))) -> result nil
I was stunned and found no reason of that.
Note that with:  (INSIDE_P '(0 0 1) '((-1 -1 1) (-1 1 1) (1 1) (1 -1 1))) -> result T
Same result for every value of z coordinate, provided that the third point is without the z coordinate
Thank you for attention.
« Last Edit: July 24, 2018, 09:20:09 AM by Giuseppe Beatrice »

GP

  • Newt
  • Posts: 82
  • Vercelli, Italy
Re: LM:ConvexHull strange behavior
« Reply #7 on: July 24, 2018, 10:50:25 AM »
Remove the z value here:
(setq Fp (mapcar '+ '(1.0 1.0 0.0) (getvar 'extmax)))
« Last Edit: July 25, 2018, 03:24:02 AM by GP »

Giuseppe Beatrice

  • Newt
  • Posts: 42
Re: LM:ConvexHull strange behavior
« Reply #8 on: July 25, 2018, 03:44:47 AM »
Of course, I've already solved the problem this way.
But I would like to understand why the command does not work well with all z coordinates, and especially because, by deleting a specified z coordinate (and only that one) the command works well again.
I'm confused... :no:

Giuseppe Beatrice

  • Newt
  • Posts: 42
Re: LM:ConvexHull strange behavior
« Reply #9 on: July 26, 2018, 01:49:43 AM »
I did not know that the extmax system variable was three-dimensional and that the values of the z coordinate of the extmax and extmin variables were of opposite sign.
Now I understood the reason that caused what seemed like an error.
Thanks GP, you are precious :smitten: