TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Challenges => Topic started by: JohnK on December 22, 2021, 05:26:50 PM

Title: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: JohnK on December 22, 2021, 05:26:50 PM

Using only AutoLisp, "Pack" a list that contains repeated elements. The elements should be placed in separate sublists.

Example:
(pack '(a a a a b c c a a d e e e e))
> ((A A A A) (B) (C C) (A A) (D) (E E E E))
(pack '())
> nil

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: JohnK on December 28, 2021, 08:23:42 AM

Challenge posted.

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: well20152016 on December 28, 2021, 08:40:22 AM

The simplest way

Code - Auto/Visual Lisp: [Select]

1. (defun pack (l / l1 l2)
2.   (while l
3.     (setq n (length l)
4.           a (car l)
5.           l (vl-remove-if '(lambda (b) (equal a b)) l)
6.           n (repeat (- n (length l)) (setq l1 (cons a l1)))
7.         )
8.   (setq l2 (cons l1 l2) l1 nil))
9.  (reverse l2) )
10.  

Code - Auto/Visual Lisp: [Select]

1. (defun pack (l / l1 l2 l3)
2.   (while l
3.     (setq l1 nil l2 nil l1 (list (car l))
4.           n (foreach a (cdr l) (if (= (car l) a ) (setq l1 (cons a l1)) (setq l2 (cons a l2))))
5.           l3 (cons l1 l3)
6.           l (reverse l2)
7.           ))
8.  (reverse l3) )
9.  
10.  

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Lee Mac on December 28, 2021, 08:46:04 AM

Code - Auto/Visual Lisp: [Select]

1. (defun pack1 ( l / f )
2.     (defun f ( l a )
3.         (if l
4.             (if (= (car l) (car a))
5.                 (f (cdr l) (cons (car l) a))
6.                 (cons a (pack1 l))
7.             )
8.             (list a)
9.         )
10.     )
11.     (if l (f (cdr l) (list (car l))))
12. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: JohnK on December 28, 2021, 08:50:15 AM

Quote from: well20152016 on December 28, 2021, 08:40:22 AM

The simplest way
...

Sorry, well20152016 you will have to build your own vl-remove-if (https://www.theswamp.org/Sources/doc/avlisp/#vl-remove-if).

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: JohnK on December 28, 2021, 08:52:24 AM

You are quick. It took me a few hours to get mine working.

Code - Auto/Visual Lisp: [Select]

1. (defun pack (aList / segment)
2.   (defun group-subarray (element seg aList)
3.     (cond
4.       ((null aList)
5.        (list (cons element seg)))
6.       ((eq element (car aList))
7.        (group-subarray element (cons element seg) (cdr aList)))
8.       (t
9.         (cons
10.           (cons element seg)
11.           (group-subarray (car aList) '() (cdr aList))))
12.       )
13.     )
14.   (if (null aList)
15.     '()
16.     (group-subarray (car aList) '() (cdr aList)))
17.   )
18.  

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Lee Mac on December 28, 2021, 08:53:37 AM

Code - Auto/Visual Lisp: [Select]

1. (defun pack2 ( l / r s x y )
2.     (while l
3.         (setq x (car  l)
4.               s (list x)
5.               l (cdr  l)
6.         )
7.         (while (and l (= x (setq y (car l))))
8.             (setq s (cons y s)
9.                   l (cdr  l)
10.             )
11.         )
12.         (setq r (cons s r))
13.     )
14.     (reverse r)
15. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Lee Mac on December 28, 2021, 08:59:41 AM

Code - Auto/Visual Lisp: [Select]

1. (defun pack3 ( l / s x y )
2.     (if l
3.         (progn
4.             (setq x (car  l)
5.                   s (list x)
6.                   l (cdr  l)
7.             )  
8.             (while (and l (= x (setq y (car l))))
9.                 (setq s (cons y s)
10.                       l (cdr  l)
11.                 )
12.             )
13.             (cons s (pack3 l))
14.         )
15.     )
16. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: VovKa on December 28, 2021, 11:29:19 AM

Code: [Select]

(defun pack4 (l / nl)
  (foreach e l
    (setq nl (if (= e (caar nl))
       (cons (cons e (car nl)) (cdr nl))
       (cons (list e) nl)
     )
    )
  )
  (reverse nl)
)


Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: VovKa on December 28, 2021, 11:39:01 AM

Lee, your 2 and 3 do not like nils

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: gile on December 28, 2021, 11:46:34 AM

Code - Auto/Visual Lisp: [Select]

1. (defun pack (l / loop)
2.   (defun loop (l a)
3.     (cond
4.       ((null l) (reverse a))
5.       ((/= (car l) (caar a)) (loop (cdr l) (cons (list (car l)) a)))
6.       (T (loop (cdr l) (cons (cons (car l) (car a)) (cdr a))))
7.     )
8.   )
9.   (loop l nil)
10. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: gile on December 28, 2021, 11:51:53 AM

In other words:

Code - Auto/Visual Lisp: [Select]

1. (defun pack (l / loop)
2.   (defun loop (l a)
3.     (if l
4.       (loop
5.         (cdr l)
6.         (if (= (car l) (caar a))
7.           (cons (cons (car l) (car a)) (cdr a))
8.           (cons (list (car l)) a)
9.         )
10.       )
11.       (reverse a)
12.     )
13.   )
14.   (loop l nil)
15. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Stefan on December 28, 2021, 11:53:12 AM

Code - Auto/Visual Lisp: [Select]

1. (defun pack_stef (l / p r)
2.   (setq p (list (car l)) l (cdr l))
3.   (while
4.     (cond
5.       ( (not l) nil)
6.       ( (eq (car l) (car p))
7.         (setq p (cons (car l) p)
8.               l (cdr l)
9.         )
10.       )
11.       (T
12.         (setq r (cons p r)
13.               p (list (car l))
14.               l (cdr l)
15.         )
16.       )
17.     )
18.   )
19.   (reverse (cons p r))
20. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: ronjonp on December 28, 2021, 12:31:31 PM

Code - Auto/Visual Lisp: [Select]

1. (defun pack-rjp (l / a r)
2.   (while l
3.     (setq a (list (car l)))
4.     (setq l (cdr l))
5.     (while (and l (equal (car a) (car l))) (setq a (cons (car l) a)) (setq l (cdr l)))
6.     (setq r (cons a r))
7.   )
8.   (reverse r)
9. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Lee Mac on December 28, 2021, 02:05:53 PM

Quote from: VovKa on December 28, 2021, 11:39:01 AM

Lee, your 2 and 3 do not like nils

Thanks - now revised :-)

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Marc'Antonio Alessi on December 29, 2021, 05:22:10 AM

Another… similar.

Code: [Select]

(defun ALE_pack (L / o)
  (mapcar
   '(lambda (x)
      (setq o (if (eq x (caar o)) (cons (cons x (car o)) (cdr o)) (cons (list x) o)))
    )
    L
  )
  (reverse o)
)

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: JohnK on December 29, 2021, 03:22:59 PM

TIME TRIALS:

Code: [Select]

Elapsed milliseconds / relative speed for 32768 iteration(s):

    (PACK-LEE-3 ARRAYTOUSE)..............1094 / 2.10 <fastest>
    (PACK-LEE-2 ARRAYTOUSE)..............1203 / 1.91
    (PACK-VOVKA ARRAYTOUSE)..............1312 / 1.75
    (PACK-RJP ARRAYTOUSE)................1313 / 1.75
    (PACK-SE7EN ARRAYTOUSE)..............1375 / 1.67
    (PACK_STEF ARRAYTOUSE)...............1390 / 1.65
    (PACK-GILE-2 ARRAYTOUSE).............1407 / 1.63
    (ALE_PACK ARRAYTOUSE)................1532 / 1.50
    (PACK-GILE-1 ARRAYTOUSE).............1656 / 1.39
    (PACK-LEE-1 ARRAYTOUSE)..............1812 / 1.27
    (PACK-WELL20152016-2 ARRAYTOUSE).....2297 / 1.00 <slowest>
---- Benchmark utility: In memory of Michael Puckett ----

Code: [Select]

Elapsed milliseconds / relative speed for 32768 iteration(s):

    (PACK_STEF ARRAYTOUSE)...............1359 / 1.91 <fastest>
    (PACK-GILE-2 ARRAYTOUSE).............1391 / 1.86
    (PACK-SE7EN ARRAYTOUSE)..............1500 / 1.73
    (PACK-RJP ARRAYTOUSE)................1500 / 1.73
    (ALE_PACK ARRAYTOUSE)................1547 / 1.68
    (PACK-GILE-1 ARRAYTOUSE).............1609 / 1.61
    (PACK-LEE-3 ARRAYTOUSE)..............1734 / 1.50
    (PACK-LEE-1 ARRAYTOUSE)..............1765 / 1.47
    (PACK-VOVKA ARRAYTOUSE)..............1828 / 1.42
    (PACK-WELL20152016-2 ARRAYTOUSE).....2297 / 1.13
    (PACK-LEE-2 ARRAYTOUSE)..............2594 / 1.00 <slowest>
 ---- Benchmark utility: In memory of Michael Puckett ----

Code: [Select]

Elapsed milliseconds / relative speed for 65536 iteration(s):

    (PACK-LEE-2 ARRAYTOUSE)...............1985 / 7.34 <fastest>
    (PACK-LEE-3 ARRAYTOUSE)...............2046 / 7.12
    (PACK-SE7EN ARRAYTOUSE)...............2297 / 6.34
    (PACK-RJP ARRAYTOUSE).................2328 / 6.26
    (PACK-VOVKA ARRAYTOUSE)...............2532 / 5.75
    (PACK_STEF ARRAYTOUSE)................2563 / 5.68
    (PACK-GILE-2 ARRAYTOUSE)..............2672 / 5.45
    (ALE_PACK ARRAYTOUSE).................2812 / 5.18
    (PACK-GILE-1 ARRAYTOUSE)..............3062 / 4.76
    (PACK-LEE-1 ARRAYTOUSE)...............8015 / 1.82
    (PACK-WELL20152016-2 ARRAYTOUSE).....14563 / 1.00 <slowest>
 ---- Benchmark utility: In memory of Michael Puckett ----

Code: [Select]

Elapsed milliseconds / relative speed for 65536 iteration(s):

    (PACK-SE7EN ARRAYTOUSE)..............1953 / 4.09 <fastest>
    (PACK-LEE-3 ARRAYTOUSE)..............2797 / 2.85
    (PACK-VOVKA ARRAYTOUSE)..............2953 / 2.70
    (PACK-LEE-2 ARRAYTOUSE)..............3016 / 2.65
    (PACK-RJP ARRAYTOUSE)................3078 / 2.59
    (PACK_STEF ARRAYTOUSE)...............3235 / 2.47
    (PACK-GILE-1 ARRAYTOUSE).............3594 / 2.22
    (PACK-GILE-2 ARRAYTOUSE).............3625 / 2.20
    (ALE_PACK ARRAYTOUSE)................4016 / 1.99
    (PACK-LEE-1 ARRAYTOUSE)..............7875 / 1.01
    (PACK-WELL20152016-2 ARRAYTOUSE).....7985 / 1.00 <slowest>
 ---- Benchmark utility: In memory of Michael Puckett ----
Testing function:

Code - Auto/Visual Lisp: [Select]

1. ( (lambda ( / ArrayToUse)
2.     ;;
3.     ;; FUNCTIONS
4.  
5.         (defun pack-se7en (aList / segment)
6.           (defun group-subarray (element seg aList)
7.             (cond
8.               ((null aList)
9.                (list (cons element seg)))
10.               ((eq element (car aList))
11.                (group-subarray element (cons element seg) (cdr aList)))
12.               (t
13.                 (cons
14.                   (cons element seg)
15.                   (group-subarray (car aList) '() (cdr aList))))
16.               )
17.             )
18.           (if (null aList)
19.             '()
20.             (group-subarray (car aList) '() (cdr aList)))
21.           )
22.  
23.         ;;(defun pack-well20152016-1 (l / l1 l2)
24.         ;;  (while l
25.         ;;    (setq n (length l)
26.         ;;          a (car l)
27.         ;;          l (vl-remove-if '(lambda (b) (equal a b)) l)
28.         ;;          n (repeat (- n (length l)) (setq l1 (cons a l1)))
29.         ;;        )
30.         ;;  (setq l2 (cons l1 l2) l1 nil))
31.         ;; (reverse l2) )
32.  
33.         (defun pack-well20152016-2 (l / l1 l2 l3)
34.           (while l
35.             (setq l1 nil l2 nil l1 (list (car l))
36.                   n (foreach a (cdr l) (if (= (car l) a ) (setq l1 (cons a l1)) (setq l2 (cons a l2))))
37.                   l3 (cons l1 l3)
38.                   l (reverse l2)
39.                   ))
40.          (reverse l3) )
41.  
42.         (defun pack-lee-1 ( l / f )
43.             (defun f ( l a )
44.                 (if l
45.                     (if (= (car l) (car a))
46.                         (f (cdr l) (cons (car l) a))
47.                         (cons a (pack-lee-1 l))
48.                     )
49.                     (list a)
50.                 )
51.             )
52.             (if l (f (cdr l) (list (car l))))
53.         )
54.  
55.         (defun pack-lee-2 ( l / r s x y )
56.             (while l
57.                 (setq x (car  l)
58.                       s (list x)
59.                       l (cdr  l)
60.                 )
61.                 (while (and l (= x (setq y (car l))))
62.                     (setq s (cons y s)
63.                           l (cdr  l)
64.                     )
65.                 )
66.                 (setq r (cons s r))
67.             )
68.             (reverse r)
69.         )
70.  
71.         (defun pack-lee-3 ( l / s x y )
72.             (if l
73.                 (progn
74.                     (setq x (car  l)
75.                           s (list x)
76.                           l (cdr  l)
77.                     )  
78.                     (while (and l (= x (setq y (car l))))
79.                         (setq s (cons y s)
80.                               l (cdr  l)
81.                         )
82.                     )
83.                     (cons s (pack-lee-3 l))
84.                 )
85.             )
86.         )
87.  
88.         (defun pack-vovka (l / nl)
89.           (foreach e l
90.             (setq nl (if (= e (caar nl))
91.                        (cons (cons e (car nl)) (cdr nl))
92.                        (cons (list e) nl)
93.                      )
94.             )
95.           )
96.           (reverse nl)
97.         )
98.  
99.         (defun pack-gile-1 (l / loop)
100.           (defun loop (l a)
101.             (cond
102.               ((null l) (reverse a))
103.               ((/= (car l) (caar a)) (loop (cdr l) (cons (list (car l)) a)))
104.               (T (loop (cdr l) (cons (cons (car l) (car a)) (cdr a))))
105.             )
106.           )
107.           (loop l nil)
108.         )
109.  
110.         (defun pack-gile-2 (l / loop)
111.           (defun loop (l a)
112.             (if l
113.               (loop
114.                 (cdr l)
115.                 (if (= (car l) (caar a))
116.                   (cons (cons (car l) (car a)) (cdr a))
117.                   (cons (list (car l)) a)
118.                 )
119.               )
120.               (reverse a)
121.             )
122.           )
123.           (loop l nil)
124.         )
125.  
126.         (defun pack_stef (l / p r)
127.           (setq p (list (car l)) l (cdr l))
128.           (while
129.             (cond
130.               ( (not l) nil)
131.               ( (eq (car l) (car p))
132.                 (setq p (cons (car l) p)
133.                       l (cdr l)
134.                 )
135.               )
136.               (T
137.                 (setq r (cons p r)
138.                       p (list (car l))
139.                       l (cdr l)
140.                 )
141.               )
142.             )
143.           )
144.           (reverse (cons p r))
145.         )
146.  
147.         (defun pack-rjp (l / a r)
148.           (while l
149.             (setq a (list (car l)))
150.             (setq l (cdr l))
151.             (while (and l (equal (car a) (car l))) (setq a (cons (car l) a)) (setq l (cdr l)))
152.             (setq r (cons a r))
153.           )
154.           (reverse r)
155.         )
156.  
157.         (defun ALE_pack (L / o)
158.           (mapcar
159.            '(lambda (x)
160.               (setq o (if (eq x (caar o)) (cons (cons x (car o)) (cdr o)) (cons (list x) o)))
161.             )
162.             L
163.           )
164.           (reverse o)
165.         )
166.     ;;
167.     ;; Setup
168.     (setq ArrayToUse '(a a a a b c c a a d e e e e))
169.  
170.     ;;
171.     ;; Run the bechmark
172.     (benchmark '((pack-se7en ArrayToUse)
173.                  (pack-well20152016-2 ArrayToUse)
174.                  (pack-lee-1 ArrayToUse)
175.                  (pack-lee-2 ArrayToUse)  
176.                  (pack-lee-3 ArrayToUse)
177.                  (pack-vovka ArrayToUse)
178.                  (pack-gile-1 ArrayToUse)
179.                  (pack-gile-2 ArrayToUse)
180.                  (pack_stef ArrayToUse)
181.                  (pack-rjp ArrayToUse)
182.                  (ALE_pack ArrayToUse))
183.     )
184.   )
185. )

EDIT: Sorry, I forgot that one function was DQ for using VL. New results posted.

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Marc'Antonio Alessi on December 30, 2021, 01:25:43 PM

Another version (slower) but pretty good if MANY repetitions:

Code: [Select]

(defun ALE_pack3 (L / a p o)
  (while
    (progn
      (setq a (car L))
      (cond
        ( (equal (setq p (list a (cadr L) (caddr L) (cadddr L))) (list a a a a)) (setq L (cddddr L)) )
        ( (equal (setq p (list a (cadr L) (caddr L)           )) (list a a a  )) (setq L (cdddr  L)) )
        ( (equal (setq p (list a (cadr L)                     )) (list a a    )) (setq L (cddr   L)) )
        (        (setq p (list a))                                               (setq L (cdr    L)) )
      )
      (if (= a (caar o)) (setq o (cons (append p (car o)) (cdr o))) (setq o (cons p o)))
      L
    )
  )
  (reverse o)
)

Edit: >>> wrong results if more then 4 repetitions > need more work… sorry  :uglystupid2:
Edit2: fixed but slow  :tickedoff:

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Marc'Antonio Alessi on January 02, 2022, 04:22:50 AM

Very short…

Code: [Select]

(defun ALE_pack4 (L / a p o)
  (and
    L
    (while
      (setq
        o (if (equal (setq p (car L)) (caar o)) (cons (cons p (car o)) (cdr o)) (cons (list p) o))
        L (cdr L)
      )
    )
  )
  (reverse o)
)

Edit: non more "Very short"... thanks Lee  :-) :-(

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: Lee Mac on January 02, 2022, 05:58:22 AM

Code: [Select]

_$ (ale_pack4 nil)
:wink:

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: roy_043 on January 03, 2022, 04:47:29 PM

Similar to my A09 code: https://www.theswamp.org/index.php?topic=57274.msg607958#msg607958 :whistling:

Code - Auto/Visual Lisp: [Select]

1. (defun pack-roy (lst / tmp)
2.   (if (not (atom lst))
3.     (apply
4.       'append
5.       (mapcar
6.         '(lambda (cur / ret)
7.           (cond
8.             ((not cur)
9.               nil
10.             )
11.             ((not (atom cur)) ; Added last item.
12.               (list tmp)
13.             )
14.             ((not tmp)
15.               (setq tmp (list cur))
16.               nil
17.             )
18.             ((equal cur (car tmp))
19.               (setq tmp (cons cur tmp))
20.               nil
21.             )
22.             (T
23.               (setq ret (list tmp))
24.               (setq tmp (list cur))
25.               ret
26.             )
27.           )
28.         )
29.         (append lst '((nil)))
30.       )
31.     )
32.   )
33. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: bruno_vdh on January 12, 2022, 10:02:14 AM

Hello, if it's not too late to play

For long lists,

Code: [Select]

(defun pack-vdh-1 (l / m grp)
  (mapcar '(lambda (x1 x2)
     (if (= x1 x2)
       (setq grp (cons x1 grp))
       (setq m (cons grp m)
     grp (list x1)
       )
     )
   )
  l
  (cons (car l) l)
  )
  (if l
    (reverse (cons grp m))
  )
)
A recursive version with accumulator

Code: [Select]

(defun pack-vdh-2 (l)
  (if l
    ((lambda (x m)
       (if (= x (caar m))
(cons (cons x (car m)) (cdr m))
(cons (list x) m)
       )
     )
      (car l)
      (pack-vdh-2 (cdr l))
    )
  )
)
The same when looking for optimization

Code: [Select]

(defun pack-vdh-3 (l / m)
  (if l
    (if (= (car l) (cadr l))
      (cons (cons (car l) (car (setq m (pack-vdh-3 (cdr l))))) (cdr m))
      (cons (list (car l)) (pack-vdh-3 (cdr l)))
    )
  )
)


Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: ElpanovEvgeniy on January 20, 2022, 01:43:50 AM

Code - Auto/Visual Lisp: [Select]

1. (defun f (l)
2.   (cond ((not l) l)
3.         ((atom (car l)) (f (cons (list (car l)) (cdr l))))
4.         ((= (caar l) (cadr l)) (f (cons (cons (cadr l) (car l)) (cddr l))))
5.         ((cons (car l) (f (cdr l))))
6.   )
7. )

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: VovKa on January 20, 2022, 05:14:53 AM

Quote from: ElpanovEvgeniy on January 20, 2022, 01:43:50 AM

(f '(1 nil))

Title: Re: [challenge] A08 : "Pack" consecutive duplicates of list elements into sublists
Post by: ElpanovEvgeniy on January 20, 2022, 05:47:13 AM

Quote from: VovKa on January 20, 2022, 05:14:53 AM

Quote from: ElpanovEvgeniy on January 20, 2022, 01:43:50 AM

(f '(1 nil))

thanks, I'll fix it.