Author Topic: (Challenge) To draw the shortest lwpolyline  (Read 39289 times)

0 Members and 3 Guests are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #150 on: June 30, 2020, 01:09:22 PM »
I figured this out : Maybe someone really needs this faster... So I had a time to combine posted codes and I managed to improve shortpath.vlx results... Results are better, but in cost of speed... But all in all I used all fast codes I saw and now I suppose that it's acceptable... So finally this is what I came with, but I must warn you : don't take everything for grand... The results are better, but not reliable like it's supposed to be (my last code I posted), but who the hell can wait to eternity to get a result that is satisfactory enough... And just not to forget, thanks to Mr. Evgeniy Elpanov and chlh_jd who both provided very well codes for us to develop based on them... I know - I haven't stated inside LISP from where codes (subs) originates, but I modified them myself and they are obvious for reader so I believe that anyone can recognize them... So I dwarfed shortpath.vlx which is BTW. not open source and is old enough so I can say with very much confident that that file is no longer efficient - IMO it used E.E. subs combined with chlh_jd's in very direct way... (when you check results - it's almost exact copy of chlh_jd's code posted in this topic)

So here is my LISP and I hope you'll find it somewhat more useful then I do, but anyway it was fun to code it...
Regards, M.R.

[EDIT : There were some lacks in localizing variables of sub functions... I'll reattach LSP - there were 7 downloads till now...]
« Last Edit: July 01, 2020, 01:38:35 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #151 on: July 02, 2020, 11:41:42 AM »
Hi, me again...
After very limited testings, I discovered that there were no differences between original version and my mod. of chlh_jd's sub... I find that using (/ pi 2.0) angle is somewhat more mathematical and theoretical better than using both (/ pi 2.0) and (/ pi 3.0) and therefore I have chosen my mod. better... It's somewhat faster as it don't process last portion I commented and now it's only the question why chlh_jd used both angles in checking... If someone finds differences between those two, please leave the comment... Here is my mod. I am using now :

Code - Auto/Visual Lisp: [Select]
  1. ...
  2.   (defun chlh_jd-process ( lst / l m p p0 p1 q i d0 l0 l1 d1 _pi2 _pi3 )
  3.     (setq _pi2 (/ pi 2.0) _pi3 (/ pi 3.0))
  4.     (setq lst (foo lst))
  5.     (setq l (f2 lst))
  6.     (setq i  0
  7.           l0 lst
  8.           q  (length lst)
  9.           d0 (get-closedpolygon-length lst)
  10.     )
  11.     (foreach a l
  12.       (if (and (< a _pi2) (setq p (nth i lst))) ;;; original version : (and (< a _pi3) (= (setq p (nth i lst)) (nth i l0)))
  13.         (progn
  14.           (if (= i 0)
  15.             (setq p0 (last lst))
  16.             (setq p0 (nth (1- i) lst))
  17.           )
  18.           (if (= i (1- q))
  19.             (setq p1 (car lst))
  20.             (setq p1 (nth (1+ i) lst))
  21.           )
  22.           (setq m (list (list p0 p p1)
  23.                         (list p0 p1 p)
  24.                         (list p1 p p0)
  25.                         (list p1 p0 p)
  26.                         (list p p0 p1)
  27.                         (list p p1 p0)
  28.                   )
  29.           )
  30.           (setq l1
  31.             (car
  32.               (vl-sort (mapcar
  33.                          (function
  34.                            (lambda ( x )
  35.                              (ch-para-lst x i lst)
  36.                            )
  37.                          )
  38.                          m
  39.                        )
  40.                 (function (lambda ( e1 e2 )
  41.                     (< (get-closedpolygon-length e1)
  42.                        (get-closedpolygon-length e2)
  43.                     )
  44.                   )
  45.                 )
  46.               )
  47.             )
  48.           )
  49.           (setq d1 (get-closedpolygon-length l1))
  50.           (if (< d1 d0)
  51.             (setq d0  d1
  52.                   lst l1
  53.             )
  54.           )
  55.         )
  56.       )
  57.       (setq i (1+ i))
  58.     )
  59.     ;;; original version has this portion that is commented between ;| and |;
  60.     ;|
  61.     (setq l (f2 lst))
  62.     (setq i  0
  63.           l0 lst
  64.           d0 (get-closedpolygon-length lst)
  65.     )
  66.     (foreach a l
  67.       (if (and (< a _pi2) (setq p (nth i l0)))
  68.         (progn
  69.           (setq l1 (f1 p (vl-remove p lst)))
  70.           (setq d1 (get-closedpolygon-length l1))
  71.           (if (< d1 d0)
  72.             (setq d0  d1
  73.                   lst l1
  74.             )
  75.           )
  76.         )
  77.       )
  78.       (setq i (1+ i))
  79.     )
  80.     |;
  81.     lst
  82.   )
  83. ...
  84.  
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

John Kaul (Se7en)

  • Administrator
  • Needs a day job
  • Posts: 9476
Re: (Challenge) To draw the shortest lwpolyline
« Reply #152 on: July 02, 2020, 12:04:45 PM »
> slow
I've lost almost all of my lisp abilities but, to me, this seems like an awful lot of anonymous functions and variable declarations.

Also, function names like "foo", "det", "f1", etc. make this code unreadable.

Here are a few quick copy/pastes from the lisp file (not exhaustive or inclusive; just random areas showing excessive annon functions).
Couldn't some of these annon functions be simplified?
Code - Auto/Visual Lisp: [Select]
  1. ...
  2.               (setq lst
  3.                   (vl-sort lst
  4.                       (function
  5.                           (lambda ( a b / c d )
  6.                               (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))))
  7.                                   (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
  8.                                   (< c d)
  9.                               )
  10.                           )
  11.                       )
  12.                   )
  13.               )
  14.               (setq lstl (vl-remove-if-not (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  15.               (setq lst (vl-remove-if (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  16.               (setq lstl (vl-sort lstl (function (lambda ( a b ) (> (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))))))
  17.               (setq lst (append lst lstl))
  18.  
  19. ...
  20. (defun chulllw2 ( l v / ll ent ls lll lil lial liall )
  21.     (setq ll  (if (= v 1) (LM:ConvexHull-ptsonHull l) (Graham-scan l))
  22.           ent (entmakex (append (list '(0 . "LWPOLYLINE")
  23.                                       '(100 . "AcDbEntity")
  24.                                       '(100 . "AcDbPolyline")
  25.                                       (cons 90 (length l))
  26.                                       (cons 70 (1+ (* 128 (getvar 'plinegen))))
  27.                                       '(38 . 0.0)
  28.                                 )
  29.                                 (mapcar (function (lambda ( a ) (cons 10 a))) ll)
  30.                         )
  31.               )
  32.     )
  33.     (setq ls l)
  34.     (foreach a ll (setq ls (vl-remove a ls)))
  35.     (setq lll ll)
  36.     (while (/= (length lll) (length l))
  37.       (setq lil (mapcar (function list) lll (append (cdr lll) (list (car lll)))))
  38.       (foreach a ls
  39.         (setq lial (mapcar (function (lambda ( x ) (cons (+ (distance (car x) a) (distance (cadr x) a)) (list x a)))) lil))
  40.         (setq liall (cons lial liall))
  41.       )
  42.       (setq liall (vl-sort liall (function (lambda ( a b ) (< (apply (function min) (mapcar (function car) a)) (apply (function min) (mapcar (function car) b)))))))
  43.       (setq lial (car (vl-sort (car liall) (function (lambda ( a b ) (< (car a) (car b)))))))
  44.       (entmod (append (reverse (member (cons 10 (car (cadr lial))) (reverse (entget ent))))
  45.                       (list (cons 10 (caddr lial)))
  46.                       (member (cons 10 (cadr (cadr lial))) (entget ent))
  47.               )
  48.       )
  49.       (setq lll (mapcar (function cdr)
  50.                         (vl-remove-if (function (lambda ( a ) (/= (car a) 10))) (entget ent))
  51.                 )
  52.       )
  53.       (setq ls (vl-remove (caddr lial) ls))
  54.       (setq liall nil)
  55.     )
  56.     ent
  57.   )
  58.  
  59.   (defun car-sort ( lst cmp / f rtn )
  60.  
  61.     (defun f ( x )
  62.       (setq lst (cdr lst))
  63.       (if (apply cmp (list x rtn))
  64.         (setq rtn x)
  65.       )
  66.     )
  67.  
  68.     (setq rtn (car lst))
  69.     (while (vl-some (function f) (cdr lst)))
  70.     rtn
  71.   )
  72.  
  73.   (defun chkinters ( pl / lil k a ilil pre mid suf )
  74.     (setq lil (mapcar (function list) pl (append (cdr pl) (list (car pl)))))
  75.     (setq k -1)
  76.     (while (and (< (setq k (1+ k)) (length lil)) (setq a (nth k lil)))
  77.       (setq ilil (vl-some (function (lambda ( b / ip ) (setq ip (inters (car a) (cadr a) (car b) (cadr b))) (if (and ip (setq ip (mapcar (function +) '(0 0) ip)) (or (and (or (equal ip (car a) 1e-6) (equal ip (cadr a) 1e-6)) (not (equal ip (car b) 1e-6)) (not (equal ip (cadr b) 1e-6))) (and (or (equal ip (car b) 1e-6) (equal ip (cadr b) 1e-6)) (not (equal ip (car a) 1e-6)) (not (equal ip (cadr a) 1e-6))) (and (not (equal ip (car a) 1e-6)) (not (equal ip (cadr a) 1e-6)) (not (equal ip (car b) 1e-6)) (not (equal ip (cadr b) 1e-6))))) (list a b)))) (vl-remove a lil)))
  78.       (if ilil
  79.         (progn
  80.           (setq pre (reverse (cdr (member (car ilil) (reverse lil)))))
  81.           (setq mid (cdr (member (car ilil) lil)))
  82.           (setq mid (cdr (member (cadr ilil) (reverse mid))))
  83.           (setq mid (mapcar (function reverse) mid))
  84.           (setq suf (cdr (member (cadr ilil) lil)))
  85.           (setq lil (append pre (list (list (car (car ilil)) (car (cadr ilil)))) mid (list (list (cadr (car ilil)) (cadr (cadr ilil)))) suf))
  86.           (setq pre nil mid nil suf nil)
  87.           (setq ilil nil k -1)
  88.         )
  89.       )
  90.     )
  91.     (mapcar (function car) lil)
  92.   )
  93.  
  94.   (prompt "\nSelect points, blocks or circles...")
  95.   (if (setq ss (ssget '((0 . "POINT,INSERT,CIRCLE"))))
  96.     (progn
  97.       (repeat (setq i (sslength ss))
  98.         (setq pl (cons (mapcar (function +) '(0 0) (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))) pl))
  99.       )
  100.       (setq ti (car (_vl-times)))
  101.       (setq l pl)
  102.       (setq lw (greedy pl))
  103.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (setq lwx (entget lw)))))
  104.       (setq pll (cons pl pll))
  105.       (generic lwx)
  106.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (setq lwx (entget lw)))))
  107.       (entdel lw)
  108.       (setq pl (chkinters pl))
  109.       (setq pll (cons pl pll))
  110.       (generic (entget (chulllw1 l 1)))
  111.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget (entlast)))))
  112.       (entdel (entlast))
  113.       (setq pl (chkinters pl))
  114.       (setq pll (cons pl pll))
  115.       (generic (entget (chulllw1 l 2)))
  116.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget (entlast)))))
  117.       (entdel (entlast))
  118.       (setq pl (chkinters pl))
  119.       (setq pll (cons pl pll))
  120.       (generic (entget (chulllw2 l 1)))
  121.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget (entlast)))))
  122.       (entdel (entlast))
  123.       (setq pl (chkinters pl))
  124.       (setq pll (cons pl pll))
  125.       (generic (entget (chulllw2 l 2)))
  126.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget (entlast)))))
  127.       (entdel (entlast))
  128.       (setq pl (chkinters pl))
  129.       (setq pll (cons pl pll))
  130.       (TSP-chlh_jd l 1)
  131.       (setq pl (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) (entget (entlast)))))
  132.       (entdel (entlast))
  133. ...
  134.  
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #153 on: July 02, 2020, 12:45:16 PM »
Just to reply from my perspective... I am also not so called lisp genius - it takes lots of practice to change style and way you code... Someone is born with that talent, someone not... MP is one fine example of person that has abilities of lisping made to perfection... I am just simple guy that tries to help in the way God has blessed me... As for the code, yes it can always be better written, but I tried to keep as much as possible exactly the same written material as original authors left us... That's why (foo) (f1) (det)... If you have some better remarks in the way posted routine works - functions it would be perfect to make those things implemented... It's just that TSP is way too complex programming challenge and it simply isn't easy to cobble together all needed components that can make it fast/correct in the way it should be expected... There is even no way to test for correctness of results - it's all wild guessing unless you choose simple task (cca. 10 points at maximum) and use checking by all possibilities for order the points that form closed path... Now, please don't avoid to reply on my previous observation about sub function that is used... Actually I even don't care too much how the code looks, someone can always make cosmetic changes... To me it's much more important how it works and what could be better in that manner... And yes, it looks that there are more material than needed, but in fact every sub is used in the code - there is no unused functions - it all works together and only combined it makes completeness...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #154 on: July 02, 2020, 06:17:40 PM »
I totally discarded checking of angles and let it process all points in list by triplets of points... Also I used (while) as with (foreach) list is not updating during calculations inside sub... I know that this is now slower then it was and perhaps it gives the same results, but in fact it's better coded - more reliable in terms of what it is doing... Also all subs are needed except newly added (ang) and (f2) that are looking for angles, but I leaved them as there are some comments related to them... So nothing is removed only added and commented those things that aren't necessity... In attachment is my mod. version that I use now...

M.R.

[EDIT : I've replaced 2 subs from chlh_jd's codes with newer more obvious versions that are shorter... But still chlh_jd's subs are faster by my testings, so I just added them for comparison reasons and leaved active chlh_jd's and my versions deactivated... There were 3 downloads till now...]
« Last Edit: July 06, 2020, 06:21:00 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #155 on: July 04, 2020, 01:38:14 PM »
From fast routines to implementation of depth permutation parameter...
So your remark (John) is that it is slow...
Well, it can always be slower, lol...

But in fact, I am satisfied now with this depth version... It should yield the same results as previous with depth=3, but if you put a little higher (for ex. 6), IMO it will be very close to exact solution, no matter how long does it take to finish...
I've tested on my tricky example with 11 points and it did correct at about 40 seconds with my PC - this is still faster than doing full permutations... In routine I hard coded - preferable number 3, but maybe it's actually 6, if you have more time...

Regards, M.R.
« Last Edit: July 10, 2020, 02:03:07 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #156 on: July 05, 2020, 01:36:18 AM »
shorthpath.vlx results beaten by TSP.lsp at about 300 sec...
TSP.lsp results beaten by TSP-depth.lsp at about 5.5 hours...

http://www.theswamp.org/index.php?topic=30434.msg591042#msg591042
This results were beaten...

« Last Edit: July 10, 2020, 08:43:31 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #157 on: July 10, 2020, 02:22:58 AM »
I've reattached TSP-depth.lsp as I improved timings... There is little changes, but there are some and I had to give up of some previous calculations to gain more speed... If you find TSP interesting to you too, then recheck your tasks - it passed all mine very well - not exact solutions as previous were, but that one that was different also yield shortest length as in my example there could be multiple solutions with shortest path...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2366
  • Marko Ribar, architect
Re: (Challenge) To draw the shortest lwpolyline
« Reply #158 on: August 01, 2020, 11:06:27 AM »
This is how story continues...
While testing TSP-depth.lsp through AutoCAD and BricsCAD, I noticed that on one example in BricsCAD, routine caused lag... So I retested it and it was the same... At first glance I thought it was something with BricsCAD, so I left it there and switched to AutoCAD testings... I wander how anyone haven't noticed this issue and report this bug... So there it was all the time routine had lacks and now I dedicated little of my time to debugg it... Everything was correct except (chulllw2) sub function... Nevertheless as I didn't know where the issue was, I remedy and some other things I found... I figured what is the point not to fix it for both ACAD and BCAD when BCAD is faster and is IMHO the best choice for performing this task - TSP solution, so there it was, I had to debugg it under BCAD... So finally I haven't retested it under BricsCAD - that DWG I posted last, but I believe that it would be way under 4-5 hours... It was my pleasure to have sub functions from master Evgeniy, Lee and chlh_jd and make this version that satisfies my needs and I believe and needs of many others...
Thanks for your attention and suggestions I recieved from many that participated and gave cntributions to this challenging topic...
Regards, M.R.
Attahched - my latest debugged version that should work well for both ACAD and BCAD...
« Last Edit: August 02, 2020, 05:40:24 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube