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

[Lee Mac]

The Challenge:

To emulate the behaviour of the Express Tools' acet-list-group-by-assoc function, (however the list should be in the correct order, unlike that function...). The function needn't accomodate for dotted pairs.

Example:

Code: [Select]

(setq lst '((1 123 234) (2 234 345) (3 345 456) (2 456 567) (3 567 678)))

==> ((1 123 234) (2 234 345) (3 345 456) (2 456 567) (3 567 678))


Code: [Select]

(reverse (acet-list-group-by-assoc lst))

==> ((1 123 234) (2 234 345 456 567) (3 345 456 567 678))

I'll kick us off, as an example:

Code: [Select]

(defun _GroupByAssoc ( lst / rtn a )
  (setq rtn (list (car lst)))

  (while (setq lst (cdr lst))
    (setq rtn
      (if (setq a (assoc (caar lst) rtn))
        (subst (cons (car a) (append (cdr a) (cdar lst))) a rtn)
        (cons (car lst) rtn))))
 
  (reverse rtn))

Enjoy,

Lee

[JohnK]

Here is my c++ entry.

Code: [Select]

int main ( )
/*
   sort a three dimensional array by first colum using the bubble sort.

   the array:
   (
    (1 123 234)
    (2 234 345)
    (3 345 456)
    (2 456 567)
    (3 567 678)
   )
*/
{
        int rows = 5,
            cols = 3;
        int r,
            c = 0;
        int tmp[1][3];
            // temp array to hold value while switch is made.
        int nums[5][3] = {
                {1, 123, 234},
                {2, 234, 345},
                {3, 345, 456},
                {2, 456, 567},
                {3, 567, 678}};
               
        cout << "\nOrig array is:\n";
        for(r=0; r<rows; r++)
                // print the array
        {
                for(c=0; c<cols; ++c) cout << '\t' << nums[r][c];
                // print each entry
               
                cout << endl;
                // add a line break
        }

        cout << endl;

        for(r=1; r<rows; r++)
        {
                // if array entry is bigger then the previous
                // entry, swap them
                if(nums[r][0] < nums[r-1][0])
                {
                        for(c=0; c<cols; c++)
                        {
                           tmp[0][c] = nums[r-1][c];
                           nums[r-1][c] = nums[r][c];
                           nums[r][c] = tmp[0][c];
                        }
                }
        }

        cout << "\nSorted array is:\n";
        for(r=0; r<rows; r++)
                // print the array
        {
                for(c=0; c<cols; ++c) cout << '\t' << nums[r][c];
                // print each entry

                cout << endl;
                // add a line break
        }

        return 0;
}

Orig array is:
        1       123     234
        2       234     345
        3       345     456
        2       456     567
        3       567     678


Sorted array is:
        1       123     234
        2       234     345
        2       456     567
        3       345     456
        3       567     678

[Lee Mac]

Thanks John 

It seems the challenge isn't as interesting as the other one, but I'm having fun anyway 

Here's an attempt at 'Bicursion' 

Code: [Select]

(defun _GroupByAssoc2 ( lst / g f )

  (defun g ( l )
    (if l
      (f (caar l) l)))

  (defun f ( x l )
    (cons
      (cons x (apply (function append)
                     (mapcar (function cdr)
                             (vl-remove-if-not
                               (function
                                 (lambda (pair) (= x (car pair)))) l))))
      (g (vl-remove-if (function (lambda (pair) (= x (car pair)))) l))))

  (g lst))


[qjchen]

Hi, Lee mac:)

When I finish the code, I feel it is similar to your first code.

Code: [Select]

(defun c:test ()
  (setq lst '((9 1111)
         (1 123 234) (2 234 345)
(3 345 456)
(2 456 567)
(4 678 789 90)
(3 567 678)
(1 111)
)
  )
  (chenGroupassoc lst)
)

(defun chenGroupassoc (lst / res a b item)
  (setq res (list (car lst)))
  (while (setq lst (cdr lst))
    (setq a (car lst) b (car a))
    (if (not (setq item (assoc b res)))
      (setq res (append res (list a)))
        (setq res (subst (append item (cdr a)) item res))))
)


[gile]

Hi

A cross recursive example

Code: [Select]

(defun GroupByAssoc (lst / f1 f2)
  (defun f1 (a l / b)
    (if (setq b (assoc (car a) l))
      (f1 (append a (cdr b)) (vl-remove b l))
      (cons a (f2 l))
    )
  )
  (defun f2 (l)
    (if (cdr l)
      (f1 (car l) (cdr l))
      l
    )
  )
  (f1 (car lst) (cdr lst))
)

[Lee Mac]

Very nice Gile!  I like it 

[Lee Mac]

Another to mess with the mind 

Code: [Select]

(defun _GroupByAssoc3 ( lst / g f )

  (defun g ( a b )
    (if a
      (if (assoc (caar a) b)
        (g (cdr a) b)
        (g (cdr a)
           (cons
             (cons (caar a)
                (f (caar a) a)) b))) b))

  (defun f ( x l )
    (if l
      (if (= x (caar l))
        (append (cdar l) (f x (cdr l)))
        (f x (cdr l)))))

  (reverse (g lst nil)))


[ElpanovEvgeniy]

my version:

Code: [Select]

(defun gba-ee (l / a)
 (setq l (vl-sort l (function (lambda (a b) (>= (car a) (car b)))))
       a nil
 )
 (while l
  (setq a (cons (car l) a)
        l (cdr l)
  )
  (while (and l (= (caar l) (caar a)))
   (setq a (cons (cons (caar l) (append (cdar l) (cdar a))) (cdr a))
         l (cdr l)
   )
  )
 )
 a
)

[Lee Mac]

Nice idea Evgeniy 

[ElpanovEvgeniy]

Nice idea Evgeniy 

I hope this idea will give odds to speed ...

[Lee Mac]

Nice idea Evgeniy 

I hope this idea will give odds to speed ...

But would Sorting reduce speed for longer lists... 

[ElpanovEvgeniy]

But would Sorting reduce speed for longer lists... 

Yes, sorting is very fast!
Particularly noticeable is in large lists...

[It's Alive!]

What's the difference between 'cross recursive' and 'Bicursion'... just so I know I'm properly dressed   

[Lee Mac]

What's the difference between 'cross recursive' and 'Bicursion'... 

Bicursion is a term I picked up from this thread 

[Lee Mac]

Quick speed test:

Code: [Select]

Intel Core2Duo @ 2.1GHz
3GB RAM

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

    (MAC_GROUPBYASSOC LST)......1201 / 5.61 <fastest>
    (GILE_GROUPBYASSOC LST).....1264 / 5.33
    (GBA-EE LST)................1872 / 3.60
    (MAC_GROUPBYASSOC3 LST).....1903 / 3.54
    (MAC_GROUPBYASSOC2 LST).....6740 / 1.00 <slowest>