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
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.             (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.             (cons s (pack3 l))
13.         )
14.     )
15. )
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.     (cond
4.       ( (not l) nil)
5.       ( (eq (car l) (car p))
6.         (setq p (cons (car l) p)
7.               l (cdr l)
8.         )
9.       )
10.       (T
11.         (setq r (cons p r)
12.               p (list (car l))
13.               l (cdr l)
14.         )
15.       )
16.     )
17.   )
18.   (reverse (cons p r))
19. )
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
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.                     (setq x (car  l)
74.                           s (list x)
75.                           l (cdr  l)
76.                     )
77.                     (while (and l (= x (setq y (car l))))
78.                         (setq s (cons y s)
79.                               l (cdr  l)
80.                         )
81.                     )
82.                     (cons s (pack-lee-3 l))
83.                 )
84.             )
85.         )
86.
87.         (defun pack-vovka (l / nl)
88.           (foreach e l
89.             (setq nl (if (= e (caar nl))
90.                        (cons (cons e (car nl)) (cdr nl))
91.                        (cons (list e) nl)
92.                      )
93.             )
94.           )
95.           (reverse nl)
96.         )
97.
98.         (defun pack-gile-1 (l / loop)
99.           (defun loop (l a)
100.             (cond
101.               ((null l) (reverse a))
102.               ((/= (car l) (caar a)) (loop (cdr l) (cons (list (car l)) a)))
103.               (T (loop (cdr l) (cons (cons (car l) (car a)) (cdr a))))
104.             )
105.           )
106.           (loop l nil)
107.         )
108.
109.         (defun pack-gile-2 (l / loop)
110.           (defun loop (l a)
111.             (if l
112.               (loop
113.                 (cdr l)
114.                 (if (= (car l) (caar a))
115.                   (cons (cons (car l) (car a)) (cdr a))
116.                   (cons (list (car l)) a)
117.                 )
118.               )
119.               (reverse a)
120.             )
121.           )
122.           (loop l nil)
123.         )
124.
125.         (defun pack_stef (l / p r)
126.           (setq p (list (car l)) l (cdr l))
127.             (cond
128.               ( (not l) nil)
129.               ( (eq (car l) (car p))
130.                 (setq p (cons (car l) p)
131.                       l (cdr l)
132.                 )
133.               )
134.               (T
135.                 (setq r (cons p r)
136.                       p (list (car l))
137.                       l (cdr l)
138.                 )
139.               )
140.             )
141.           )
142.           (reverse (cons p r))
143.         )
144.
145.         (defun pack-rjp (l / a r)
146.           (while l
147.             (setq a (list (car l)))
148.             (setq l (cdr l))
149.             (while (and l (equal (car a) (car l))) (setq a (cons (car l) a)) (setq l (cdr l)))
150.             (setq r (cons a r))
151.           )
152.           (reverse r)
153.         )
154.
155.         (defun ALE_pack (L / o)
156.            '(lambda (x)
157.               (setq o (if (eq x (caar o)) (cons (cons x (car o)) (cdr o)) (cons (list x) o)))
158.             )
159.             L
160.           )
161.           (reverse o)
162.         )
163.     ;;
164.     ;; Setup
165.     (setq ArrayToUse '(a a a a b c c a a d e e e e))
166.
167.     ;;
168.     ;; Run the bechmark
169.     (benchmark '((pack-se7en ArrayToUse)
170.                  (pack-well20152016-2 ArrayToUse)
171.                  (pack-lee-1 ArrayToUse)
172.                  (pack-lee-2 ArrayToUse)
173.                  (pack-lee-3 ArrayToUse)
174.                  (pack-vovka ArrayToUse)
175.                  (pack-gile-1 ArrayToUse)
176.                  (pack-gile-2 ArrayToUse)
177.                  (pack_stef ArrayToUse)
178.                  (pack-rjp ArrayToUse)
179.                  (ALE_pack ArrayToUse))
180.     )
181.   )
182. )

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.         '(lambda (cur / ret)
4.           (cond
5.             ((not cur)
6.               nil
7.             )
8.             ((not (atom cur)) ; Added last item.
9.               (list tmp)
10.             )
11.             ((not tmp)
12.               (setq tmp (list cur))
13.               nil
14.             )
15.             ((equal cur (car tmp))
16.               (setq tmp (cons cur tmp))
17.               nil
18.             )
19.             (T
20.               (setq ret (list tmp))
21.               (setq tmp (list cur))
22.               ret
23.             )
24.           )
25.         )
26.         (append lst '((nil)))
27.       )
28.     )
29.   )
30. )
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
(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
(f '(1 nil))

thanks, I'll fix it.