The simplest way
...
(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)
)
Lee, your 2 and 3 do not like nils
(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)
)
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 ----
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 ----
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 ----
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 ----
(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)
)
(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)
)
_$ (ale_pack4 nil)
(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))
)
)
(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))
)
)
)
(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)))
)
)
)
(f '(1 nil))