Author Topic: Split List Using Test Function  (Read 3469 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 812
Split List Using Test Function
« on: August 23, 2017, 02:26:59 PM »
Hi guys,
Does anyone has a function that splits a list into sublists, using a custom criteria (test function) ? i.e.:

Code - Auto/Visual Lisp: [Select]
  1. (setq L '("ABC" 1 "A" "B" -2 "CDE" 525 "D" 3 "E" "F")) ; Given List

Code - Auto/Visual Lisp: [Select]
  1. (foo (lambda (x) (= "CDE" x)) L) -> '(("ABC" 1 "A" "B" -2) ("CDE") (525 "D" 3 "E" "F"))
  2. (foo numberp L) -> '(("ABC") (1) ("A" "B") (-2) ("CDE") (525) ("D") (3) ("E" "F"))
  3. (foo minusp L) -> '(("ABC" 1 "A" "B") (-2) ("CDE" 525 "D" 3 "E" "F"))
  4. (foo (lambda (x) (member x '("A" "D"))) L) -> '(("ABC" 1) ("A") ("B" -2 "CDE" 525) ("D") (3 "E" "F"))

 :roll: :idea:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Split List Using Test Function
« Reply #1 on: August 23, 2017, 02:41:56 PM »
Simplistic approach:
Code - Auto/Visual Lisp: [Select]
  1. (defun foo ( prd lst / rtn tmp )
  2.     (foreach itm lst
  3.         (if (apply prd (list itm))
  4.             (progn
  5.                 (if tmp (setq rtn (cons (reverse tmp) rtn)))
  6.                 (setq rtn (cons (list itm) rtn)
  7.                       tmp nil
  8.                 )
  9.             )
  10.             (setq tmp (cons itm tmp))
  11.         )
  12.     )
  13.     (reverse (if tmp (cons (reverse tmp) rtn) rtn))
  14. )

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Split List Using Test Function
« Reply #2 on: August 23, 2017, 02:44:17 PM »
Or, more condensed:
Code - Auto/Visual Lisp: [Select]
  1. (defun foo ( prd lst / rtn tmp )
  2.     (foreach itm lst
  3.         (if (apply prd (list itm))
  4.             (setq rtn (vl-list* (list itm) (reverse tmp) rtn) tmp nil)
  5.             (setq tmp (cons itm tmp))
  6.         )
  7.     )
  8.     (vl-remove nil (reverse (cons (reverse tmp) rtn)))
  9. )

VovKa

  • Water Moccasin
  • Posts: 1626
  • Ukraine
Re: Split List Using Test Function
« Reply #3 on: August 23, 2017, 03:32:24 PM »
Lee, it's better to change (apply prd (list itm)) to (prd itm) and pass the argument unqouted
in this case the function will run much faster

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Split List Using Test Function
« Reply #4 on: August 23, 2017, 03:36:35 PM »
Wow - That was fast, Lee!
Did you just wrote this, or you already had such subfunction?

Some not-so-interesting fact, about how I got the idea:
I was exploring some of your [Lee Mac] codes, where you were grouping some items like this (but the function you used there didn't serve a global purpose).
Then I thought about attempting to write such modification myself, but obviously failed... few weeks passed and finally decided to ask here.

Thread after thread helping me out, I shall call you the LISP GOD:crazy2:
Not sure what would be the next list manipulation idea I'll come up with, but I'm happy you are still here!



Lee, it's better to change (apply prd (list itm)) to (prd itm) and pass the argument unqouted
in this case the function will run much faster

I'm also on that opinion - not sure why Lee prefers to stick with unevaluated functions as arguments.  :roll:
Number 1 priority is that it works as supposed.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Split List Using Test Function
« Reply #5 on: August 23, 2017, 04:00:40 PM »
Wow - That was fast, Lee!
Did you just wrote this, or you already had such subfunction?

Thanks Grrr1337 - I wrote the function after reading the thread.  :-)

Not sure what would be the next list manipulation idea I'll come up with, but I'm happy you are still here!

Thank you for your kind words - I do enjoy these type of 'challenge' threads and so I look forward to it.

Lee, it's better to change (apply prd (list itm)) to (prd itm) and pass the argument unqouted
in this case the function will run much faster
I'm also on that opinion - not sure why Lee prefers to stick with unevaluated functions as arguments.  :roll:

I designed the function to accept a quoted functional argument purely for consistency with standard AutoLISP functions - a call to eval redefining the prd symbol before the foreach loop would perhaps yield the best of both.

fools

  • Newt
  • Posts: 72
  • China
Re: Split List Using Test Function
« Reply #6 on: August 24, 2017, 07:39:51 AM »
Ingenious program loop , I learned how to be concise , thanks for share,  Lee .
Change "apply" to "vl-catch-all-apply" will be better , beacuse  (minusp "ABC")  ->  error

Code - Auto/Visual Lisp: [Select]
  1. (DEFUN foo (prd lst / rtn tmp err)
  2.   (FOREACH itm lst
  3.     (IF(OR (NOT (SETQ err (VL-CATCH-ALL-APPLY prd (LIST itm)))) (VL-CATCH-ALL-ERROR-P err))
  4.       (SETQ tmp (CONS itm tmp))
  5.       (SETQ rtn (VL-LIST* (LIST itm) (REVERSE tmp) rtn) tmp nil)
  6.     )
  7.   )
  8.   (VL-REMOVE nil (REVERSE (CONS (REVERSE tmp) rtn)))
  9. )
« Last Edit: August 24, 2017, 08:12:18 AM by fools »
Good good study , day day up . Sorry about my Chinglish .

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Split List Using Test Function
« Reply #7 on: August 24, 2017, 10:19:07 AM »
Good catch, but @fools, analyze this explanation (look for short versions and their notes for foo3 and foo4)... The problem is quickly solvable by correct function specification, so Grrr have overlooked this when posting question... Instead of : (foo 'minusp L), he should have written (foo '(lambda ( x ) (and (numberp x) (minusp x))) L)...

Code - Auto/Visual Lisp: [Select]
  1. ;; group alone items that are evaluated "t" and group multiple items in sequence that are evaluated "nil" by specified function
  2. ;;
  3. ;; (setq L1 '("ABC" 1 "A" "B" -2 "CDE" 525 "D" 3 "E" "F")) ; Given List 1
  4. ;;
  5. ;; (foo1 (function (lambda ( x ) (= "CDE" x))) L1) -> '(("ABC" 1 "A" "B" -2) ("CDE") (525 "D" 3 "E" "F"))
  6. ;; (foo1 (function numberp) L1) -> '(("ABC") (1) ("A" "B") (-2) ("CDE") (525) ("D") (3) ("E" "F"))
  7. ;; (foo1 (function minusp) L1) -> '(("ABC" 1 "A" "B") (-2) ("CDE" 525 "D" 3 "E" "F"))
  8. ;; (foo1 (function (lambda ( x ) (member x '("A" "D")))) L1) -> '(("ABC" 1) ("A") ("B" -2 "CDE" 525) ("D") (3 "E" "F"))
  9.  
  10. (defun foo1 ( prd lst / rtn tmp err )
  11.   (foreach itm lst
  12.     (setq err (vl-catch-all-apply prd (list itm)))
  13.     (if (and err (not (vl-catch-all-error-p err)))
  14.       (setq rtn (vl-list* (list itm) (reverse tmp) rtn) tmp nil)
  15.       (setq tmp (cons itm tmp))
  16.     )
  17.   )
  18.   (vl-remove nil (reverse (cons (reverse tmp) rtn)))
  19. )
  20.  
  21. ;; group alone items that are evaluated "nil" and group multiple items in sequence that are evaluated "t" by specified function
  22. ;;
  23. ;; (setq L2 '("ABC" 1 "A" "B" -2 -5 10 "CDE" 525 "D" 3 "E" "F")) ; Given List 2
  24. ;;
  25. ;; (foo2 (function (lambda ( x ) (= "CDE" x))) L2) -> '(("ABC") (1) ("A") ("B)" (-2) (-5) (10) ("CDE") (525) ("D") (3) ("E") ("F"))
  26. ;; (foo2 (function numberp) L2) -> '(("ABC") (1) ("A") ("B") (-2 -5 10) ("CDE") (525) ("D") (3) ("E") ("F"))
  27. ;; (foo2 (function minusp) L2) -> '(("ABC") (1) ("A") ("B") (-2 -5) (10) ("CDE") (525) ("D") (3) ("E") ("F"))
  28. ;; (foo2 (function (lambda ( x ) (member x '("A" "D")))) L2) -> '(("ABC") (1) ("A") ("B") (-2) (-5) (10) ("CDE") (525) ("D") (3) ("E") ("F"))
  29.  
  30. (defun foo2 ( prd lst / rtn tmp err )
  31.   (foreach itm lst
  32.     (setq err (vl-catch-all-apply prd (list itm)))
  33.     (if (and err (not (vl-catch-all-error-p err)))
  34.       (setq tmp (cons itm tmp))
  35.       (setq rtn (vl-list* (list itm) (reverse tmp) rtn) tmp nil)
  36.     )
  37.   )
  38.   (vl-remove nil (reverse (cons (reverse tmp) rtn)))
  39. )
  40.  
  41. ;; note that foo1 and foo2 are the same, only inside if (then) (else) are swithched...
  42.  
  43. ;; acquire items that are evaluated "t" and remove items evaluated "nil" by specified function
  44. ;;
  45. ;; (setq L3 '("ABC" 1 "A" "B" -2 "CDE" 525 "D" 3 "E" "F")) ; Given List 3
  46. ;;
  47. ;; (foo3 (function (lambda ( x ) (= "CDE" x))) L3) -> '("CDE")
  48. ;; (foo3 (function numberp) L3) -> '(1 -2 525 3)
  49. ;; (foo3 (function minusp) L3) -> '(-2)
  50. ;; (foo3 (function (lambda ( x ) (member x '("A" "D")))) L3) -> '("A" "D")
  51.  
  52. (defun foo3 ( prd lst / rtn err )
  53.   (foreach itm lst
  54.     (setq err (vl-catch-all-apply prd (list itm)))
  55.     (if (and err (not (vl-catch-all-error-p err)))
  56.       (setq rtn (cons itm rtn))
  57.     )
  58.   )
  59.   (reverse  rtn)
  60. )
  61.  
  62. (defun foo3 ( prd lst )
  63.   (vl-remove-if-not prd lst)
  64. )
  65. ;; this shortcut foo3 won't work correctly for (foo3 (function minusp) L3) - it will error : ; error: bad argument type: numberp: "ABC", so function must be specified differently (foo3 (function (lambda ( x ) (and (numberp x) (minusp x)))) L3)
  66.  
  67. ;; acquire items that are evaluated "nil" and remove items evaluated "t" by specified function
  68. ;;
  69. ;; (setq L4 '("ABC" 1 "A" "B" -2 -5 10 "CDE" 525 "D" 3 "E" "F")) ; Given List 4
  70. ;;
  71. ;; (foo4 (function (lambda ( x ) (= "CDE" x))) L4) -> '("ABC" 1 "A" "B" -2 -5 10 525 "D" 3 "E" "F")
  72. ;; (foo4 (function numberp) L4) -> '("ABC" "A" "B" "CDE" "D" "E" "F")
  73. ;; (foo4 (function minusp) L4) -> '("ABC" 1 "A" "B" 10 "CDE" 525 "D" 3 "E" "F")
  74. ;; (foo4 (function (lambda ( x ) (member x '("A" "D")))) L4) -> '("ABC" 1 "B" -2 -5 10 "CDE" 525 3 "E" "F")
  75.  
  76. (defun foo4 ( prd lst / rtn err )
  77.   (foreach itm lst
  78.     (setq err (vl-catch-all-apply prd (list itm)))
  79.     (if (not (and err (not (vl-catch-all-error-p err))))
  80.       (setq rtn (cons itm rtn))
  81.     )
  82.   )
  83.   (reverse  rtn)
  84. )
  85.  
  86. (defun foo4 ( prd lst )
  87.   (vl-remove-if prd lst)
  88. )
  89. ;; this shortcut foo4 won't work correctly for (foo4 (function minusp) L4) - it will error : ; error: bad argument type: numberp: "ABC", so function must be specified differently (foo4 (function (lambda ( x ) (and (numberp x) (minusp x)))) L4)
  90.  
  91. ;; note that foo3 and foo4 are the same, only if condition is opposite thus (not) before condition of foo3 in foo4 - in additional short variants function is opposite...
  92.  
« Last Edit: August 24, 2017, 10:22:59 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Split List Using Test Function
« Reply #8 on: August 24, 2017, 03:04:58 PM »
I designed the function to accept a quoted functional argument purely for consistency with standard AutoLISP functions

That makes sence - the main code would be more readable, when generally one passes unevaluated subfunctions as arguments to other ones.

a call to eval redefining the prd symbol before the foreach loop would perhaps yield the best of both.

That seems the most simple and effective solution.



The problem is quickly solvable by correct function specification, so Grrr have overlooked this when posting question...

Yeah, sorry about that - I was trying to be more clear about the required return value, based on the provided input.

Instead of : (foo 'minusp L), he should have written (foo '(lambda ( x ) (and (numberp x) (minusp x))) L)...

Thanks for the correction, Marko,
I didn't had the subfunction to see that it would error-out.

BTW I strongly advise to use the error-trapping technique inside the prd argument,
and not being used in the foo subfunction, due the possibility of neglected errors - which could make the debugging in the main code even harder.
So I don't think Lee's code require any more changes and I think he'd be on the same opinion.

IMO Error-trapping is good only in those cases where you can predict all the plausible failures of a given evaluation.

(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

fools

  • Newt
  • Posts: 72
  • China
Re: Split List Using Test Function
« Reply #9 on: August 25, 2017, 08:36:56 AM »
 :yes:
Good good study , day day up . Sorry about my Chinglish .