• Re: Collecting like-labelled sublists of a list

    From B. Pym@21:1/5 to Madhu on Mon Jul 22 00:37:31 2024
    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))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From B. Pym@21:1/5 to B. Pym on Wed Aug 14 23:57:34 2024
    B. Pym wrote:

    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))

    newLISP

    (define (c-group lst)
    (let (alist (map list (unique (map first lst))))
    (dolist (xs lst)
    (setf (assoc (xs 0) alist)
    (append $it (1 xs))))
    (map rest alist)))

    (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))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)