Deutsch   English   Français   Italiano  
<v7k9k9$ala1$1@dont-email.me>

View for Bookmarking (what is this?)
Look up another Usenet article

Path: ...!feeds.phibee-telecom.net!news.mixmin.net!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: Mon, 22 Jul 2024 00:37:31 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 50
Message-ID: <v7k9k9$ala1$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 22 Jul 2024 02:37:31 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="57632485c335ebce11c84c4b6618c564";
	logging-data="349505"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+gb+A/ua2tHi7As7C3pI62"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:iLgjt1z4bFdw5aVcj7Bh76LDk7Q=
Bytes: 2496

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