Deutsch   English   Français   Italiano  
<103t2i3$1vn48$1@dont-email.me>

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

Path: nntp.eternal-september.org!news.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: need help with data structure problem
Date: Mon, 30 Jun 2025 04:07:32 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 73
Message-ID: <103t2i3$1vn48$1@dont-email.me>
References: <1034rga$akhr$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Mon, 30 Jun 2025 06:07:33 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="b316bafb1ab57d3a7e95c5e7f34e7f34";
	logging-data="2088072"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18NLiX0nlcKfire+hhXUrp1"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:V+q79nKmPzvGr9+Rfg7dijWvkEY=

B. Pym wrote:

> > hi, I need to write a function  (join_similar expr) where expr is 
> > adata structure with the following format ( (x1 y1) (x2 y2) (x3 y3)... 
> > (xn yn)), 
> > 
> > join_similar  will return an expression like ( (x1 y1 y2) (x3 y3) ...) 
> > when x1=x2 
> > 
> > for instance: 
> > *(join_similar '((3 4) (7 5) (3 6) (7 8) (3 9) (0 1)) 
> > 
> > would return: 
> > ((3 4 6 9) (7 5 8) (0 1))
> 
> 
> Kenny Tilton wrote:
> 
> > Lieven Marchand wrote: 
> > > CL-USER 9 > (defun join-similar (list) 
> > >               (loop with ht = (make-hash-table) 
> > >                     for (first second) in list 
> > >                     do 
> > >                     (pushnew second (gethash first ht nil)) 
> > >                     finally (return (loop for first being each hash-key in ht using (hash-value rest) collect (cons first rest))))) 
> > > JOIN-SIMILAR 
> > 
> > > Isn't LOOP beautiful? <g,d&r> 
> > 
> > <g> No... 
> > 
> > (defun join-similar (pairs &aux result) 
> >   (dolist (pair pairs (nreverse result)) 
> >     (nconc (or (assoc (first pair) result)
> >                (first (push (list (first pair)) result))) 
> >            (list (second pair)))))
> 

Gauche Scheme

Using a collector that collects into an association list.

(define (join-similar pairs)
  (let1 a (malistbag)
    (dolist (xs pairs)  (a (car xs) (cadr xs) cons ()))
    (a)))

(join-similar '((foo 4)(bar 7)(foo 5)(bar 8)(fun 9)))
  ===>
((fun 9) (foo 5 4) (bar 8 7))

Given:


(define (mbag init func :optional (pass-through #f))
  (let ((val init) (func func) (pass-through pass-through))
    (lambda args
      (if (null? args)
        val
        (begin
          (set! val
            ;; A "kons" may have been supplied.
            ((if (null? (cdr args)) func (cadr args))
              (car args) val))
          (if pass-through
            (car args)
            val))))))
(define (mlistbag :optional (pass-through #t))
  (let ((bag (mbag '() cons pass-through)))
    (lambda args
      (if (null? args)
        (reverse (bag))
        (apply bag args)))))