Author Topic: ( Challenge ) Shortest & Longest line  (Read 12223 times)

0 Members and 1 Guest are viewing this topic.

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
( Challenge ) Shortest & Longest line
« on: January 30, 2013, 12:31:06 PM »
EXPERIENCED CODERS PLEASE WAIT AT LEAST 24 HOURS BEFORE POSTING YOUR CODE. THANKS

Ok, here is the challenge. The attached file has thousands of lines in it. Your challenge is to write a program that will return the shortest and longest lines in the attached file and erase the others. Bonus points for the fastest program and breaking it down by layers.

Have fun! :)

Thanks to Lee Mac for providing the code that created the file. :)
TheSwamp.org  (serving the CAD community since 2003)

Tharwat

  • Swamp Rat
  • Posts: 710
  • Hypersensitive
Re: ( Challenge ) Shortest & Longest line
« Reply #1 on: January 30, 2013, 01:05:42 PM »
Hi .

I am not experienced coder yet , so I am more than happy to be the first one to give a try on it .  :-)

Code - Auto/Visual Lisp: [Select]
  1. (defun c:test (/ ss i e sn lst sh lo j)
  2.   ;;; Tharwat 30. Jan. 2013 ;;;
  3.   (if (setq ss (ssget "_x" '((0 . "LINE"))))
  4.     (progn
  5.       (repeat (setq i (sslength ss))
  6.         (setq e (entget (setq sn (ssname ss (setq i (1- i))))))
  7.         (setq lst
  8.                (vl-list*
  9.                  (list (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))) sn)
  10.                  lst
  11.                )
  12.         )
  13.       )
  14.       (setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
  15.       (setq sh (cadr lst)
  16.             lo (cadr (last lst))
  17.             j  0
  18.       )
  19.       (repeat (- (length lst) 2)
  20.         (entdel (cadr (nth (setq j (1+ j)) lst)))
  21.       )
  22.     )
  23.   )
  24.   (princ)
  25. )
  26.  
  27.  

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Re: ( Challenge ) Shortest & Longest line
« Reply #2 on: January 30, 2013, 01:19:57 PM »
Nice job Tharwat!
TheSwamp.org  (serving the CAD community since 2003)

Tharwat

  • Swamp Rat
  • Posts: 710
  • Hypersensitive
Re: ( Challenge ) Shortest & Longest line
« Reply #3 on: January 30, 2013, 01:27:16 PM »
Nice job Tharwat!

Thank you Mark .  :-)

I have two extra variables ( sh , lo) that should be removed since There is no need of them .

Lee Mac

  • Seagull
  • Posts: 12914
  • London, England
Re: ( Challenge ) Shortest & Longest line
« Reply #4 on: January 30, 2013, 03:38:57 PM »
Here is a short & simple timing function so that we may compare challenge entries  :-)

Code: [Select]
(defun time-it ( expr / et st )
    (setq st (getvar 'millisecs))
    (eval expr)
    (setq et (getvar 'millisecs))
    (princ (strcat "\nProgram running time: " (itoa (- et st)) " msecs."))
    (princ)
)

Call with quoted expression:
Code: [Select]
(time-it '(c:test))
Thanks for the nod Mark :-)

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Re: ( Challenge ) Shortest & Longest line
« Reply #5 on: January 30, 2013, 03:41:42 PM »
Here is a short & simple timing function so that we may compare challenge entries  :-)
Thanks Lee. I was just going to ask ... :)
TheSwamp.org  (serving the CAD community since 2003)

Stefan

  • Bull Frog
  • Posts: 319
  • The most I miss IRL is the Undo button
Re: ( Challenge ) Shortest & Longest line
« Reply #6 on: January 30, 2013, 03:42:43 PM »
I think I'd be too arrogant to cosider myself an experienced coder, so here is my code:
Code - Auto/Visual Lisp: [Select]
  1. (defun C:MinMaxLine ( / d ss i l e m n tm)
  2.   (defun d (e / en)
  3.     (distance
  4.       (cdr (assoc 10 (setq en (entget e))))
  5.       (cdr (assoc 11 en)))
  6.     )
  7. ;;;  (setq tm (getvar 'millisecs))
  8.   (if
  9.     (setq ss (ssget "_X" '((0 . "LINE"))))
  10.     (progn
  11.       (setq e (ssname ss 0)
  12.             m (list (d e) e)
  13.             n m
  14.             )
  15.       (repeat (setq i (sslength ss))
  16.         (setq e (ssname ss (setq i (1- i)))
  17.               l (d e)
  18.               )
  19.         (if (< l (car m)) (setq m (list l e)))
  20.         (if (> l (car n)) (setq n (list l e)))
  21.         (entdel e)
  22.         )
  23.       (entdel (cadr m))
  24.       (entdel (cadr n))
  25.       (print (list (car m) (car n)))
  26.       )
  27.     )
  28. ;;;  (print (- (getvar 'millisecs) tm))
  29.   (princ)
  30.   )

Lee Mac

  • Seagull
  • Posts: 12914
  • London, England
Re: ( Challenge ) Shortest & Longest line
« Reply #7 on: January 30, 2013, 03:47:23 PM »
I think I'd be too arrogant to cosider myself an experienced coder

I think you give yourself too little credit  :-)
Very good solution using an 'unerase'

LE3

  • Guest
Re: ( Challenge ) Shortest & Longest line
« Reply #8 on: January 30, 2013, 03:59:35 PM »
... something simple in c#:
Code: [Select]
[CommandMethod("SHOLON")]
public void cmd_shortestLongestLines()
{
    var e = AcadApp.DocumentManager.MdiActiveDocument.Editor;
    TypedValue[] tv = { new TypedValue((int)DxfCode.Start, "LINE") };
    var filter = new SelectionFilter(tv);
    var options = new PromptSelectionOptions
    {
        MessageForAdding = "\nAdd lines to selection",
        MessageForRemoval = "\nRemove lines from selection",
        AllowDuplicates = false,
        RejectObjectsFromNonCurrentSpace = true
    };
    var psr = e.GetSelection(options, filter);
    if (psr.Status != PromptStatus.OK) return;
    var sw = new Stopwatch();
    var pairs = new SortedList<double, ObjectId>();
    using (var tr = e.Document.Database.TransactionManager.StartTransaction())
    {
        sw.Start();
        foreach (var id in psr.Value.GetObjectIds())
        {
            var line = tr.GetObject(id, OpenMode.ForRead) as Line;
            if (line != null)
            {
                pairs.Add(line.Length, id);
            }
        }
        pairs.RemoveAt(0);
        pairs.RemoveAt(pairs.Count - 1);
        foreach (var pair in pairs)
        {
            tr.GetObject(pair.Value, OpenMode.ForWrite).Erase();
        }
        sw.Stop();
        tr.Commit();
    }
    e.WriteMessage("\nElapsed.TotalMilliseconds={0} \n", sw.Elapsed.TotalMilliseconds);
}
Elapsed.TotalMilliseconds=1320.1172
« Last Edit: February 06, 2013, 03:47:13 PM by LE »

ronjonp

  • Needs a day job
  • Posts: 7529
Re: ( Challenge ) Shortest & Longest line
« Reply #9 on: January 30, 2013, 04:59:15 PM »
I think I'd be too arrogant to cosider myself an experienced coder

...
Very good solution using an 'unerase'

Beat me to it .. that was in my solution too  :-(  ... when can I play?  :lmao:

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

kruuger

  • Swamp Rat
  • Posts: 635
Re: ( Challenge ) Shortest & Longest line
« Reply #10 on: January 30, 2013, 07:23:55 PM »
vla approach:
Code: [Select]
(defun c:KRU (/ res)
  (ssget "_x" '((0 . "LINE")))
  (vlax-for %
    (vla-get-activeselectionset
      (vla-get-activedocument
        (vlax-get-acad-object)
      )
    )
    (setq res (cons (list (vla-get-length %) %) res))
    (if (> (length res) 2)
      (progn
        (setq res
          (vl-sort res
            (function
              (lambda (%1 %2)
                (< (car %1) (car %2))
              )
            )
          )
        )
        (vla-delete (cadadr res))
        (setq res (list (car res) (last res)))
      )
    )
  )
  (list
    (cons (caar res) (vla-get-layer (cadar res)))
    (cons (caadr res) (vla-get-layer (cadadr res)))
  )
)

EDIT: revised to return
Code: [Select]
((19.6269 . "CYAN") (1528.89 . "GREEN"))
« Last Edit: January 31, 2013, 04:45:05 AM by kruuger »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: ( Challenge ) Shortest & Longest line
« Reply #11 on: January 30, 2013, 11:57:46 PM »
Great challenge Mark.
Thanks for the timer Lee.

Code: [Select]
TIME-IT
((BLUE 20.1582 1442.59 <Entity name: 7d3ad5e8>) (CYAN 19.6269 1468.04 <Entity name: 7d3b2240>) (GREEN 20.9117 1528.89 <Entity name: 7d3a07b0>) (RED 20.5474 1504.13 <Entity name: 7d3a5ba8>))
Program running time: 702 msecs.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: ( Challenge ) Shortest & Longest line
« Reply #12 on: January 31, 2013, 01:22:24 AM »
Great challenge Mark.
Thanks for the timer Lee.

Code: [Select]
TIME-IT
((BLUE 20.1582 1442.59 <Entity name: 7d3ad5e8>) (CYAN 19.6269 1468.04 <Entity name: 7d3b2240>) (GREEN 20.9117 1528.89 <Entity name: 7d3a07b0>) (RED 20.5474 1504.13 <Entity name: 7d3a5ba8>))
Program running time: 702 msecs.


wow .. really? maybe I just have a slow computer ... mine runs about 3600 msecs
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1453
  • Marco
Re: ( Challenge ) Shortest & Longest line
« Reply #13 on: January 31, 2013, 03:35:28 AM »
My version:
Code - Auto/Visual Lisp: [Select]
  1. (defun C:ShortLongest ( / SelSet Countr EntSht EntLng LenVal MaxLen MinLen)
  2.   (defun Dxf (DxfCod EntDat)  (cdr (assoc DxfCod EntDat)))
  3.   (if (setq SelSet (ssget "_X" '((0 . "LINE"))))
  4.     (progn
  5.       (setvar "HIGHLIGHT" 0)
  6.       (setq
  7.         Countr 0
  8.         EntSht (ssname SelSet 0)
  9.         EntLng EntSht
  10.         EntDat (entget EntSht)
  11.         MaxLen (distance (Dxf 10 EntDat) (Dxf 11 EntDat))
  12.         MinLen  MaxLen
  13.       )
  14.       (repeat (sslength SelSet)
  15.         (setq
  16.           EntNam (ssname SelSet Countr) EntDat (entget EntNam)
  17.           LenVal (distance (Dxf 10 EntDat) (Dxf 10 EntDat))
  18.           Countr (1+ Countr)
  19.         )
  20.         (cond
  21.           ( (> LenVal MaxLen) (setq MaxLen LenVal  EntLng EntNam) )
  22.           ( (< LenVal MinLen) (setq MinLen LenVal  EntSht EntNam) )
  23.         )
  24.       )
  25.       (command "_.ERASE" SelSet "_R" (ssadd EntSht (ssadd EntLng)) "")
  26. ;      (princ (strcat "\n" (itoa Countr) " erased entity(es). Use Oops to restore. "))
  27.       (setvar "HIGHLIGHT" 1)
  28.     )
  29.     (alert "No lines to erase.")
  30.   )
  31. )

ribarm

  • Gator
  • Posts: 3274
  • Marko Ribar, architect
Re: ( Challenge ) Shortest & Longest line
« Reply #14 on: January 31, 2013, 04:24:47 AM »
This is off-topic, but if I run TEST-TIMES twice, I get 2 different results... Can someone explain :

Code: [Select]
(defun time-it ( expr msg / et st )
    (setq st (getvar 'millisecs))
    (eval expr)
    (setq et (getvar 'millisecs))
    (princ (strcat msg (itoa (- et st)) " msecs."))
    (princ)
)

(defun dst (p1 p2 / v)
    (setq v (mapcar '- p2 p1))
    (sqrt (+ (expt (car v) 2) (expt (cadr v) 2) (expt (caddr v) 2)))
)

(defun makelst ( / k l1 l2 )
    (setq k 0.0)
    (repeat 20000
        (setq l1 (append l1 (setq l1 (list (1+ k)))))
    )
    (setq l2 (reverse l1))
    (setq ptlst (mapcar '(lambda (a b c) (list a b c)) l1 l1 l2))
)

(defun testdst ( ptlst )
    (mapcar '(lambda (a b) (dst a b)) ptlst (cdr ptlst))
)

(defun testdistance ( ptlst )
    (mapcar '(lambda (a b) (distance a b)) ptlst (cdr ptlst))
)

(defun c:test-times ( / ptlst )
    (makelst)
    (time-it '(testdst ptlst) "\n\"Dst\" function running time: ")
    (time-it '(testdistance ptlst) "\n\"Distance\" LISP function running time: ")
    (textscr)
    (princ)
)

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube