Page 1 of 1
Remove a sequence of elements from a list
Posted: Sun Mar 26, 2006 2:11 pm
by cormullion
Given a list with some doubled elements:
Code: Select all
(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 all
(replace 4 s )
;-> (1 1 2 2 3 3 5 5 3 3 2 2 1 1)
because it loses the non-doubled ones.
Posted: Sun Mar 26, 2006 4:44 pm
by 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 all
(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 all
(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 all
(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
Posted: Sun Mar 26, 2006 6:15 pm
by 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 all
(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 all
(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 all
(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 all
(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)
Posted: Sun Mar 26, 2006 6:32 pm
by Lutz
This looks like a job for 'match'
Code: Select all
> (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
Posted: Sun Mar 26, 2006 6:37 pm
by Lutz
... or even shorter faster:
Code: Select all
> (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
Posted: Mon Mar 27, 2006 8:56 am
by 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!