Topic: -={ Challenge }=- Group By Assoc

[CAB]

My clumsy attempt.

Code: [Select]

(defun remove1 (x lst / itm result)
  (while (setq itm (car lst))
    (setq lst (cdr lst))
    (if (= x itm)
      (setq x nil)
      (setq result (cons itm result))
    )
  )
  (reverse result)
)

[Lee Mac]

Nice one Alan 

Its a shame, all of these solutions will be slower than vl-remove - so its looking like Evgeniy may snatch it for longer lists....

Code: [Select]

List Length: 5

Benchmarking ..................Elapsed milliseconds / relative speed for 32768 iteration(s):

    (MAC_GROUPBYASSOC LST).......1217 / 1.28 <fastest>
    (MAC_GROUPBYASSOC5 LST)......1326 / 1.18
    (GILE_GROUPBYASSOC2 LST).....1389 / 1.12
    (GBA-EE LST).................1560 / 1.00 <slowest>


Code: [Select]

List Length: 80

Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

    (GBA-EE LST)..................1529 / 11.57 <fastest>
    (MAC_GROUPBYASSOC LST)........4446 / 3.98
    (GILE_GROUPBYASSOC2 LST).....16443 / 1.08
    (MAC_GROUPBYASSOC5 LST)......17690 / 1.00 <slowest>


Code: [Select]

(defun Mac_GroupByAssoc5 ( lst / item rtn out)
  (setq item (caar lst) rtn (cdar lst))

  (while (setq lst (cdr lst))
   
    (while (and lst (setq a (assoc item lst)))
     
      (setq rtn (append rtn (cdr a)) lst (r1 a lst)))
   
    (setq out (cons (cons item rtn) out) item (caar lst) rtn (cdar lst)))
 
  (reverse out))

(defun r1 (x l) ; ElpanovEvgeniy
    (cond (  (not l) nil)
          (  (equal x (car l)) (cdr l))
          (  (cons (car l) (r1 x (cdr l))))))


[T.Willey]

Late to the party, but didn't see one that did it the way I had in my head, so it is.

Code: [Select]

(defun gba-tmw ( lst / a b r )
   
    (while (setq a (car lst))
        (cond
            ((not r) (setq r (list a)))
            ((setq b (assoc (car a) r)) (setq r (subst (cons (car b) (append (cdr b) (cdr a))) b r)))
            (t (setq r (cons a r)))
        )
        (setq lst (cdr lst))
    )
    (vl-sort r (function (lambda ( a b ) (< (car a ) (car b)))))
)

Here is one that will sort the nested lists also, incase that also desired.

Code: [Select]

(defun gba-tmw2 ( lst / a b r )
    ; (setq lst '((1 123 234) (2 234 345) (3 345 456) (2 456 567 133) (3 567 678 125)))
    (while (setq a (car lst))
        (cond
            ((not r) (setq r (list a)))
            ((setq b (assoc (car a) r)) (setq r (subst (cons (car b) (append (cdr b) (cdr a))) b r)))
            (t (setq r (cons a r)))
        )
        (setq lst (cdr lst))
    )
    (vl-sort
        (mapcar (function (lambda (a) (cons (car a) (vl-sort (cdr a) (function (lambda (x y) (< x y))))))) r)
        (function (lambda ( a b ) (< (car a ) (car b))))
    )
)