### Author Topic: [challenge] 38 : List pooling  (Read 592 times)

0 Members and 1 Guest are viewing this topic. ##### [challenge] 38 : List pooling
« on: April 01, 2022, 09:36:33 AM »
Given a list, split it into pools of a specified size and return the rest.

Example:
(pool 2 '(1 2 3 4 5 6 7))
> ((1 2 3) (3 4 5) (6 7))

(pool 5 '(1 2 3 4 5 6 7))
> ((1 2 3 4 5 6) (7))

(pool 8 '(1 2 3 4 5 6 7))
> (1 2 3 4 5 6 7)

(pool 1 nil)
> nil
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

#### Marc'Antonio Alessi ##### Re: [challenge] 38 : List pooling
« Reply #1 on: April 01, 2022, 11:57:53 AM »

#### kirby ##### Re: [challenge] 38 : List pooling
« Reply #2 on: April 04, 2022, 03:42:47 PM »
My attempt... (and as always not attempting the code brevity record, just get 'er done and make is simple enough to understand in 10 years time)

Tweaked the conditions a bit because the following seems odd to me:
(pool 2 '(1 2 3 4 5 6 7))  -> ((1 2 3) (3 4 5) (6 7))

Would rather have Number 2 specify the number of items in the sublist and not the greatest index (0-n), but easy to switch either way.
e.g.  (pool 2 '(1 2 3 4 5 6 7))  -> ((1 2) (3 4) (5 6) (7))

Code - Auto/Visual Lisp: [Select]
1. (defun C:TestPool ( / MyTestLust CNT MyItem Num Ans)
2. ; Test function for challenge 38 : List pooling
3. ; Given a list, split it into pools of a specified size and return the rest.
4. ; Example:
5. ;       (pool 2 '(1 2 3 4 5 6 7))
6. ;               > ((1 2 3) (3 4 5) (6 7))
7. ;       (pool 5 '(1 2 3 4 5 6 7))
8. ;               > ((1 2 3 4 5 6) (7))
9. ;       (pool 8 '(1 2 3 4 5 6 7))
10. ;               > (1 2 3 4 5 6 7)
11. ;       (pool 1 nil)
12. ;               > nil
13.
14.
15. (setq MyTestList (list
16.         '(1 2 3 4 5 6 7)
17.         nil
18. ))
19.
20. (setq CNT 0)
21. (repeat (length MyTestList)
22.
23.         (setq MyItem (nth CNT MyTestList))
24.         (prompt "\nTest List = ")(princ MyItem)(princ)
25.
26.         (setq Num 1)
27.         (repeat (1+ (length MyItem))
28.                 (setq Ans (pool-kirby NUM MyItem))
29.                 (prompt "\n  Num = ")(princ NUM)(prompt "  Result = ")(princ Ans)(princ)
30.                 (setq NUM (1+ NUM))
31.         ) ; close repeat
32.
33.         (setq CNT (1+ CNT))
34. ) ; close repeat
35.
36. (prompt "\nComplete!")(princ)
37. )
38.
39.
40.
41. (defun Pool-kirby (MyNum MyList /
42.                 OutList1 OutList2 CNT
43.                 )
44. ; Challenge 38 - group a list into pools of specific size
45. ; Input:
46. ;       MyNum - (integer) number of items in pool.  Must be 1 or larger.
47. ;       MyList - (list) un-nested list of items
48. ; Returns:
49. ;       list of sublists, with any remaining items included in final sublist
50.
51. (setq OutList1 nil)
52. (setq OutList2 nil)
53.
54. (if (> MyNum 0)
55.         (setq CNT 0)
56.         (repeat (length MyList)
57.
58.                 (if (eq (length OutList1) MyNum)
59.                         (setq OutList2 (cons (reverse OutList1) OutList2))      ; build output list
60.                         (setq OutList1 (list (nth CNT MyList)))                 ; reset sublist
61.                   )
62.                         (setq OutList1 (cons (nth CNT MyList) OutList1))        ; continue to build sublist
63.                   )
64.                 )
65.
66.                 (setq CNT (1+ CNT))
67.         ) ; close repeat
68.
69.         (if OutList1
70.                 (setq OutList2 (cons (reverse OutList1) OutList2))      ; add remaining sublist
71.         )
72.
73.         (setq OutList2 (reverse OutList2))
74.
75.   )
76. ) ; close if
77.
78. OutList2
79. )
80.

Results:
Command: TESTPOOL

Test List = (1 2 3 4 5 6 7)
Num = 1  Result = ((1) (2) (3) (4) (5) (6) (7))
Num = 2  Result = ((1 2) (3 4) (5 6) (7))
Num = 3  Result = ((1 2 3) (4 5 6) (7))
Num = 4  Result = ((1 2 3 4) (5 6 7))
Num = 5  Result = ((1 2 3 4 5) (6 7))
Num = 6  Result = ((1 2 3 4 5 6) (7))
Num = 7  Result = ((1 2 3 4 5 6 7))
Num = 8  Result = ((1 2 3 4 5 6 7))
Test List = nil
Num = 1  Result = nil
Complete!

#### dexus

• Newt
• Posts: 75 ##### Re: [challenge] 38 : List pooling
« Reply #3 on: April 05, 2022, 07:17:31 AM »
Quick one, without any optimizations:
Code - Auto/Visual Lisp: [Select]
1. (defun pool (n lst / i rtn)
2.   (while lst
3.     (repeat (min n (length lst))
4.       (setq i (cons (car lst) i)
5.             lst (cdr lst))
6.     )
7.     (setq rtn (cons (reverse i) rtn)
8.           i nil)
9.     )
10.   (reverse rtn)
11. )

*edit* and an attempt to get rid of some of the length checks and reversals.
Code - Auto/Visual Lisp: [Select]
1. (defun pool (n lst / i rtn)
2.   (setq lst (reverse lst))
3.   (repeat (rem (length lst) n)
4.     (setq i (cons (car lst) i)
5.           lst (cdr lst))
6.   )
7.   (setq rtn (list i))
8.   (while lst
9.     (setq i nil)
10.     (repeat n
11.       (setq i (cons (car lst) i)
12.             lst (cdr lst))
13.     )
14.     (setq rtn (cons i rtn))
15.   )
16.   rtn
17. )
« Last Edit: April 05, 2022, 08:00:39 AM by dexus »

#### dexus

• Newt
• Posts: 75 ##### Re: [challenge] 38 : List pooling
« Reply #4 on: April 06, 2022, 07:33:32 AM »
I made a version that precomputes the functions that count the items. This should be good for long lists.
Inspired by bruno_vdh just like he did in this topic: https://www.theswamp.org/index.php?topic=57351.msg608524#msg608524

Code - Auto/Visual Lisp: [Select]
1. (defun cdrN (x) ; Returns a function that removes the first x items of a list
2.   (cond
3.     ((> x 3) (cons 'cddddr (list (cdrN (- x 4)))))
4.     ((= x 3) (cons 'cdddr  (list (cdrN (- x 3)))))
5.     ((= x 2) (cons 'cddr   (list (cdrN (- x 2)))))
6.     ((= x 1) (cons 'cdr    (list (cdrN (1- x)))))
7.     (t 'l)
8.   )
9. )
10. (defun carN (x) ; Returns a function that returns the nth (x) item of a list
11.   (cond
12.     ((> x 3) (cons 'cadddr (list (cdrN (- x 4)))))
13.     ((= x 3) (cons 'caddr  (list (cdrN (- x 3)))))
14.     ((= x 2) (cons 'cadr   (list (cdrN (- x 2)))))
15.     ((= x 1) (cons 'car    (list (cdrN (1- x)))))
16.     (t 'l)
17.   )
18. )
19. (defun firstN (x / rtn) ; Returns a function that returns the first x items of a list
20.   (while (/= x 0)
21.     (setq rtn (cons 'cons (cons (carN x) (list (cond (rtn)))))
22.           x (1- x))
23.   )
24.   rtn
25. )
26.
27. (defun pool-dexus (n l / cdrNth firstNth r)
28.   (eval (cons 'defun ; Create function that returns the first n items of a list
29.     (cons 'firstNth (list (list 'l)
30.     (firstN n)
31.   ))))
32.   (eval (cons 'defun ; Create function that removes the first n items of a list
33.     (cons 'cdrNth (list (list 'l)
34.     (cdrN n)
35.   ))))
36.   (while l ; Loop through list with newly created functions
37.     (setq r (cons (firstNth l) r)
38.           l (cdrNth l))
39.   )
40.   (reverse r) ; return list
41. )