TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MP on December 21, 2008, 11:11:53 PM
-
Write a function that takes 3 arguments:
control_points: a list of points that serves as a control alignment in the XY plane
test_points: a list of points that are to be examined
tolerance: the max distance any point can be offset from the control alignment
Signature:
(IndexPoints control_points test_points tolerance)
Return value:
A list of integers representing the ordered position of the test_points. Points that
fall outside the tolerance should not be indexed. Use base 0 per the nth LISP
function.
Objective:
Using the points represented by variable control_points, compare each point hosted
by the test_points variable. If the point is on the alignment, or is within the distance
represented by the precision variable, return its order position relative to the control_points
data; base 0. That is, the point closest to the first control point would have a position value
of 0, the next 1, the next 2 and so on.
Note 1:
The comparisons detailed above are to be performed by projecting to a common XY plane,
so if the function is passed 3D points it will still perform the task.
Note 2:
Duplicate data should not be discarded. For example, if three points are equidistant from a
control point and are within the tolerance corridor then the three points should be indexed.
For example, given control points of:
'(
(00.0 40.0)
(20.0 40.0)
(20.0 00.0)
(35.0 00.0)
(35.0 20.0)
(55.0 20.0)
)
Test points of:
'(
(17.7 20.1)
(35.0 15.3)
(05.4 39.2)
(20.9 32.7)
(20.9 17.9)
(37.1 10.4)
(18.8 09.8)
(27.2 00.2)
(21.6 07.8)
(21.0 02.5)
(39.2 20.0)
(35.8 07.3)
(22.0 28.1)
(30.1 00.0)
(07.7 40.7)
(25.2 00.4)
(10.3 42.2)
(34.5 02.9)
(42.5 21.3)
(49.8 18.4)
(18.5 35.9)
(51.1 20.0)
(11.9 40.0)
(53.3 20.9)
)
And a tolerance of:
1.0
The result should be:
(
2
14
22
3
4
9
15
7
13
17
11
1
10
21
23
)
Note that the following highlighted values were not indexed because they breached the tolerance value:
(
(17.7 20.1) index: 0 *
(35.0 15.3) 1
(05.4 39.2) 2
(20.9 32.7) 3
(20.9 17.9) 4
(37.1 10.4) 5 *
(18.8 09.8) 6 *
(27.2 00.2) 7
(21.6 07.8) 8 *
(21.0 02.5) 9
(39.2 20.0) 10
(35.8 07.3) 11
(22.0 28.1) 12 *
(30.1 00.0) 13
(07.7 40.7) 14
(25.2 00.4) 15
(10.3 42.2) 16 *
(34.5 02.9) 17
(42.5 21.3) 18 *
(49.8 18.4) 19 *
(18.5 35.9) 20 *
(51.1 20.0) 21
(11.9 40.0) 22
(53.3 20.9) 23
)
Some imagery to illuminate:
Control points represented by green, test points by red and points that exceed the
tolerance gray respectively. Red points to be numbered according to their distance
from point <1> along the alignment established by points 1 thru 6. Distances used
for ordering should reflect the distance from the control point to the equivalent test
point along the center line. See image below for clarity.
(http://www.theswamp.org/screens/mp/sorted_points_1.png)
Tolerance detail, light gray area represents the limits of the tolerance. Distance for
any red point from the green point to be measured along the center line.
(http://www.theswamp.org/screens/mp/sorted_points_2.png)
Let me know if I've not provided enough detail, lol.
Cheers, Michael.
-
Nice challenge Michael. Too late here to tackle it. I'll be back in 8-9 hours. 8-)
-
I assume this is a geometry only challenge.
I assume the tolerance corridor zones terminate adjacent to the control point ( as indicated by the dashed lines in diagram 1 )
.. and similarly the tolerance zones at any 'corridor' change of direction will not be mitred ie: the corners shall be simple overlapped zones)
-
Type "test" at the command line to run. Getting the sort to work right, near
the end of IndexPoint, took longer to figure out than I expected.
Be interesting to see how others handle that. Couple notes, this
routine projects an intersect point for each test point and checks them
against the current working control segment. If it is not on the control
segment then it is not qualified to update the offset data structure.
This means that points that are within an outside corner will not
be qualified, and points on the inside corner will have 2 solutions.
Because of the sorting the solution closest to segment 0 will be
(should) be reported in the end.
All in all this is a good challenge. Got me to use a bunch of features
I've never touched, and I just spotted the vlax-curve- routines in
the help file. Hmm. might have to give this another go around.
Paul
(defun IndexPoint (control_points test_points tolerance /
nSegment nPt pt1 pt2 pt3 pt4 testPt
testPt_offset)
(setq nSegment 0
nPt 0
)
;; make a list the size of test_points.
;; { ptNumber, segment, distFirstPtOfSegment, perpDist }
;; is there a way in lisp to get the max value a double can hold?
;; for now just set to 1e10, should be big enough for testing purposes
(setq nPt -1)
(setq testPt_offset (mapcar
'(lambda (x) (list (setq nPt (1+ nPt)) 0 0.0 1e10)) test_points))
;; need to compute some values between each segment
(while (< nSegment (- (length control_points) 1))
(setq pt1 (nth nSegment control_points) ;_ segment pt1
pt2 (nth (+ 1 nSegment) control_points) ;_ segment pt2
distSeg (distance pt1 pt2)
ang1 (angle pt1 pt2)
ang2 (+ ang1 (/ PI 2.0)) ;_ perp Angle
nPt 0
)
;; each test point will be computed against the current segment
;; pt3 = 10 units from testPt perp to control line segment
;; pt4 = the intesection of control line segment and testPt to pt3 LS
;; dist = distance from the intersect point to the testPt
;; dist14 = distance from pt1 to intersect pt (pt4)
(foreach testPt tp
(setq pt3 (polar testPt ang2 10.0)
pt4 (inters pt1 pt2 pt3 testPt nil)
dist (distance pt4 testPt)
dist14 (distance pt1 pt4)
)
;; make sure pt4 is on the control segment line
(if (= distSeg (+ dist14 (distance pt2 pt4)))
;; is dist < previous perpendicular distance
(if (< dist (cadddr (nth nPt testPt_offset)))
;; it is, need to update the list structure to hold
;; what segment is currently being worked on, the
;; distance from pt1 of the current segment and the
;; intercept pt4, and the perp distance to the
;; control line segment.
(setq testPt_offset
(subst (list npt nSegment dist14 dist)
(assoc nPt testPt_offset)
testPt_offset
)
)
) ;_ if
) ;_ if
(setq nPt (1+ nPt))
) ;_ foreach
(setq nSegment (1+ nSegment))
) ;_ while
;; sort on dist from pt1 to pt4
(setq ndx (vl-sort-i testPt_offset
'(lambda (e1 e2) (< (caddr e2) (caddr e1))) ))
;; rebuild the list
(setq testPt_offset (mapcar '(lambda (x) (nth x testPt_offset)) ndx))
;; sort based on the segment
(setq ndx (vl-sort-i testPt_offset
'(lambda (e1 e2) (< (cadr e1) (cadr e2))) ))
;; rebuild the list
(setq testPt_offset (mapcar '(lambda (x) (nth x testPt_offset)) ndx))
;; remove any sets that are outside of tolerance limits
(setq testPt_offset (vl-remove-if '(lambda (x) (> (cadddr x) tolerance))
testPt_offset))
;; return list of just the sorted point numbers
(mapcar '(lambda (x) (car x)) testPt_offset)
) ;_ defun
(defun c:Test (/)
(setq cp (list '(00.0 40.0) '(20.0 40.0) '(20.0 00.0)
'(35.0 00.0) '(35.0 20.0) '(55.0 20.0)
)
tp (list '(17.7 20.1) '(35.0 15.3) '(05.4 39.2)
'(20.9 32.7) '(20.9 17.9) '(37.1 10.4)
'(18.8 09.8) '(27.2 00.2) '(21.6 07.8)
'(21.0 02.5) '(39.2 20.0) '(35.8 07.3)
'(22.0 28.1) '(30.1 00.0) '(07.7 40.7)
'(25.2 00.4) '(10.3 42.2) '(34.5 02.9)
'(42.5 21.3) '(49.8 18.4) '(18.5 35.9)
'(51.1 20.0) '(11.9 40.0) '(53.3 20.9)
)
)
(IndexPoint cp tp 1.0)
)
-
Nicely done Paul, we've shared some techniques, differed on others.
However, you haven't met one of the requirements, namely to index all points that satisfy the conditions. Your current incarnation does not index duplicate points, for example if you (setq test_points (append test_points test_points)) the function should return double the number of indexed values, assuming at least one point was indexable.
Here's my stab. While it's (typically) verbose, sometimes bigger is better (comparative results at the end):
(defun MP:IndexPoints
( control_points
test_points
tolerance
/
@pairs
@index
@inters
@process
@sort
@enum
@xy
@main
)
(defun @pairs ( lst )
;; Pair each item in the list with the immediate
;; adjacent item.
;; ------------------------------------------------
;; Given '(1 2 3 4) return '((1 2) (2 3) (3 4)).
;; ------------------------------------------------
;; Lexical global(s) : none.
( (lambda ( i / result )
(reverse
(repeat (1- (length lst))
(setq result
(cons
(list
(nth i lst)
(nth (setq i (1+ i)) lst)
)
result
)
)
)
)
)
0
)
)
(defun @index ( pair / ang )
;; Determine the angle for the pair of points and
;; append said ang + and - pi/2.
;; ------------------------------------------------
;; given '((0.0 0.0) (1.0 1.0)).
;; return ((0.0 0.0) (1.0 1.0) 2.35619 -0.785398).
;; ------------------------------------------------
;; Lexical global(s) : r90.
(append pair
(list
(+ (setq ang (apply 'angle pair)) r90)
(- ang r90)
)
)
)
(defun @inters ( c / a b )
;; Determine if point c intersects segment ab using
;; the tolerance distance projected from point c at
;; angles 90 and 180 from the angle defined by
;; segment ab. Points a and b are hosted by lexical
;; global lst.
;; ------------------------------------------------
;; Given a test point return t or nil.
;; ------------------------------------------------
;; Lexical global(s) : lst, tolerance.
(or
(inters
(setq a (car lst))
(setq b (cadr lst))
c
(polar c (caddr lst) tolerance)
)
(inters a b c (polar c (cadddr lst) tolerance))
)
)
(defun @process ( / successes failures )
;; Process the current set of control points.
;; ------------------------------------------------
;; Lexical global(s) : control_points, test_points,
;; lst.
(foreach x test_points
(if (@inters (car x))
(setq successes (cons x successes))
(setq failures (cons x failures))
)
)
;; Remove the test points that intersected with
;; the current control point pair from the master
;; test points list.
(setq test_points failures)
;; Sort the test points, return their index(s)
(mapcar 'cadr (vl-sort successes '@sort))
)
(defun @sort ( a b / c )
;; Determine if dist ab is less than dist bc. Point
;; c is hosted by the lexical global lst.
;; ------------------------------------------------
;; lexical global(s) : lst
(<
(distance (car a) (setq c (car lst)))
(distance (car b) c)
)
)
(defun @enum ( lst )
;; Index a list (zero base), appending the index to
;; the end of each item.
;; ------------------------------------------------
;; Given '(a b c) return ((a 0) (b 1) (c 2)).
( (lambda ( i )
(mapcar
'(lambda ( x ) (list x (setq i (1+ i))))
lst
)
)
-1
)
)
(defun @xy ( point )
;; return the 2D portion of a point
(list (car point) (cadr point))
)
(defun @main ( control_points test_points tolerance / r90 )
;; Put all the functions defined above to work.
;; ------------------------------------------------
;; Lexical global(s) : arguments + r90.
(setq
r90 (* 0.5 pi)
test_points (@enum (mapcar '@xy test_points))
)
(apply 'append
(mapcar
'(lambda ( lst ) (@process))
(mapcar '@index (@pairs (mapcar '@xy control_points)))
)
)
)
;; Let's roll ...
(@main control_points test_points tolerance)
)
Some test code:
(defun c:Test ( / control_points test_points tolerance )
(setq control_points
'(
(00.0 40.0)
(20.0 40.0)
(20.0 00.0)
(35.0 00.0)
(35.0 20.0)
(55.0 20.0)
)
)
(setq test_points
'(
(17.7 20.1)
(35.0 15.3)
(05.4 39.2)
(20.9 32.7)
(20.9 17.9)
(37.1 10.4)
(18.8 09.8)
(27.2 00.2)
(21.6 07.8)
(21.0 02.5)
(39.2 20.0)
(35.8 07.3)
(22.0 28.1)
(30.1 00.0)
(07.7 40.7)
(25.2 00.4)
(10.3 42.2)
(34.5 02.9)
(42.5 21.3)
(49.8 18.4)
(18.5 35.9)
(51.1 20.0)
(11.9 40.0)
(53.3 20.9)
)
)
(setq tolerance 1.0)
(repeat 4
;; Note, the benchmark function can be found at:
;;
;; http://www.theswamp.org/lilly_pond/mp/lisp/benchmark.txt
(princ
(strcat
"\nTesting functions with test_points length of <"
(itoa (length test_points))
"> ...\n\n"
)
)
(Benchmark
'(
(MP:IndexPoints control_points test_points tolerance)
(PK:IndexPoints control_points test_points tolerance)
)
)
;; Now increase the number of test points.
(repeat 4 (setq test_points (append test_points test_points)))
)
(princ)
)
The results:
Testing functions with test_points length of <24> ...
Elapsed milliseconds / relative speed for 4096 iteration(s):
(_PK:INDEXPOINTS CONTROL_POINTS TEST...).....1875 / 1.38 <fastest>
(_MP:INDEXPOINTS CONTROL_POINTS TEST...).....2594 / 1.00 <slowest>
Testing functions with test_points length of <384> ...
Elapsed milliseconds / relative speed for 256 iteration(s):
(_PK:INDEXPOINTS CONTROL_POINTS TEST...).....1907 / 1.34 <fastest>
(_MP:INDEXPOINTS CONTROL_POINTS TEST...).....2547 / 1.00 <slowest>
Testing functions with test_points length of <6144> ...
Elapsed milliseconds / relative speed for 8 iteration(s):
(_MP:INDEXPOINTS CONTROL_POINTS TEST...).....1453 / 3.04 <fastest>
(_PK:INDEXPOINTS CONTROL_POINTS TEST...).....4422 / 1.00 <slowest>
Testing functions with test_points length of <98304> ...
Elapsed milliseconds / relative speed for 1 iteration(s):
[color=red](_MP:INDEXPOINTS CONTROL_POINTS TEST...).......3547 / 38.91 <fastest> ZING!![/color]
(_PK:INDEXPOINTS CONTROL_POINTS TEST...).....138031 / 1.00 <slowest>
This was the more conservative result from several test runs. :D
Keep in mind the results are not conclusive, it's not really a wide variety of data scenarios ans only the number of test_points were increased. Robust testing would also interpret how the number of control points influences performance. Also, the version of your proggy tested is not actually fulfilling the requirements as stated above.
Finally, my benchmarking utility may have built in bias to my code. :whistle:
As a real world app, I needed this function to sort pipeline data, typically around 2000 items (vertical / horizontal bends, pipe supports etc). I had one based on vlax-curve-getDistAtPoint but it started to produce pooched results when the project was really far away from the origin.
My current project is based on millimeters, with extremely high coordinate values so I needed to rewrite the function based solely on geometry, thus IndexPoints.lsp. I opted for the indexes approach as I can use it to pluck data from a rather large list, sorting the latter would have been more memory intensive than necessary.
Thanks for participating Paul -- looking forward to your revision (if you have time) as well as entries to come that will blow mine out of the water!!
:)
-
Very cool. I'll check out your code more completely when I get back and
thanks for the details.
Paul
-
My pleasure Paul, thanks again for participating and sharing your expertise. :)
-
I didn't get the same results as you Michael. I will look to see why not. Index 9 didn't show up in my list, and I have index 11 & 17 reversed. Here is the code.
Now I will see how you two did it.
(defun IndexPoints ( ptList testPtList tol / GetRecPts PointWithin GetDistance cnt RecPtList MaxCnt LocDistList tempList )
(defun GetRecPts ( stPt endPt width / Ang )
(setq Ang (angle stPt endPt))
(list
(polar
stPt
(rem (+ Ang (* pi 0.5)) (* pi 2.))
width
)
(polar
endPt
(rem (+ Ang (* pi 1.5)) (* pi 2.))
width
)
)
)
;----------------------------------
(defun PointWithin ( pt recPtList )
(and
(or
(< (caar recPtList) (car pt) (caadr recPtList))
(< (caadr recPtList) (car pt) (caar recPtList))
)
(or
(< (cadar recPtList) (cadr pt) (cadadr recPtList))
(< (cadadr recPtList) (cadr pt) (cadar recPtList))
)
)
)
;-------------------------------
(defun GetDistance ( stPt endPt )
(*
(sin
(-
(* pi 0.5)
(rem (angle stPt endPt) (* pi 0.5))
)
)
(distance stPt endPt)
)
)
;------------------------------
(setq cnt 0)
(repeat (1- (length ptList))
(setq RecPtList (cons (GetRecPts (nth cnt ptList) (nth (1+ cnt) ptList) tol) RecPtList))
(setq cnt (1+ cnt))
)
(setq RecPtList (reverse RecPtList))
(setq MaxCnt (length RecPtList))
(foreach i testPtList
(setq cnt 0)
(while
(and
(< cnt MaxCnt)
(not (PointWithin i (nth cnt RecPtList)))
)
(setq cnt (1+ cnt))
)
(if (setq tempList
(if (not (equal cnt MaxCnt))
(list
cnt
(GetDistance (nth cnt ptList) i)
(vl-position i testPtList)
)
)
)
(setq LocDistList (cons tempList LocDistList))
)
)
(mapcar
'caddr
(vl-sort
LocDistList
'(lambda (a b)
(if (equal (car a) (car b))
(< (cadr a) (cadr b))
(< (car a) (car b))
)
)
)
)
)
Results:
(2 14 22 3 4 15 7 13 11 17 1 10 21 23)
-
Hi,
Here's my way
(defun IndexPoints (control_points test_points tolerance / pl lst)
(vl-load-com)
(setq pl
(entmakex
(append
(list
'(0 . "lWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(70 . 0)
(cons 90 (length control_points))
'(210 0.0 0.0 1.0)
)
(mapcar '(lambda (x) (cons 10 x)) control_points)
)
)
)
(setq lst (mapcar
'(lambda (x / p)
(setq p (vlax-curve-getClosestPointTo pl (list (car x) (cadr x))))
(cons (vlax-curve-getParamAtPoint pl p)
(distance x p)
)
)
test_points
)
)
(entdel pl)
(vl-remove-if
'(lambda (x) (< tolerance (cdr (nth x lst))))
(vl-sort-i lst
'(lambda (x1 x2) (< (car x1) (car x2)))
)
)
)
-
Hi gile!
I have written a code very similar to yours. :)
I will write the new...
(defun IndexPoint (a b c / e)
;;(IndexPoint a b c)
(setq e (entmakex
(append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbPolyline")
(cons 90 (length a))
) ;_ list
(mapcar (function (lambda (b) (cons 10 b))) a)
)
)
a (mapcar (function
(lambda (a / b)
(if (<= (distance a
(setq b (vlax-curve-getClosestPointTo
e
a
)
)
)
c
)
(vlax-curve-getParamAtPoint e b)
)
)
)
b
)
b (length (vl-remove-if-not (function null) a))
a (vl-sort-i
a
(function <)
)
)
(entdel e)
(repeat b (setq a (cdr a)))
)
-
Late as usual. :lol:
(defun IndexPoints (cp_list tp_list fuzz / p1 p2 p3 res lst idxlst)
;; returns height & distance for p1 to p3 intersect with base
(defun GetHeight (p1 p2 p3 / s1 s2 s3 a b c j k)
(setq s1 (distance p1 p2)
s2 (distance p1 p3)
s3 (distance p2 p3)
ra (/ pi 2) ; right angle
)
(setq j (/ (+ s1 s2 s3) 2.0))
(if (zerop (setq k (sqrt (/ (* (- j s1) (- j s2) (- j s3)) j))))
(list 0.0 (distance p1 p3)); point is on the segment
(progn
(setq
a (* 2 (atan (/ k (- j s1))))
b (* 2 (atan (/ k (- j s2))))
c (- pi (+ a b))
)
(if (or (> b ra) (> c ra))
nil ; point is not adjacent
(list (* s2 (sin c)) (* s2 (sin (/ a 2.)))) ; return height & dist
)
)
)
)
;; Create a list of points that match the requirement
;; (height dist idx point)
(setq p1 (car cp_list)
sdist 0)
(foreach p2 (cdr cp_list) ; segments
(setq idx 0)
(foreach p3 tp_list ; test points
(if (and (setq h (GetHeight p1 p2 p3))
(<= (car h) fuzz)
)
(setq res (cons (list (car h) (+ sdist (cadr h)) idx p3) res))
)
(setq idx (1+ idx))
)
(setq sdist (+ sdist (distance p1 p2))
p1 p2
)
)
;; sort the points withing the segments
(setq lst (vl-sort res (function (lambda (e1 e2) (> (cadr e1)(cadr e2))))))
(mapcar '(lambda(x) (setq idxlst (cons (caddr x) idxlst))) lst)
idxlst
)
-
new version...
(defun IndexPoint (a b c / i)
;;(IndexPoint a b c)
(setq i 0
a (mapcar (function (lambda (a b / e d)
(setq d (distance a b)
e (mapcar (function /) (mapcar (function -) a b) (list d d))
) ;_ setq
(list (mapcar (function +) a e)
(mapcar (function -) b e)
(list (- (cadr e)) (car e))
(list d (setq i (1+ i)))
) ;_ list
) ;_ lambda
) ;_ function
a
(cdr a)
) ;_ mapcar
a (mapcar
(function (lambda (d)
(if (setq d
(cdar (vl-sort
(vl-remove-if
(function null)
(mapcar
(function (lambda (e / f p)
(if (setq p (inters (mapcar (function -) d (caddr e))
(mapcar (function +) d (caddr e))
(car e)
(cadr e)
) ;_ inters
) ;_ setq
(if (<= (setq f (distance p d)) c)
(list f p (car e) (cadddr e))
) ;_ if
) ;_ if
) ;_ lambda
) ;_ function
a
) ;_ mapcar
) ;_ vl-remove-if
(function (lambda (a b) (< (car a) (car b))))
) ;_ vl-sort
) ;_ cdar
) ;_ setq
(+ (cadadr (cdr d)) (/ (distance (car d) (cadr d)) (caaddr d)))
) ;_ if
) ;_ lambda
) ;_ function
b
) ;_ mapcar
b (length (vl-remove-if-not (function null) a))
a (vl-sort-i a (function <))
) ;_ setq
(repeat b (setq a (cdr a)))
)
-
Current results, functions returning incorrect results marked in red ...
Our friends:
AB = Alan Butler (CAB)
EE = Elpanov Evgeniy
G* = Giles ?
MP = Michael Puckett
PK = Paul Kohut
TW = Tim Willey
Initial test data:
(setq control_points
'(
(00.0 40.0 1.3)
(20.0 40.0 2.5)
(20.0 00.0 1.1)
(35.0 00.0 3.9)
(35.0 20.0 2.1)
(55.0 20.0 0.5)
)
)
(setq test_points
'(
(17.7 20.1 1.3)
(35.0 15.3 2.5)
(05.4 39.2 1.1)
(20.9 32.7 3.9)
(20.9 17.9 2.1)
(37.1 10.4 0.5)
(18.8 09.8 1.3)
(27.2 00.2 2.5)
(21.6 07.8 1.1)
(21.0 02.5 3.9)
(39.2 20.0 2.1)
(35.8 07.3 0.5)
(22.0 28.1 1.3)
(30.1 00.0 2.5)
(07.7 40.7 1.1)
(25.2 00.4 3.9)
(10.3 42.2 2.1)
(34.5 02.9 0.5)
(42.5 21.3 1.3)
(49.8 18.4 2.5)
(18.5 35.9 1.1)
(51.1 20.0 3.9)
(11.9 40.0 2.1)
(53.3 20.9 0.5)
)
)
(setq tolerance 1.0)
3D Test:
(eval (AB:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 4 7 13 1 10 23)
(eval (EE:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(17 11)
(eval (G*:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(17 11)
(eval (MP:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 9 15 7 13 17 11 1 10 21 23)
(eval (PK:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
nil
(eval (TW:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 15 7 13 11 17 1 10 21 23)
2D Test (2D version of previous control_points and test_points data):
(eval (AB:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 15 7 13 17 11 1 10 21 23)
(eval (EE:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 9 15 7 13 17 11 1 10 21 23)
(eval (G*:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 9 15 7 13 17 11 1 10 21 23)
(eval (MP:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 9 15 7 13 17 11 1 10 21 23)
(eval (PK:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
nil
(eval (TW:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 14 22 3 4 15 7 13 11 17 1 10 21 23)
Duplicates Test (2D) (append test_points test_points):
(eval (AB:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 26 14 38 22 46 3 27 4 28 15 39 7 31 13 37 17 41 11 35 1 25 10 34 21 45 23 47
23 47 3 27 2 26 14 38 22 46 3 27 4 28 15 39 7 31 13 37 17 41 11 35 1 25 10 34
21 45 23 47)
(eval (EE:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(26 2 38 14 46 22 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23
27 3)
(eval (G*:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(26 2 38 14 46 22 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23
27 3)
(eval (MP:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(26 2 38 14 46 22 3 27 4 28 9 33 39 15 31 7 37 13 17 41 11 35 1 25 34 10 45 21
47 23)
(eval (PK:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
nil
(eval (TW:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(2 2 14 14 22 22 3 3 4 4 15 15 7 7 13 13 11 11 17 17 1 1 10 10 21 21 23 23 0 0
18 18 12 12 20 20)
Despite errors above I benchmarked their performance:
Testing functions with test_points length of <48> ...
Elapsed milliseconds / relative speed for 2048 iteration(s):
(EE:INDEXPOINTS CONTROL_POINTS TEST_...)......2078 / 9.38 <fastest>
(PK:INDEXPOINTS CONTROL_POINTS TEST_...)......2140 / 9.11
(G*:INDEXPOINTS CONTROL_POINTS TEST_...)......3171 / 6.15
(TW:INDEXPOINTS CONTROL_POINTS TEST_...)......4093 / 4.76
(MP:INDEXPOINTS CONTROL_POINTS TEST_...)......4485 / 4.35
(AB:INDEXPOINTS CONTROL_POINTS TEST_...).....19500 / 1.00 <slowest>
Testing functions with test_points length of <768> ...
Elapsed milliseconds / relative speed for 128 iteration(s):
(EE:INDEXPOINTS CONTROL_POINTS TEST_...)......1828 / 10.38 <fastest>
(PK:INDEXPOINTS CONTROL_POINTS TEST_...)......2422 / 7.83
(G*:INDEXPOINTS CONTROL_POINTS TEST_...)......3141 / 6.04
(TW:INDEXPOINTS CONTROL_POINTS TEST_...)......4094 / 4.63
(MP:INDEXPOINTS CONTROL_POINTS TEST_...)......4484 / 4.23
(AB:INDEXPOINTS CONTROL_POINTS TEST_...).....18969 / 1.00 <slowest>
Testing functions with test_points length of <12288> ...
Elapsed milliseconds / relative speed for 8 iteration(s):
(EE:INDEXPOINTS CONTROL_POINTS TEST_...)......2000 / 8.09 <fastest>
(TW:INDEXPOINTS CONTROL_POINTS TEST_...)......4625 / 3.50
(MP:INDEXPOINTS CONTROL_POINTS TEST_...)......4907 / 3.30
(G*:INDEXPOINTS CONTROL_POINTS TEST_...).....10109 / 1.60
(PK:INDEXPOINTS CONTROL_POINTS TEST_...).....15797 / 1.02
(AB:INDEXPOINTS CONTROL_POINTS TEST_...).....16188 / 1.00 <slowest>
<kill process> Got tired of waiting / have other stuff to do.
:D
PS: I don't know why yours is failing Paul, I loaded up your latest {shrug}.
-
I know why mine is. One of the points is right on the line, and I don't have the = sign there. Once that is there, then it will be correct.
Here is the correct sub functions.
(defun PointWithin ( pt recPtList )
(and
(or
(<= (caar recPtList) (car pt) (caadr recPtList))
(<= (caadr recPtList) (car pt) (caar recPtList))
)
(or
(<= (cadar recPtList) (cadr pt) (cadadr recPtList))
(<= (cadadr recPtList) (cadr pt) (cadar recPtList))
)
)
)
-
My corrections
(defun EE:INDEXPOINTS-1 (a b c / I)
;;(EE:INDEXPOINTS-1 a b c)
(setq i 0
a (mapcar (function (lambda (a b / e d)
(setq d (distance (list (car a)(cadr a)) b)
e (mapcar (function /) (mapcar (function -) a b) (list d d))
) ;_ setq
(list (mapcar (function +) a e)
(mapcar (function -) b e)
(list (- (cadr e)) (car e))
(list d (setq i (1+ i)))
) ;_ list
) ;_ lambda
) ;_ function
a
(cdr a)
) ;_ mapcar
a (mapcar
(function (lambda (d)
(if (setq d
(cdar (vl-sort
(vl-remove-if
(function null)
(mapcar
(function (lambda (e / f p)
(if (setq p (inters (mapcar (function -) d (caddr e))
(mapcar (function +) d (caddr e))
(car e)
(cadr e)
) ;_ inters
) ;_ setq
(if (<= (setq f (distance p d)) c)
(list f p (car e) (cadddr e))
) ;_ if
) ;_ if
) ;_ lambda
) ;_ function
a
) ;_ mapcar
) ;_ vl-remove-if
(function (lambda (a b) (< (car a) (car b))))
) ;_ vl-sort
) ;_ cdar
) ;_ setq
(+ (cadadr (cdr d)) (/ (distance (car d) (cadr d)) (caaddr d)))
) ;_ if
) ;_ lambda
) ;_ function
b
) ;_ mapcar
b (length (vl-remove-if-not (function null) a))
a (vl-sort-i a (function <))
) ;_ setq
(repeat b (setq a (cdr a)))
)(defun EE:INDEXPOINTS-2 (a b c / e)
;;(EE:INDEXPOINTS-2 a b c)
(setq e (entmakex
(append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(410 . "Model")
'(100 . "AcDbPolyline")
(cons 90 (length a))
) ;_ list
(mapcar (function (lambda (b) (cons 10 b))) a)
)
)
a (mapcar (function
(lambda (a / b)
(if (<= (distance (list (car a)(cadr a))
(setq b (vlax-curve-getClosestPointTo
e
a
)
)
)
c
)
(vlax-curve-getParamAtPoint e b)
)
)
)
b
)
b (length (vl-remove-if-not (function null) a))
a (vl-sort-i
a
(function <)
)
)
(entdel e)
(repeat b (setq a (cdr a)))
)
-
Ah, mine has a side effect! The test functions variables are being used in the IndexPoints
routines. So the change to your test suite caught the bug. :ugly: Still the 3D test
and duplicate points run will fail.
Paul
-
My correction too, an a little optimisation (2 lists instead of a dotted pair list)
GC = Gilles Chanteau
(defun GC:IndexPoints (control_points test_points tolerance / pl pt l1 l2)
(vl-load-com)
(setq pl
(entmakex
(append
(list
'(0 . "lWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(70 . 0)
(cons 90 (length control_points))
)
(mapcar '(lambda (x) (cons 10 x)) control_points)
)
)
)
(foreach p (reverse test_points)
(setq pt (vlax-curve-getClosestPointTo pl p)
l1 (cons (vlax-curve-getParamAtPoint pl pt) l1)
l2 (cons (distance pt (list (car p) (cadr p))) l2)
)
)
(entdel pl)
(vl-remove-if
'(lambda (x) (< tolerance (nth x l2)))
(vl-sort-i l1 '<)
)
)
-
While I don't have anything to contribute (on pseudo-holiday at the moment), this could be potentially quite useful for some of my users. Thank you all for the ideas, I will definitely be keeping an eye on this.
Any plans for testing this with point cloud data?
-
Just to cap this thread ... Giles' and Evgeniy's last entries ...
• showed performance increases, tho in the same magnitude as prior efforts
• pass the 2D and 3D tests
• fail the duplicates test
For my own use functions based upon entity creation/deletion are, while impressive performance wise, not usable for production work.
All in all a pretty fun exercise, I thank you all for your spirited participation.
Lots of functioning gray matter herein!
:)
-
• fail the duplicates test
I don't agree.
_$ (MP:IndexPoints control_points (append test_points test_points) 1.0)
(26 2 38 14 46 22 3 27 4 28 9 33 39 15 31 7 37 13 17 41 11 35 1 25 34 10 45 21 47 23)
_$ (GC:IndexPoints control_points (append test_points test_points) 1.0)
(26 2 38 14 46 22 27 3 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23)
_$ (EE:IndexPoints-2 control_points (append test_points test_points) 1.0)
(26 2 38 14 46 22 27 3 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23)
_$ (EE:IndexPoints-1 control_points (append test_points test_points) 1.0)
(26 2 38 14 46 22 27 3 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23)
The inversions as 3 27 vs 27 3, 4 28 vs 28 4, 9 33 vs 33 9 and so on, always refer to the same overlapped points (a 24 difference).
-
Don't know what to tell you Gile, when I ran my tests (which cared not if a pair was inverted, only that the pairs were in the proper sequence) it this is what I got:
NO DUPLICATES SORT
(eval (MP:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(02 14 22 03 04 09 15 07 13 17 11 01 10 21 23)
DUPLICATES SORT
(eval (E1:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)): FAIL
(26/02 38/14 46/22 28/04 33/09 39/15 31/07 37/13 ...)
(eval (E2:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)): FAIL
(26/02 38/14 46/22 28/04 33/09 39/15 31/07 37/13 ...)
(eval (GC:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)): FAIL
(26/02 38/14 46/22 28/04 33/09 39/15 31/07 37/13 ...)
(eval (MP:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)):
(26/02 38/14 46/22 03/27 04/28 09/33 39/15 31/07 ...)
{shrug}
I'll run fresh tests later on; gotta gun to me head right now.
-
DUPLICATES SORT
(eval (E1:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)): FAIL
(26/02 38/14 46/22 28/04 33/09 39/15 31/07 37/13 ...)
(eval (E2:INDEXPOINTS CONTROL_POINTS TEST_POINTS TOLERANCE)): FAIL
(26/02 38/14 46/22 28/04 33/09 39/15 31/07 37/13 ...)
I have received other results!
(EE:INDEXPOINTS-1 a b c)
(26 2 38 14 46 22 27 3 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23)
(EE:INDEXPOINTS-2 a b c)
(26 2 38 14 46 22 27 3 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23)
(GC:IndexPoints a b c)
(26 2 38 14 46 22 27 3 28 4 33 9 39 15 31 7 37 13 41 17 35 11 25 1 34 10 45 21 47 23)
(MP:IndexPoints a b c)
(26 2 38 14 46 22 3 27 4 28 9 33 39 15 31 7 37 13 17 41 11 35 1 25 34 10 45 21 47 23)
-
Weird, I know I used the most current versions of all your submissions. If you're both getting some thing different than me I must be in err, so my apologies. I'll rerun anew ASAP. Forgive me / thanks for your patience.