Author Topic: -={ Challenge }=- Group By Assoc  (Read 8757 times)

0 Members and 1 Guest are viewing this topic.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Group By Assoc
« Reply #15 on: April 04, 2010, 01:11:42 PM »
« Last Edit: April 04, 2010, 11:05:12 PM by Trauma »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #16 on: April 04, 2010, 01:19:17 PM »
A test with a longer list reveals more...  :evil:

Code: [Select]
List Length: 80

Elapsed milliseconds / relative speed for 16384 iteration(s):

    (GILE_GROUPBYASSOC LST)......1310 / 8.00 <fastest>
    (GBA-EE LST).................4056 / 2.58
    (MAC_GROUPBYASSOC LST)......10484 / 1.00 <slowest>

My laptop's not fast enough to process lists much longer than that  :|

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #17 on: April 04, 2010, 01:33:39 PM »
Another  :-)

Code: [Select]
(defun Mac_GroupByAssoc4 ( 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 (vl-remove a lst)))
   
    (setq out (cons (cons item rtn) out) item (caar lst) rtn (cdar lst)))
 
  (reverse out))

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #18 on: April 04, 2010, 01:34:55 PM »
Code: [Select]
List Length: 5

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

    (MAC_GROUPBYASSOC4 LST).....1482 / 1.41 <fastest>
    (MAC_GROUPBYASSOC LST)......1528 / 1.37
    (GILE_GROUPBYASSOC LST).....1576 / 1.33
    (GBA-EE LST)................2090 / 1.00 <slowest>

Code: [Select]
List Length: 80

Elapsed milliseconds / relative speed for 16384 iteration(s):

    (MAC_GROUPBYASSOC4 LST).....1139 / 8.49 <fastest>
    (GILE_GROUPBYASSOC LST).....1170 / 8.27
    (GBA-EE LST)................3697 / 2.62
    (MAC_GROUPBYASSOC LST)......9672 / 1.00 <slowest>

 8-)

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Group By Assoc
« Reply #19 on: April 04, 2010, 02:20:50 PM »
Hi Lee! :)

Code: [Select]
(Mac_GroupByAssoc4 '((1 2) (1 2) (1 2))) ;=>> ((1 2 2))
(GroupByAssoc '((1 2) (1 2) (1 2)))      ;=>> ((1 2 2))
(gba-ee '((1 2) (1 2) (1 2)))           ;=>> ((1 2 2 2))
« Last Edit: April 04, 2010, 02:25:53 PM by ElpanovEvgeniy »

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #20 on: April 04, 2010, 02:34:24 PM »
I wondered who'd be the first to spot that...

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Group By Assoc
« Reply #21 on: April 04, 2010, 02:40:34 PM »
I wondered who'd be the first to spot that...

Now I do not know, I must make a new version?  :kewl:

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #22 on: April 04, 2010, 02:50:42 PM »
I wondered who'd be the first to spot that...

Now I do not know, I must make a new version?  :kewl:

No, I think your version is the correct way to deal with that situation - I just wish there was a function like vl-remove that would only remove the first occurence of an item.  :-(

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #23 on: April 04, 2010, 03:12:48 PM »
I thought I'd try to write my own, but I cannot seem to get this to work  :-(

Code: [Select]
(defun vl-remove-1st (x l / foo)

    (defun foo (y)
      (if (equal x y)
        (defun foo (y) nil)))

    (vl-remove-if (function foo) l))

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: -={ Challenge }=- Group By Assoc
« Reply #24 on: April 04, 2010, 03:22:06 PM »
Don't have time to optimize but ...

Code: [Select]
(defun remove-first-if ( foo lst / bar )
   
    (defun bar (x) (if (foo x) (defun foo (x) nil)))   

    (vl-remove-if 'bar lst)

)

(remove-first-if

    (lambda (x) (eq 2 x))   
   
   '(0 1 2 2 3 4 5 6 7 8)   
   
)

=> (0 1 2 3 4 5 6 7 8)
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #25 on: April 04, 2010, 03:37:32 PM »
Thanks Michael - appreciated.

I couldn't work out why my solution failed though  :-(

With my code

Code: [Select]
(defun vl-remove-1st (x l / foo)

    (defun foo (y)
      (if (equal x y)
        (defun foo (y) nil)))

    (vl-remove-if (function foo) l))

For say,

Code: [Select]
(vl-remove-1st 1 '(1 2 3 1 2 3))

I would have thought the first item is fed to foo, the IF statement evaluates and redefines foo (hence returning T, and so the first item is removed), and subsequent evaluation of foo would return nil (hence no more items are removed).

What is wrong in my reasoning?

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Group By Assoc
« Reply #26 on: April 04, 2010, 03:54:09 PM »
my version remove first
Code: [Select]
(defun r1 (x l)
 (cond
  ((not l)nil)
  ((= x (car l))(cdr l))
  ((cons (car l)(r1 x(cdr l))))))

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: -={ Challenge }=- Group By Assoc
« Reply #27 on: April 04, 2010, 03:57:33 PM »
As usual - nice idea Evgeniy!  :lol:

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- Group By Assoc
« Reply #28 on: April 04, 2010, 04:16:30 PM »
Code: [Select]
(defun r2 (x l / ll)
 ;;iteration
 (while (and l (/= (car l) x))
  (setq ll (cons (car l) ll)
        l  (cdr l)
  ) ;_  setq
 ) ;_  while
 (if l
  (append (reverse ll) (cdr l))
  (reverse ll)
 ) ;_  if
)

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: -={ Challenge }=- Group By Assoc
« Reply #29 on: April 04, 2010, 04:43:28 PM »
A new version which doesn't remove duplicated items

Code: [Select]
(defun GroupByAssoc (lst / f1 f2)
  (defun f1 (a l / b)
    (if (setq b (assoc (car a) l))
      (f1 (append a (cdr b)) (removefirst b l))
      (cons a (f2 l))
    )
  )
  (defun f2 (l)
    (if (cdr l)
      (f1 (car l) (cdr l))
      l
    )
  )
  (f1 (car lst) (cdr lst))
)

(defun removefirst (item lst)
  (if (or (equal item (car lst)) (null lst))
    (cdr lst)
    (cons (car lst) (removefirst item (cdr lst)))
  )
)
« Last Edit: April 04, 2010, 04:56:37 PM by gile »
Speaking English as a French Frog