toy list processing problem: collect similar terms

[namekuseijin]

On 30 set, 09:35, namekuseijin <namekusei... at gmail.com> wrote:
> On 29 set, 11:04, w_a_x_man <w_a_x_... at yahoo.com> wrote:
>
>
>
> > On Sep 26, 9:24 am, p... at informatimago.com (Pascal J. Bourguignon)
> > wrote:
>
> > > Xah Lee <xah... at gmail.com> writes:
> > > > here's a interesting toy list processing problem.
>
> > > > I have a list of lists, where each sublist is labelled by
> > > > a number. I need to collect together the contents of all sublists
> > > > sharing
> > > > the same label. So if I have the list
>
> > > > ((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))
>
> > > > where the first element of each sublist is the label, I need to
> > > > produce:
>
> > > > output:
> > > > ((a b) (c d i j) (e f k l o p) (g h) (m n q r) (s t))
>
> > > > a Mathematica solution is here:
> > > >http://xahlee.org/UnixResource_dir/writ/notations_mma.html
>
> > > > R5RS Scheme lisp solution:
> > > >http://xahlee.org/UnixResource_dir/writ/Sourav_Mukherjee_sourav.work_...
> > > > by Sourav Mukherjee
>
> > > > also, a Common Lisp solution can be found here:
> > > >http://groups.google.com/group/comp.lang.lisp/browse_frm/thread/5d1de...
>
> > > It's too complex. Just write:
>
> > > (let ((list '((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))))
>
> > >   (mapcar (lambda (class) (reduce (function append) class :key (function rest)))
> > >            (com.informatimago.common-lisp.list:equivalence-classes list :key (function first)))
>
> > >    )
>
> > > --> ((S T) (Q R M N) (G H) (O P K L E F) (I J C D) (A B))
>
> > > --
> > > __Pascal Bourguignon__                    http://www.informatimago.com/
>
> > Ruby:
>
> > [[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']].
> > group_by{|x| x.first}.values.map{|x| x.map{|y| y[1..-1]}.flatten}
>
> >     ==>[["s", "t"], ["a", "b"], ["c", "d", "i", "j"],
> >  ["e", "f", "k", "l", "o", "p"],
> >  ["g", "h"], ["m", "n", "q", "r"]]
>
> cool, it comes with order all fucked up.  This is something I was
> criticized for before, though not all that important to most
> functional processing.  Not the case here, though.
>
> here's a scheme version that is hopefully better than the given one:

(define (dig in)
  (if (null? in) '()
    (let* ((n         (first-of-first in))
           (all-n     (filter in (lambda (x)      (eq? n (first x)))))
           (all-but-n (filter in (lambda (x) (not (eq? n (first
x)))))))
       (pair
          (fold all-n
             (lambda (i o) (pair (second i) (pair (third i) o))))
          (dig all-but-n)))))

; given these aliases to lisp n00bs
(define pair cons)
(define first car)
(define rest cdr)
(define first-of-first caar)
(define second cadr)
(define third caddr)

; and these well-known functions (non-tail-recursive for benefit of
n00bs)
(define (fold ls f) ; AKA reduce
  (if (null? ls) '()
      (f (first ls) (fold (rest ls) f))))
(define (filter ls f)
  (fold ls (lambda (i o) (if (f i) (pair i o) o))))

; testing
(let ((in '((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))))
  (display (dig in))
  (newline))

;frakkin text editor...