Author Topic: Looking for a better way...  (Read 13079 times)

0 Members and 1 Guest are viewing this topic.

LibertyOne

  • Guest
Looking for a better way...
« on: June 23, 2012, 04:56:58 PM »
...to reprogram a bit of code.

I wrote a small program about 11 years ago (for AutoCAD R14), and at that time with my knowledge of AutoLisp that I had. I recently dug this code out, reevaluated it and made it work for AutoCAD 2010. Knowing what I know now, I have a feeling this code is a bit redundant and I'm looking for a way to shorten it or find a different solution.

The function does the following:

Starting with two lists of different length, it cycles through each one simultaneously pairing the atoms of each list. When one list comes to the end, it starts over from the beginning. The same with the other list. For example, the first list could have any number of atoms from 1 to the maximal allowed. The second list is an  list of points which are fixed at 11.

Added to the program is a counter that exits the program once so many paired items have gone through which the user sets at the beginning of the program.

The counter is a WHILE statement counting down the total number of points and the cycling is done with IF statements. At the time I wrote the program I didn't think COND could be an option because it would exit the program during the 11 point cycle. The program needs to continuously step through the 11 point cycle and has to decide if the point is to be carried out or not. If the counter is exhausted, then it stops at this point and exits the program.

I've listed the basic structure of the code to read through, but took out what it does to each point in the PROGN statement because it's not relevant. Trying to run it would fail.

The main question I have is if I could somehow get rid of all the IF statements and substitute them with something else.

If my question is not clear, just ask I'll try to explain it again. I look forward to hearing from you.


Code: [Select]
(setq num_pl 0)
        (setq        num 100)
(while (< num_pl num)
(if (< num_pl num)
(progn
(...pt01)
)
)
(command "_.change" el "" "_p" "_c" col_pl "")
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt02)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt03)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt04)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt05)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt06)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt07)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt08)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt09)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt10)
)
)
(setq num_pl (1+ num_pl))
(if (< num_pl num)
(progn
(...pt11)
)
)
)


Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Looking for a better way...
« Reply #1 on: June 23, 2012, 05:01:00 PM »
What are each of these?

Code: [Select]
(...pt01)

(...pt02)

...

LibertyOne

  • Guest
Re: Looking for a better way...
« Reply #2 on: June 23, 2012, 05:05:40 PM »
those are the points from the second list

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: Looking for a better way...
« Reply #3 on: June 23, 2012, 06:11:53 PM »
hi,

Code: [Select]
(setq n 0)
(foreach n lst1
  (... (nth (rem n 11) lst2)) ; instead of pt0n
  (setq n (1+ n))
)
 
Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Looking for a better way...
« Reply #4 on: June 23, 2012, 08:43:08 PM »
It's not clear what you are doing but this is a simple example of looping through two lists with a limit on the first list.
Code: [Select]
(defun c:test(/ idx)
  (defun do_something (x y)
    (print (+ x y))
  )
  (setq listA '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
        listB '(1 2 3 4 5 6 7 8 9 10 11)
        )

  (setq MaxListA 10) ; max number to process, why I don't know

 
  (setq idx 0) ; index pointer to listA
  (setq MaxListA (1- MaxListA)) ; make zero based
  (while
    (and
      (< idx MaxListA) ; did not exceed the max allowed
      (setq itm (nth idx ListA)) ; got a valid item
    )
    ;;  OK to process the item - 11 times from ListB
    (foreach B_item listB
      (do_something itm B_item)
    )
    (setq idx (1+ idx))
  ) ; endwhile
  (princ)
)
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.

LibertyOne

  • Guest
Re: Looking for a better way...
« Reply #5 on: June 24, 2012, 09:29:41 AM »
Thanks to everyone for their replies!

@CAB - my explanation may have not been as clear for all. There are basisly three things involved here. One list is a set of X and Y coordinates, the second list is a set of integers and the third thing is a counter, which the user defines in the beginning of the function. The counter corresponds to the amount of pairs which are made. The first list of items is paired with the second list of items.

Look at it like this: let's say the first list has 11 items and the second list has 4 items. The counter is set at 200. Now we want to make 200 pairs or matchups with the two lists. This means the second list is exhausted at 4, but cycles back through from the beginning. That means we have a pairing of the two lists like this:

Code: [Select]
(1 1) (2 2) (3 3) (4 4) (5 1) (6 2) (7 3) (8 4) (9 1) (10 2) (11 3) (1 4) (2 1) (3 2) ...

Notice how each list once it reaches the end it returns back to the beginning and starts over. This is to be done with each list until the counter reaches the end. In this case 200 pairs are made.

Perhaps this explanation is clearer.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Looking for a better way...
« Reply #6 on: June 24, 2012, 11:41:02 AM »
Try this:
Code: [Select]
(defun c:test(/ idxA idxB)
  (defun do_something (x y)
    (print (list x y))
  )
(setq lista '("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l")
      listB '(1 2 3 4 5 6 7 8 9 10 11)
        )

  (setq MaxPairs 20) ; max number to process, why I don't know

 
  (setq cnt 0 ; counter
        idxA 0 ; index pointer
        idxB 0 ; index pointer
        lenA (length ListA) ; length of list
        lenB (length ListB)
        )
  (while (< (setq cnt (1+ cnt)) MaxPairs)
    (do_something (nth idxA ListA) (nth idxB ListB))
    (setq idxB (1+ idxB))
    (if (= idxB lenB)
      (progn
        (setq idxA (1+ idxA)
              idxB 0)
        (if (= idxA lenA)
          (setq inxA 0)
        )
      )
    )
  ) ; endwhile
  (princ)
)
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.

Stefan

  • Bull Frog
  • Posts: 319
  • The most I miss IRL is the Undo button
Re: Looking for a better way...
« Reply #7 on: June 24, 2012, 01:37:07 PM »
This will return a list of pairs, as you described
Code - Auto/Visual Lisp: [Select]
  1. (defun pairs (l1 l2 i / n m j lst)
  2.   (setq n (length l1)
  3.         m (length l2)
  4.         j 0
  5.         )
  6.   (repeat i
  7.     (setq lst (cons (list (nth (rem j n) l1) (nth (rem j m) l2)) lst)
  8.           j (1+ j)
  9.           )
  10.     )
  11.   (reverse lst)
  12. )
  13.  
Code: [Select]
_$ (pairs '(1 2 3 4 5 6 7 8 9 10 11) '(1 2 3 4) 15)
((1 1) (2 2) (3 3) (4 4) (5 1) (6 2) (7 3) (8 4) (9 1) (10 2) (11 3) (1 4) (2 1) (3 2) (4 3))


LibertyOne

  • Guest
Re: Looking for a better way...
« Reply #8 on: June 24, 2012, 05:30:02 PM »
Thanks for both replies. I'll be looking into both possibilities. I like the simplicity of Stefans code, but remember I still have the PROGN part to deal with. This is where CAB's code looks good.

The last two hours I've been sitting on the edge of my seat watching the European Cup and I'm sorry to see England lose to Italy. I think the Germans would have liked to have played them in the semi-final more. Sorry Lee  :-(

Haven't had time to test either but will do this tomorrow. Time to head to bed...

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Looking for a better way...
« Reply #9 on: June 24, 2012, 06:16:10 PM »
Some highly inefficient recursive solutions...

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup1 ( l1 l2 i )
  2.     (if (< 0 i)
  3.         (if (< (length l1) i)
  4.             (pairup1 (append l1 l1) l2 i)
  5.             (if (< (length l2) i)
  6.                 (pairup1 l1 (append l2 l2) i)
  7.                 (cons (list (car l1) (car l2))
  8.                     (pairup1 (cdr l1) (cdr l2) (1- i))
  9.                 )
  10.             )
  11.         )
  12.     )
  13. )

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup2 ( l1 l2 i )
  2.     (if (< 0 i)
  3.         (if (< (length l1) i)
  4.             (pairup2 (append l1 l1) l2 i)
  5.             (if (< (length l2) i)
  6.                 (pairup2 l1 (append l2 l2) i)
  7.                 (apply 'append
  8.                     (mapcar
  9.                        '(lambda ( a b ) (if (<= 0 (setq i (1- i))) (list (list a b))))
  10.                         l1 l2
  11.                     )
  12.                 )
  13.             )
  14.         )
  15.     )
  16. )

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup3 ( l1 l2 i )
  2.     (if (< 0 i)
  3.         (cons (list (car l1) (car l2))
  4.             (pairup3
  5.                 (append (cdr l1) (list (car l1)))
  6.                 (append (cdr l2) (list (car l2)))
  7.                 (1- i)
  8.             )
  9.         )
  10.     )
  11. )

...still reeling from England's knock-out
« Last Edit: June 24, 2012, 06:41:17 PM by Lee Mac »

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Looking for a better way...
« Reply #10 on: June 24, 2012, 06:28:03 PM »
One more...

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup4 ( l1 l2 n / l3 )
  2.     (while (< (length l1) n) (setq l1 (append l1 l1)))
  3.     (while (< (length l2) n) (setq l2 (append l2 l2)))
  4.     (repeat n
  5.         (setq l3 (cons (list (car l1) (car l2)) l3)
  6.               l1 (cdr l1)
  7.               l2 (cdr l2)
  8.         )
  9.     )
  10.     (reverse l3)
  11. )
« Last Edit: June 24, 2012, 06:40:49 PM by Lee Mac »

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Looking for a better way...
« Reply #11 on: June 24, 2012, 06:42:39 PM »
Quick bench...

Code - Auto/Visual Lisp: [Select]
  1. _$ (setq l1 '(1 2 3 4 5 6 7) l2 '("a" "b" "c" "d" "e") n 200)
  2. 200
  3. _$ (Benchmark '((pairs l1 l2 n) (pairup1 l1 l2 n) (pairup2 l1 l2 n) (pairup3 l1 l2 n) (pairup4 l1 l2 n)))
  4. Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
  5.  
  6.     (PAIRUP2 L1 L2 N).....1809 / 2.32 <fastest>
  7.     (PAIRUP4 L1 L2 N).....1981 / 2.12
  8.     (PAIRS L1 L2 N).......2200 / 1.91
  9.     (PAIRUP1 L1 L2 N).....4072 / 1.03
  10.     (PAIRUP3 L1 L2 N).....4197 / 1 <slowest>

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Looking for a better way...
« Reply #12 on: June 24, 2012, 06:54:15 PM »
Minor optimisation...

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup5 ( l1 l2 i )
  2.     (while (< (length l1) i) (setq l1 (append l1 l1)))
  3.     (while (< (length l2) i) (setq l2 (append l2 l2)))
  4.     (apply 'append
  5.         (mapcar
  6.            '(lambda ( a b ) (if (<= 0 (setq i (1- i))) (list (list a b))))
  7.             l1 l2
  8.         )
  9.     )
  10. )

Code - Auto/Visual Lisp: [Select]
  1. Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
  2.  
  3.     (PAIRUP5 L1 L2 N).....1763 / 2.33 <fastest>
  4.     (PAIRUP2 L1 L2 N).....1810 / 2.27
  5.     (PAIRUP4 L1 L2 N).....1981 / 2.07
  6.     (PAIRS L1 L2 N).......2153 / 1.91
  7.     (PAIRUP1 L1 L2 N).....4025 / 1.02
  8.     (PAIRUP3 L1 L2 N).....4102 / 1 <slowest>

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Looking for a better way...
« Reply #13 on: June 24, 2012, 07:26:27 PM »
Code - Auto/Visual Lisp: [Select]
  1. (defun pairup6 ( l1 l2 i / l3 )
  2.     (while (< (length l1) i) (setq l1 (append l1 l1)))
  3.     (while (< (length l2) i) (setq l2 (append l2 l2)))
  4.     (repeat i (setq l3 (cons i l3)))
  5.     (mapcar '(lambda ( a b c ) (list a b)) l1 l2 l3)
  6. )

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup7 ( l1 l2 i / l3 )
  2.     (while (< (length l1) i) (setq l1 (append l1 l1)))
  3.     (while (< (length l2) i) (setq l2 (append l2 l2)))
  4.     (setq l3 (list i))
  5.     (repeat (fix (/ (log i) (log 2))) (setq l3 (append l3 l3)))
  6.     (repeat (- i (length l3)) (setq l3 (cons i l3)))
  7.     (mapcar '(lambda ( a b c ) (list a b)) l1 l2 l3)
  8. )

Code - Auto/Visual Lisp: [Select]
  1. (defun pairup8 ( l1 l2 i / l3 )
  2.     (repeat (1+ (fix (/ (- (log i) (log (length l1))) (log 2)))) (setq l1 (append l1 l1)))
  3.     (repeat (1+ (fix (/ (- (log i) (log (length l2))) (log 2)))) (setq l2 (append l2 l2)))
  4.     (setq l3 (list i))
  5.     (repeat (fix (/ (log i) (log 2))) (setq l3 (append l3 l3)))
  6.     (repeat (- i (length l3)) (setq l3 (cons i l3)))
  7.     (mapcar '(lambda ( a b c ) (list a b)) l1 l2 l3)
  8. )

Code - Auto/Visual Lisp: [Select]
  1. _$ (setq l1 '(1 2 3 4 5 6 7) l2 '("a" "b" "c" "d" "e") n 200)
  2. 200
  3. _$ (Benchmark '((pairup5 l1 l2 n) (pairup6 l1 l2 n) (pairup7 l1 l2 n) (pairup8 l1 l2 n)))
  4. Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
  5.  
  6.     (PAIRUP7 L1 L2 N).....1263 / 1.4 <fastest>
  7.     (PAIRUP8 L1 L2 N).....1279 / 1.38
  8.     (PAIRUP6 L1 L2 N).....1498 / 1.18
  9.     (PAIRUP5 L1 L2 N).....1762 / 1 <slowest>

Code - Auto/Visual Lisp: [Select]
  1. _$ (setq l1 '(1 2 3 4 5 6 7) l2 '("a" "b" "c" "d" "e") n 200)
  2. 200
  3.  
  4. (Benchmark
  5.    '(
  6.         (pairs   l1 l2 n)
  7.         (pairup1 l1 l2 n)
  8.         (pairup2 l1 l2 n)
  9.         (pairup3 l1 l2 n)
  10.         (pairup4 l1 l2 n)
  11.         (pairup5 l1 l2 n)
  12.         (pairup6 l1 l2 n)
  13.         (pairup7 l1 l2 n)
  14.         (pairup8 l1 l2 n)
  15.     )
  16. )
  17.  
  18. Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
  19.  
  20.     (PAIRUP7 L1 L2 N).....1279 / 3.22 <fastest>
  21.     (PAIRUP8 L1 L2 N).....1279 / 3.22
  22.     (PAIRUP6 L1 L2 N).....1498 / 2.75
  23.     (PAIRUP5 L1 L2 N).....1779 / 2.32
  24.     (PAIRUP2 L1 L2 N).....1826 / 2.26
  25.     (PAIRUP4 L1 L2 N).....1887 / 2.18
  26.     (PAIRS L1 L2 N).......2059 / 2
  27.     (PAIRUP1 L1 L2 N).....3900 / 1.06
  28.     (PAIRUP3 L1 L2 N).....4119 / 1 <slowest>
« Last Edit: June 24, 2012, 07:32:15 PM by Lee Mac »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Looking for a better way...
« Reply #14 on: June 24, 2012, 07:53:21 PM »
If you are sill awake over there how does my clunker hold up?
Code: [Select]
(defun paircab (lista listb maxpairs / idxa idxb lena lenb cnt)
  (setq cnt  0 ; counter
        idxa 0 ; index pointer
        idxb 0 ; index pointer
        lena (length lista) ; length of list
        lenb (length listb)
  )
  (while (< (setq cnt (1+ cnt)) maxpairs)
    (setq lst (cons (list (nth idxa lista) (nth idxb listb)) lst))
    (setq idxb (1+ idxb))
    (if (= idxb lenb)
      (progn
        (setq idxa (1+ idxa)  idxb 0)
        (if (= idxa lena)
          (setq inxa 0)
        )
      )
    )
  ) ; endwhile
  (reverse lst)
)
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.