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

0 Members and 1 Guest are viewing this topic.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #45 on: September 28, 2009, 08:26:29 AM »
I tried to emulate your method - only up to Step 4, so not quite as short as you:


You have completely repeated my algorithm! Our results are various - I not precisely check a site of a segment in which it is necessary to add a point in the fourth Step. If the nearest point lays on vertex self-crossing is possible. I suppose it. In the fifth Step, all point will be borrowed with new places.

Now it is necessary to start genetic algorithm.
To write one or several functions which improve a contour moving one or several points, to other place of all contour.
Each time, it is necessary to check, whether the contour became shorter, if improvement will stop.

Everything, by me it is made two programs, for genetic algorithm.
The first - search of new sites of points on a contour.
The second - removal of self-crossings.

For the list lst-a I use two programs of improvement.
For the list lst-b I use only the first program.
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #46 on: September 28, 2009, 09:46:46 AM »
I think, it will be interesting to learn, how I have found the shortest polyline.  :-)

If to do pair rearrangements in 5 step the result will be even better!

Pair rearrangements:
1. We delete two consecutive points, we add the first, then the second, we measure length.
2. Again we delete two points, we add the second, then the first and we compare length.
3. We choose the shortest variant.
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12295
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #47 on: September 28, 2009, 10:03:38 AM »
I have updated my routine, but I'm still not as short as yours...  :|

Code: [Select]
(defun mkPoly (lst / mklw vlax-list->2D-point SubLst remove_nth
               
                     i x miP maP tmp lst nlst par ptlst obj)
  (vl-load-com)

  ;;(foreach pt lst (command "_.point" "_non" pt))

  (defun mklw (l / e)
    (entmakex (append (list (cons 0   "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length l))
                            (cons 70 1))
                      (mapcar (function (lambda (a) (cons 10 a))) l))))

  (defun vlax-list->2D-point (lst)
    (if lst
      (cons (list (car lst) (cadr lst))
            (vlax-list->2D-point (cddr lst)))))

  (defun SubLst (lst i j / k)
    (setq k -1)
    (or j (setq j (length lst)))
    (vl-remove-if-not
      (function
        (lambda (x)
          (<= i (setq k (1+ k)) (+ i (1- j))))) lst))

  (defun remove_nth (k lst / j)
    (setq j -1)
    (vl-remove-if
      (function
        (lambda (x)
          (= k (setq j (1+ j))))) lst))

  (setq miP (apply 'mapcar (cons 'min lst)))
  (setq maP (apply 'mapcar (cons 'max lst)))

  (setq obj (vlax-ename->vla-object
              (mklw (list miP (list (car miP) (cadr maP)) maP (list (car maP) (cadr miP))))))

  (setq lst (vl-sort lst
              (function
                (lambda (a b) (< (distance (vlax-curve-getClosestPointto obj a) a)
                                 (distance (vlax-curve-getClosestPointto obj b) b))))))

  (setq nlst lst)
  (while (setq x (car nLst))
    (setq nLst (cdr nLst) par (fix (vlax-curve-getParamatPoint obj
                                     (vlax-curve-getClosestPointto obj x))))

    (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

    (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                        (SubLst ptlst   (1+ par) nil)))

    (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (vlax-put obj 'Coordinates (apply 'append
                               (setq ptlst
                                 (vl-remove-if-not
                                   (function (lambda (x) (vl-position x lst))) ptlst))))

  (setq i -1)
  (repeat (length ptlst)
    (setq x (nth (setq i (1+ i)) ptlst))
   
    (vlax-put obj 'Coordinates (apply 'append (Remove_nth i ptlst)))

    (setq par (fix (vlax-curve-getParamatPoint obj
                     (vlax-curve-getClosestPointto obj x))))

    (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

    (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                        (SubLst ptlst   (1+ par) nil)))

    (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (vlax-put obj 'Coordinates (apply 'append ptlst))
 
  (princ (strcat "\nPolyline Length: " (rtos (vla-get-Length obj) 2 2) " mm."))
  (princ))

Code: [Select]
Polyline Length: 2535.09 mm.


ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #48 on: September 28, 2009, 10:15:37 AM »


I have updated my routine, but I'm still not as short as yours...  





Your result is magnificent.
Using manual designing, not probably to make better!
Manual methods, it is impossible even to repeat your result, for reasonable time if to speak about a permanent job.

蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12295
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #49 on: September 28, 2009, 10:21:04 AM »
Thanks ElpanovEvgeniy  :-)

I have used your "pair rearrangment" algorithm idea - and improved my result slightly  :-)

Code: [Select]
(defun mkPoly (lst / mklw vlax-list->2D-point SubLst remove_nth
               
                     i x miP maP tmp lst nlst par ptlst obj nlst nlen)
  (vl-load-com)

  (defun mklw (l / e)
    (entmakex (append (list (cons 0   "LWPOLYLINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbPolyline")
                            (cons 90 (length l))
                            (cons 70 1))
                      (mapcar (function (lambda (a) (cons 10 a))) l))))

  (defun vlax-list->2D-point (lst)
    (if lst
      (cons (list (car lst) (cadr lst))
            (vlax-list->2D-point (cddr lst)))))

  (defun SubLst (lst i j / k)
    (setq k -1)
    (or j (setq j (length lst)))
    (vl-remove-if-not
      (function
        (lambda (x)
          (<= i (setq k (1+ k)) (+ i (1- j))))) lst))

  (defun remove_nth (k lst / j)
    (setq j -1)
    (vl-remove-if
      (function
        (lambda (x)
          (= k (setq j (1+ j))))) lst))

  (setq miP (apply 'mapcar (cons 'min lst)))
  (setq maP (apply 'mapcar (cons 'max lst)))

  (setq obj (vlax-ename->vla-object
              (mklw (list miP (list (car miP) (cadr maP)) maP (list (car maP) (cadr miP))))))

  (setq lst (vl-sort lst
              (function
                (lambda (a b) (< (distance (vlax-curve-getClosestPointto obj a) a)
                                 (distance (vlax-curve-getClosestPointto obj b) b))))))

  (setq nlst lst)
  (while (setq x (car nLst))
    (setq nLst (cdr nLst) par (fix (vlax-curve-getParamatPoint obj
                                     (vlax-curve-getClosestPointto obj x))))

    (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

    (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                        (SubLst ptlst   (1+ par) nil)))

    (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (vlax-put obj 'Coordinates (apply 'append
                               (setq ptlst
                                 (vl-remove-if-not
                                   (function (lambda (x) (vl-position x lst))) ptlst))))

    (setq i -1)
    (repeat (length ptlst)
      (setq x (nth (setq i (1+ i)) ptlst))
     
      (vlax-put obj 'Coordinates (apply 'append (Remove_nth i ptlst)))
      (setq par (fix (vlax-curve-getParamatPoint obj
                       (vlax-curve-getClosestPointto obj x))))

      (setq ptlst (vlax-list->2D-point (vlax-get obj 'Coordinates)))

      (setq ptlst (append (SubLst ptlst 0 (1+ par)) (list x)
                          (SubLst ptlst   (1+ par) nil)))

      (vlax-put obj 'Coordinates (apply 'append ptlst)))

  (setq i -1)
  (repeat (- (length ptlst) 1)
    (setq x (nth (setq i (1+ i)) ptlst) y (nth (1+ i) ptlst))

    (vlax-put obj 'Coordinates (apply 'append ptlst))
    (setq len (vla-get-length obj))

    (setq nlst (append (SubLst ptlst 0 i) (list y x)
                       (Sublst ptlst (+ i 2) nil)))

    (vlax-put obj 'Coordinates (apply 'append nlst))
    (if (< (setq nlen (vla-get-length obj)) len)
      (setq ptlst nlst len nlen)))

  (vlax-put obj 'Coordinates (apply 'append ptlst))
 
  (princ (strcat "\nPolyline Length: " (rtos (vla-get-Length obj) 2 4) " mm."))
  (princ))





Almost there - although I don't think I'm anywhere near a Generic one!  :lol:

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #50 on: September 28, 2009, 10:30:16 AM »
Excellent result!
You very quickly understand an essence.

I shall dare to give one more advice.
Functions vlax-curve-* work much more quickly if it to transfer argument ename than object.
Especially strongly, it is appreciable on the contours having a plenty of segments.
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12295
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #51 on: September 28, 2009, 10:37:14 AM »
Excellent result!
You very quickly understand an essence.

I shall dare to give one more advice.
Functions vlax-curve-* work much more quickly if it to transfer argument ename than object.
Especially strongly, it is appreciable on the contours having a plenty of segments.

Thank you  :-)

I didn't realise that curve functions worked faster with enames... I thought they had the same performance with objects and enames... thanks for that.  :wink:

Lee Mac

  • Seagull
  • Posts: 12295
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #52 on: September 28, 2009, 10:39:12 AM »
Just had to test it :P

Code: [Select]
Elapsed milliseconds / relative speed for 16384 iteration(s):

    (vlax-curve-getEndParam ENT).....1233 / 1.43 <fastest>
    (vlax-curve-getEndParam OBJ).....1763 / 1.00 <slowest>

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #53 on: September 28, 2009, 10:48:38 AM »
Just had to test it :P

Code: [Select]
Elapsed milliseconds / relative speed for 16384 iteration(s):

    (vlax-curve-getEndParam ENT).....1233 / 1.43 <fastest>
    (vlax-curve-getEndParam OBJ).....1763 / 1.00 <slowest>

It is not enough, who knows. In the help autocad it is told, it is necessary to use curve-obj - VLA-object.
About an opportunity of use ename - it is not written.

Try to create a polygon "_polygon" with a lot of segments, for example 600 and try to compare speed for
vlax-curve-getDistAtPoint
You will be strongly surprised...

ps. If the polyline has arc segments, the difference is even more!
In my practice there was a difference in 200 times!
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #54 on: September 28, 2009, 10:59:43 AM »
It is very a pity, I hoped, in a theme will be more participants...

Earlier, themes with the name " (Challenge) *** " were more often also than participants was more.
Prompt me, it was very complex task or it was not interesting?
Probably, I have had time to offend?

Whether themes " (Challenge) *** " with tasks for algorithms are necessary or programming with comparison of quantity of lines and is interesting only to time of performance?

蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

Lee Mac

  • Seagull
  • Posts: 12295
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #55 on: September 28, 2009, 11:08:41 AM »
It is very a pity, I hoped, in a theme will be more participants...

Earlier, themes with the name " (Challenge) *** " were more often also than participants was more.
Prompt me, it was very complex task or it was not interesting?
Probably, I have had time to offend?

Whether themes " (Challenge) *** " with tasks for algorithms are necessary or programming with comparison of quantity of lines and is interesting only to time of performance?

I think rather that this task is based more on the best Algorithm rather than the fastest programming solution, and hence knowledge of the language.

Therefore there are fewer "obvious" solutions.

Probably, I have had time to offend?

No, I very much doubt that.  :-)


T.Willey

  • Needs a day job
  • Posts: 5218
Re: (Challenge) To draw the shortest lwpolyline
« Reply #56 on: September 28, 2009, 11:12:13 AM »
I liked the idea, but I didn't have time to participate.  I don't think I have the knowledge either.  I would have to read the link supplied, and then come up with some code.  I might have some time this week, but no promises.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1542
  • Moscow (Russia)
Re: (Challenge) To draw the shortest lwpolyline
« Reply #57 on: September 28, 2009, 11:14:00 AM »

I think rather that this task is based more on the best Algorithm rather than the fastest programming solution, and hence knowledge of the language.


For the second list, we pressed out covering loop, and it was possible to inflate a bubble.
In general, it is possible to think up many different algorithms.
By the way, I am not assured, that my result the shortest!
蝸牛そろそろ登れ富士の山 /Kobayashi Issa/

VovKa

  • Swamp Rat
  • Posts: 1174
  • Ukraine
Re: (Challenge) To draw the shortest lwpolyline
« Reply #58 on: September 28, 2009, 11:29:22 AM »
Lee, your code crashes when supplied '((20.0 0.0) (80.0 0.0) (100.0 100.0) (0.0 100.0)) as an argument
Quote
; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

Lee Mac

  • Seagull
  • Posts: 12295
  • London, England
Re: (Challenge) To draw the shortest lwpolyline
« Reply #59 on: September 28, 2009, 11:34:05 AM »
Lee, your code crashes when supplied '((20.0 0.0) (80.0 0.0) (100.0 100.0) (0.0 100.0)) as an argument
Quote
; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

VovKa, I find I sometimes get those errors when using the 'Coordinates Property - I am not entirely sure what causes it though, I am not sure why my code would work with Evgeniy's long list of points as opposed to your 4 points.  :?