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

0 Members and 1 Guest are viewing this topic.

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
[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


kirby

  • Newt
  • Posts: 110
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.   (progn
  56.         (setq CNT 0)
  57.         (repeat (length MyList)
  58.  
  59.                 (if (eq (length OutList1) MyNum)
  60.                   (progn
  61.                         (setq OutList2 (cons (reverse OutList1) OutList2))      ; build output list
  62.                         (setq OutList1 (list (nth CNT MyList)))                 ; reset sublist
  63.                   )
  64.                   (progn
  65.                         (setq OutList1 (cons (nth CNT MyList) OutList1))        ; continue to build sublist
  66.                   )
  67.                 )
  68.  
  69.                 (setq CNT (1+ CNT))
  70.         ) ; close repeat
  71.  
  72.         (if OutList1
  73.                 (setq OutList2 (cons (reverse OutList1) OutList2))      ; add remaining sublist
  74.         )
  75.        
  76.         (setq OutList2 (reverse OutList2))
  77.  
  78.   )
  79. ) ; close if
  80.  
  81. OutList2
  82. )
  83.  

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. )