TO SPLIT A LIST AT Two conditions

[hosneyalaa]

Hello all
We hope all members
Share their thoughts to get the result
If I have this list

After making the SORTING for it

(setq attdata '((6 4 "A") (6 4 "B") (18 11 "A") (18 11 "A") (18 11 "C") (18 12 "C") (22 6 "T") (22 6 "M")))

And I want to split it when the two conditions are TRUE

As for the following list

(setq attdatrslt  '(
		  ((6 4 "A") (6 4 "B"))
		  ((18 11 "A") (18 11 "A") (18 11 "C"))
		  ((18 12 "C"))
		  ((22 6 "T") (22 6 "M"))
		  ))

 

 

 

Thank you all
advance

 

 

Edited October 23, 2020 by hosneyalaa

[Lee Mac]

Quick example:

(defun foo ( l f / r z )
    (foreach x (reverse l)
        (if (vl-some '(lambda ( y ) (if (apply f (list x (car y))) (setq z y))) r)
            (setq r (subst (cons x z) z r))
            (setq r (cons  (list x) r))
        )
    )
)

_$ (setq attdata '((6 4 "A") (6 4 "B") (18 11 "A") (18 11 "A") (18 11 "C") (18 12 "C") (22 6 "T") (22 6 "M")))
(
    ( 6  4 "A")
    ( 6  4 "B")
    (18 11 "A")
    (18 11 "A")
    (18 11 "C")
    (18 12 "C")
    (22  6 "T")
    (22  6 "M")
)
_$ (foo attdata '(lambda ( a b ) (and (= (car a) (car b)) (= (cadr a) (cadr b)))))
(
    (( 6  4 "A") ( 6  4 "B"))
    ((18 11 "A") (18 11 "A") (18 11 "C"))
    ((18 12 "C"))
    ((22  6 "T") (22  6 "M"))
)

 

Edited October 23, 2020 by Lee Mac

[hosneyalaa]

Lee Mac 

Thank you so much
It works perfectly
Thank you

[pBe]

Another

(Defun _Pair (lst / a f s g b nlst) 
( (lambda (lst)
    (while (setq a (car lst))
	 (setq b nil f (car a) s (cadr a) g (list a))
  		(Foreach itm (Cdr lst)
		    (if (and (= (Car itm) f)(= (Cadr itm) s))
		  		(setq g (cons itm g))
		      		(setq b (cons itm b))))		      
  		(setq nlst (cons g
			     nlst) lst (reverse b))
  		) nlst
    )
  (reverse lst)
  )
  )

 

[hosneyalaa]

 

pBe

Thank you so much
Another solution that works beautifully
Thank you

[Lee Mac]

8 hours ago, hosneyalaa said:

Lee Mac 

Thank you so much
It works perfectly
Thank you

 

You're most welcome @hosneyalaa

[Stefan BMR]

Hi

 

Trying to test the speed for different approaches, I've added a recursive way

(defun f (l q)
  ( (if q vl-remove-if-not vl-remove-if)
    (function
      (lambda (a)
        (and
          (= (car  a) (caar  l))
          (= (cadr a) (cadar l))
        )
      )
    )
    l
  )
)

(defun group_1 (lst)
  (if lst
    (cons (f lst T) (group_1 (f lst nil)))
  )
)

Speed test result

Benchmarking ... done for 8192 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(_PAIR ATTDATA)                               8192      1172      1172     16.44
(GROUP_1 ATTDATA)                             4096      1187      2374      8.11
(FOO ATTDATA (QUOTE (LAMBDA (A B) (A...)       512      1204     19264      1.00
--------------------------------------------------------------------------------

And for a longer, scrambled list

(setq attdata nil)
(repeat 100
  (setq attdata
    (cons
      (list
        (rem (dos_random) 5)
        (rem (dos_random) 5)
        (chr (+ 65 (rem (dos_random) 26)))
      )
      attdata
    )
  )
)

Benchmarking ... done for 512 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(_PAIR ATTDATA)                                512      1799      1799     40.02
(GROUP_1 ATTDATA)                              256      1719      3438     20.94
(FOO ATTDATA (QUOTE (LAMBDA (A B) (A...)         8      1125     72000      1.00
--------------------------------------------------------------------------------

Well done PBE!

[Lee Mac]

I wonder how pre-sorting the list compares...

(defun foo2 ( l / m r )
    (setq l (vl-sort l (function (lambda ( a b ) (if (= (car a) (car b)) (> (cadr a) (cadr b)) (> (car a) (car b)))))))
    (while l
        (setq m (list (car l))
              l (cdr l)
        )
        (while (and l (= (caar m) (caar l)) (= (cadar m) (cadar l)))
            (setq m (cons (car l) m)
                  l (cdr l)
            )
        )
        (setq r (cons (reverse m) r))
    )
)

 

[Stefan BMR]

56 minutes ago, Lee Mac said:

I wonder how pre-sorting the list compares...

 

Benchmarking .. done for 512 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(FOO2 ATTDATA)                                 512      1218      1218      1.46
(_PAIR ATTDATA)                                512      1781      1781      1.00
--------------------------------------------------------------------------------

Of course, calling the function with the list already sorted is even better (..for benchmark purpose. In reality you will sort it only once,  inside or outside the function)

(setq attdata (vl-sort attdata (function (lambda ( a b ) (if (= (car a) (car b)) (> (cadr a) (cadr b)) (> (car a) (car b)))))))

(length attdata) -> 100

(defun foo3 ( l / m r )
    (while l
        (setq m (list (car l))
              l (cdr l)
        )
        (while (and l (= (caar m) (caar l)) (= (cadar m) (cadar l)))
            (setq m (cons (car l) m)
                  l (cdr l)
            )
        )
        (setq r (cons (reverse m) r))
    )
)

Benchmarking .. done for 2048 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(FOO3 ATTDATA)                                2048      1078      1078      7.19
(_PAIR ATTDATA)                                512      1938      7752      1.00
--------------------------------------------------------------------------------

And some minor improvement, using PBE's idea with local variables instead of multiple (caar m) and (cadar m)

(defun foo4 ( l / m r a b)
    (while l
        (setq m (list (car l))
              a (caar m)
              b (cadar m)
              l (cdr l)
        )
        (while (and l (= a (caar l)) (= b (cadar l)))
            (setq m (cons (car l) m)
                  l (cdr l)
            )
        )
        (setq r (cons (reverse m) r))
    )
)

Benchmarking ... done for 2048 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(FOO4 ATTDATA)                                2048      1015      1015      7.70
(FOO3 ATTDATA)                                2048      1110      1110      7.05
(_PAIR ATTDATA)                                512      1955      7820      1.00
--------------------------------------------------------------------------------
 
_$ 
Benchmarking .. done for 2048 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(FOO4 ATTDATA)                                2048      1016      1016      1.09
(FOO3 ATTDATA)                                2048      1110      1110      1.00
--------------------------------------------------------------------------------

 

[pBe]

3 hours ago, Stefan BMR said:

...

And some minor improvement, using PBE's idea with local variables instead of multiple (caar m) and (cadar m)..

 

Did not realize that localiziing makes a diffrerence, and all this time i'm avoiding it thinking it takes more of the memory block.

 

Learn new things everyday. And thank you for testing the code. 

It's all fun 

Edited October 25, 2020 by pBe

[hosneyalaa]

Stefan BMR

Thank you so much
For participation, new ideas and useful comparison
We learn new things
thanks for all