(defun test (list)|
(loop for j in list
for index = (first j)
for k = (rest j)
with indices = nil
if (not (member index indices))
do (pushnew index indices)
and collect j into res
else
do (nconc (assoc index res) k) ; ASSOC instead of NTH
finally (return res)))
| To be more precise (if that helps), I'm wondering if there's a way of
| doing this without having to build up a list of the indices (labels)
| and using membership/non-membership of this list as the test for
| whether we have encountered a new index or not.
You can get by without building indices and just using ASSOC (which you cannot avoid):
(defun cortez-group (list) ; Destroys LIST!
(let (result)
(dolist (el list)
(let ((entry (assoc (car el) result)))
(if entry
(rplacd entry (nconc (cdr entry) (cdr el)))
(push el result))))
(nreverse (mapcar #'cdr result))))
* (setq $a '((0 a b) (1 c d) (2 e f) (3 g h) (1 i j)
(2 k l) (4 m n) (2 o p) (4 q r) (5 s t)))
* (cortez-group $a)
((A B) (C D I J) (E F K L O P) (G H) (M N Q R) (S T))
Madhu wrote:
(defun test (list)
(loop for j in list
for index = (first j)
for k = (rest j)
with indices = nil
if (not (member index indices))
do (pushnew index indices)
and collect j into res
else
do (nconc (assoc index res) k) ; ASSOC instead of NTH
finally (return res)))
To be more precise (if that helps), I'm wondering if there's a way of
doing this without having to build up a list of the indices (labels)
and using membership/non-membership of this list as the test for
whether we have encountered a new index or not.
You can get by without building indices and just using ASSOC (which you cannot avoid):
(defun cortez-group (list) ; Destroys LIST!
(let (result)
(dolist (el list)
(let ((entry (assoc (car el) result)))
(if entry
(rplacd entry (nconc (cdr entry) (cdr el)))
(push el result))))
(nreverse (mapcar #'cdr result))))
* (setq $a '((0 a b) (1 c d) (2 e f) (3 g h) (1 i j)
(2 k l) (4 m n) (2 o p) (4 q r) (5 s t)))
* (cortez-group $a)
((A B) (C D I J) (E F K L O P) (G H) (M N Q R) (S T))
Gauche Scheme
(use srfi-235) ;; group-by
(define (c-group lst)
(map
(cut append-map cdr <>)
((group-by car) lst)))
(c-group '((0 a b) (1 c d) (2 e f) (3 g h) (1 i j)
(2 k l) (4 m n) (2 o p) (4 q r) (5 s t)))
===>
((a b) (c d i j) (e f k l o p) (g h) (m n q r) (s t))
Sysop: | Keyop |
---|---|
Location: | Huddersfield, West Yorkshire, UK |
Users: | 399 |
Nodes: | 16 (2 / 14) |
Uptime: | 97:55:23 |
Calls: | 8,363 |
Calls today: | 2 |
Files: | 13,162 |
Messages: | 5,897,714 |