Path: ...!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: Collecting like-labelled sublists of a list
Date: Wed, 14 Aug 2024 23:57:34 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 69
Message-ID: <v9jg9c$l9uo$1@dont-email.me>
References: <v7k9k9$ala1$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 15 Aug 2024 01:57:34 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="8dd797abfa9c4845a90c0b3910c2697b";
	logging-data="698328"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18cySYNZmugZV4ETo6ELUBA"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:6RYnzTeefqbLtZUxLVXYAPA9JYk=
Bytes: 2993

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