Topic: [challenge] A09 : Run-length Encoding of a list

[JohnK]

Using only AutoLisp, implement run-length encoding (RLE) on a list of duplicate entries. If an element has no duplicates it is simply copied into the result list meaning that only elements with duplicates are transferred as (N E) lists to the result list.

Example:
(encode-rle-list '(a a a a b c c a a d e e e e))
> ((4 A) B (2 C) (2 A) D (4 E))

[Lee Mac]

Quick first stab -

Code - Auto/Visual Lisp: [Select]

1. (defun rle1 ( l / f )
2.     (defun f ( l x n )
3.         (if l
4.             (if (= x (car l))
5.                 (f (cdr l) x (1+ n))
6.                 (cons (if (= 1 n) x (list n x)) (f (cdr l) (car l) 1))
7.             )
8.             (list (if (= 1 n) x (list n x)))
9.         )
10.     )
11.     (f (cdr l) (car l) 1)
12. )

Code - Auto/Visual Lisp: [Select]

1. _$ (rle1 '(a a a a b c c a a d e e e e))
2. ((4 A) B (2 C) (2 A) D (4 E))

[Lee Mac]

Another, iterative -

Code - Auto/Visual Lisp: [Select]

1. (defun rle2 ( l / n r x )
2.     (while l
3.         (setq x (car l)
4.               l (cdr l)
5.               n 1
6.         )
7.         (while (and l (= x (car l)))
8.             (setq n (1+  n)
9.                   l (cdr l)
10.             )
11.         )
12.         (setq r (cons (if (= 1 n) x (list n x)) r))
13.     )
14.     (reverse r)
15. )

[JohnK]

Iterative will be faster but here was mine.

Code - Auto/Visual Lisp: [Select]

1. (defun encode-rle-list (aList / pack)
2.         (defun pack (aList)
3.           (defun group-subarray (element seg aList)
4.             (cond
5.               ((null aList)
6.                (list (cons element seg)))
7.               ((eq element (car aList))
8.                (group-subarray element (cons element seg) (cdr aList)))
9.               (t
10.                 (cons
11.                   (cons element seg)
12.                   (group-subarray (car aList) '() (cdr aList))))
13.               )
14.             )
15.           (if (null aList)
16.             '()
17.             (group-subarray (car aList) '() (cdr aList)))
18.           )
19.   (mapcar
20.     '(lambda (x)
21.        (if (= (length x) 1)
22.          (car x)
23.          (list (length x) (car x))))
24.     (pack aList)
25.     )
26.   )
27.  

EDIT: removed "extra" function from code. ...not sure what I was thinking at the time.

[ronjonp]

Hey John, why are you limiting these challenges to only 'pure' autolisp?
It would be fun to use all the tools in the bag then bench the vl variants against themselves as well as the pure autolisp against themselves then a total bench.

Maybe have the participants name the functions like so to easily keep track:
VL-<USERNAME>-<FUNCTIONNAME>-<#>
VANILLA-<USERNAME>-<FUNCTIONNAME>-<#>

Just a thought 

[JohnK]

The thought was:
1. Beginners could learn the basic principles easier. (But there isn't a whole lot of interactions happening with these)
2. VL has a lot of these functions baked in (vl-somethin' ...) and submissions would be short and dumb.

We can certainly open these up to VL and AL but we should have rules (like you suggest).

Maybe those names could be simplified?
<FUNCTIONNAME>-<USER>-<#>
or
vl_<FUNCTIONNAME>-<USER>-<#>


I tried to make an "ASSERT" function to check the results before adding the submission to the benchmark list but it didn't work out that well. I would like to do more testing but everyone's so quiet.

[BIGAL]

I use a method by Gile works great for Block attribute quantities.

Code: [Select]

; By AlanH Aug 2021
(vl-load-com)
; By Gile
(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(setq lst '("a" "a" "a" "a" "b" "b" "b" "b" "b" "C" "C" ))
(setq lst2 (remove_doubles lst))
(foreach val lst2
(setq cnt (my-count  val lst))
(setq lst3 (cons (list val cnt) lst3))
)

(("C" 2) ("b" 5) ("a" 4))


[It's Alive!]

sorry, bored
Lee's while in C++20

Code - C: [Select]

1. #include <iostream>
2. #include <vector>
3. #include <variant>
4. #include <string>
5.  
6. using namespace std;
7. using Values = vector<variant<int32_t, double_t, wstring>>;
8.  
9. int main()
10. {
11.         const Values l =
12.         {
13.                 L"a", L"a", L"a", L"a", L"b", L"c", L"c", L"a",
14.                 L"a", L"d", L"e", L"e", L"e", L"e", 4, 4, 4, 4, 5.75
15.         };
16.         auto i = l.begin(), in = i, e = l.end();
17.         while (in != e) {
18.                 auto n = 1;
19.                 while (++in != e && *i == *in) {
20.                         n++;
21.                         i++;
22.                 }
23.                 if (n == 1)
24.                         visit([](auto&& x) {std::wcout << x; }, *i);
25.                 else
26.                         visit([&](auto&& x) {std::wcout << '(' << n << ' ' << x << ')'; }, *i);
27.                 i = in;
28.         }
29.         cin.get();
30. }
31.  

[roy_043]

Lst may not contain nil:

Code - Auto/Visual Lisp: [Select]

1. (defun encode-rle-list-roy (lst / tmp)
2.   (apply
3.     'append
4.     (mapcar
5.       '(lambda (cur / ret)
6.         (cond
7.           ((not cur)
8.             (if (cdr tmp)
9.               (list (list (length tmp) (car tmp)))
10.               tmp
11.             )
12.           )
13.           ((not tmp)
14.             (setq tmp (list cur))
15.             nil
16.           )
17.           ((equal cur (car tmp))
18.             (setq tmp (cons cur tmp))
19.             nil
20.           )
21.           (T
22.             (setq ret
23.               (if (cdr tmp)
24.                 (list (list (length tmp) (car tmp)))
25.                 tmp
26.               )
27.             )
28.             (setq tmp (list cur))
29.             ret
30.           )
31.         )
32.       )
33.       (append lst '(nil))
34.     )
35.   )
36. )

[dexus]

Here is my first attempt.
This was without looking at the others, the second one looks virtually identical to Lee's submission.

Code - Auto/Visual Lisp: [Select]

1. (defun rle-dexus (lst / counter item output)
2.   (if lst (progn
3.     (setq counter 0 item (car lst))
4.     (while (= item (car lst))
5.       (setq counter (1+ counter) lst (cdr lst))
6.     )
7.     (setq output (cons (if (= counter 1) item (list counter item)) (rle-dexus lst)))
8.   ))
9.   output
10. )

And a version with a loop:

Code - Auto/Visual Lisp: [Select]

1. (defun rle-dexus-loop (lst / counter item output)
2.   (while lst
3.     (setq counter 0 item (car lst))
4.     (while (= item (car lst))
5.       (setq counter (1+ counter) lst (cdr lst))
6.     )
7.     (setq output (cons (if (= counter 1) item (list counter item)) output))
8.   )
9.   (reverse output)
10. )

[ElpanovEvgeniy]

Code - Auto/Visual Lisp: [Select]

1. (defun f (l)
2.   (if l
3.     (if (atom (car l))
4.       (if (= (car l) (cadr l))
5.         (f (cons (list 1 (car l)) (cdr l)))
6.         (cons (car l) (f (cdr l)))
7.       )
8.       (if (= (cadar l) (cadr l))
9.         (f (cons (list (1+ (caar l)) (cadar l)) (cddr l)))
10.         (cons (car l) (f (cdr l)))
11.       )
12.     )
13.   )
14. )

[VovKa]

here's the same problem as in A01 and A08