Remove a sequence of elements from a list

[cormullion]

Given a list with some doubled elements:

Code Select Expand

(set 's '(1 1 4 2 2 3 3 4 4 5 5 4 4 3 3 4 2 2 1 1))


What's the best way to remove - for example - the two pairs of 4 4? I can't use replace on a sequence of elements, apparently.



I don't want to do this:

Code Select Expand

(replace 4 s )
;-> (1 1 2 2 3 3 5 5 3 3 2 2 1 1)

because it loses the non-doubled ones.

[Sammo]

If the idea is to completely remove just the pair of 4s, the following works but I don't claim it's "the best way."

Code Select Expand

(define (remove-pair L A)
  (reverse (remove-pair-aux (first L) (rest L) A '())) )

(define (remove-pair-aux head tail atom result)
  (cond
    ( (empty? tail)
      (cons head result)
    )
    ( (!= head atom)
      (remove-pair-aux (first tail) (rest tail) atom (cons head result))
    )
    ( (= head (first tail))
      (remove-pair-aux (first (rest tail)) (rest (rest tail)) atom result)
    )
    ( true
      (remove-pair-aux (first tail) (rest tail) atom (cons head result))
    ) ))
Here's the same function expressed with newLisp's implicit indexing notation:

Code Select Expand

(define (remove-pair L A)
  (reverse (remove-pair-aux (L 0) (1 L) A '())) )

(define (remove-pair-aux head tail atom result)
  (cond
    ( (empty? tail)
      (cons head result)
    )
    ( (!= head atom)
      (remove-pair-aux (tail 0) (1 tail) atom (cons head result))
    )
    ( (= head (tail 0))
      (remove-pair-aux (tail 1) (2 tail) atom result)
    )
    ( true
      (remove-pair-aux (tail 0) (1 tail) atom (cons head result))
    ) ))
Here's an example:

Code Select Expand

(set 's '(1 1 4 2 2 3 3 4 4 5 5 4 4 3 3 4 2 2 1 1))
;-> (1 1 4 2 2 3 3 4 4 5 5 4 4 3 3 4 2 2 1 1)
(remove-pair s 4)
;-> (1 1 4 2 2 3 3 5 5 3 3 4 2 2 1 1)

;; edit 2006-03-26 9:55 a.m. MST to correct one type

[Sammo]

Here's a more general solution that allows you to remove adjacent "groups" of atoms (not just groups of two), and that let's you specify that you want to remove groups of N or larger.



We start by writing the function "grouper" to make lists of adjacent identical atoms in list L:

Code Select Expand

(define (grouper L)
  (reverse (grouper-aux (first L) (rest L) '())) )

(define (grouper-aux head tail result)
  (cond
    ( (= head nil)
      result
    )
    ( (empty? result)
      (grouper-aux (first tail) (rest tail) (cons (list head) result))
    )
    ( (member head (first result))
      (push head result 0 0)
      (grouper-aux (first tail) (rest tail) result)
    )
    ( true
      (grouper-aux (first tail) (rest tail) (cons (list head) result))
    ) ))
For example:

Code Select Expand

(set 's '(1 1 2 2 3 3 4 4 5 5 4 4 4 3 3 3 2 2 2 1 1 1))
;-> (1 1 2 2 3 3 4 4 5 5 4 4 4 3 3 3 2 2 2 1 1 1)
(grouper s)
;-> ((1 1) (2 2) (3 3) (4 4) (5 5) (4 4 4) (3 3 3) (2 2 2) (1 1 1))
And now a function to remove from list L groups of atom A of length N or greater:

Code Select Expand

(define (remove-groups L A N)
  (let
    ( result '() )
  ;body of let
    (dolist (sublist L)
      (if (or (!= (sublist 0) A) (< (length sublist) (or N 1)))
        (push sublist result -1)) )
  ;return from let
    result ))
Finally, an example that removes 4's of group length 3 or longer:

Code Select Expand

(set 's '(1 1 2 2 3 3 4 4 5 5 4 4 4 3 3 3 2 2 2 1 1 1))
(flat (remove-groups (grouper s) 4 3))
;-> (1 1 2 2 3 3 4 4 5 5 5 3 3 3 2 2 2 1 1 1)

[Lutz]

This looks like a job for 'match'

Code Select Expand


>  (set 's '(1 1 4 2 2 3 3 4 4 5 5 4 4 3 3 4 2 2 1 1))

>  (while (match '(* 4 4 *) s) (set 's (apply append (match '(* 4 4 *) s))))
(1 1 4 2 2 3 3 5 5 3 3 4 2 2 1 1)





Lutz

[Lutz]

... or even shorter faster:

Code Select Expand


> (set 's '(1 1 4 2 2 3 3 4 4 5 5 4 4 3 3 4 2 2 1 1))
(1 1 4 2 2 3 3 4 4 5 5 4 4 3 3 4 2 2 1 1)

>  (while (set 'L (match '(* 4 4 *) s)) (set 's (apply append L)))
(1 1 4 2 2 3 3 5 5 3 3 4 2 2 1 1)
>


Lutz

[cormullion]

Hey, Sammo, thanks for all the good code! Very useful stuff, and I started to work through it - then Lutz came up with an even better answer!