Nice function to shift around elements in a list?

Leslie P. Polzer

unread,

Dec 16, 2008, 7:14:08 AM12/16/08

to

I'm looking for a nice way to achieve movement of list elements by a
certain offset:

(defparameter list (list 'a 'b 'c 'd 'e))

(move 'c list -1) => (list 'a 'c 'b 'd 'e)
(move 'c list +2) => (list 'a 'b 'd 'e 'c)
(move 'a list -1) => (list 'a 'b 'c 'd 'e)
(move 'e list +5) => (list 'a 'b 'c 'd 'e)

Thanks in advance for any elegant solution. :)

Leslie

kod...@eurogaran.com

unread,

Dec 16, 2008, 9:11:22 AM12/16/08

to

The most elegant solution is to use the data representation that is
most adequate to the task at hand.

Have you thought about using vectors instead of lists?

budden

unread,

Dec 16, 2008, 9:14:15 AM12/16/08

to

Looks a bit like this:
http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/b00bf5a637d5dfdf?hl=en#

your $4 hour cl freelancer

Alexander Lehmann

unread,

Dec 16, 2008, 9:21:37 AM12/16/08

to

(defun move (sym lst offset)
(let* ((pos (position sym lst))
(new-pos (mod (+ pos offset) (length lst)))
(stripped-lst (remove sym lst :count 1)))
(append (subseq stripped-lst 0 new-pos)
(cons sym (subseq stripped-lst new-pos)))))

I don't think that this is the most elegant solution, yet it seems to
work ;-)

Leslie P. Polzer

unread,

Dec 16, 2008, 9:26:45 AM12/16/08

to

> The most elegant solution is to use the data representation that is
> most adequate to the task at hand.
>
> Have you thought about using vectors instead of lists?

What difference would that make to solve the problem at hand?

In fact one might well come up with a version that works for
all sequences.

Madhu

unread,

Dec 16, 2008, 9:27:17 AM12/16/08

to

* "Leslie P. Polzer"
Wrote on Tue, 16 Dec 2008 04:14:08 -0800 (PST):

In future please post your best attempt so far when asking for
alternatives.

AFAIC Lisp's elegance in dealing with lists is in using lisps' list
manipulation functions.

(defun move (elem list offset)
(let* ((cons (member elem list))
(head (ldiff list cons)))
(if (plusp offset)
(let ((tail (nthcdr (1+ offset) cons)))
(nconc head (cdr (ldiff cons tail)) (list elem) tail))
(let ((tail (nthcdr (+ (length head) offset) head)))
(append (ldiff head tail) (list elem) tail (cdr cons))))))

--
Madhu

Leslie P. Polzer

unread,

Dec 16, 2008, 9:29:38 AM12/16/08

to

On Dec 16, 3:14 pm, budden <budden-l...@mail.ru> wrote:
> Looks a bit like this:http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/b0...

I'm not sure how well that would map to this one.

Leslie P. Polzer

unread,

Dec 16, 2008, 10:06:18 AM12/16/08

to

On Dec 16, 3:21 pm, Alexander Lehmann <lehma...@in.tum.de> wrote:

> (defun move (sym lst offset)
> (let* ((pos (position sym lst))
> (new-pos (mod (+ pos offset) (length lst)))
> (stripped-lst (remove sym lst :count 1)))
> (append (subseq stripped-lst 0 new-pos)
> (cons sym (subseq stripped-lst new-pos)))))
>
> I don't think that this is the most elegant solution, yet it seems to
> work ;-)

It does, almost:

* (move 'a (list 'a 'b 'c) -1)

=> (B C A)

Leslie P. Polzer

unread,

Dec 16, 2008, 12:49:20 PM12/16/08

to

On Dec 16, 3:27 pm, Madhu <enom...@meer.net> wrote:

> AFAIC Lisp's elegance in dealing with lists is in using lisps' list
> manipulation functions.
>
> (defun move (elem list offset)
> (let* ((cons (member elem list))
> (head (ldiff list cons)))
> (if (plusp offset)
> (let ((tail (nthcdr (1+ offset) cons)))
> (nconc head (cdr (ldiff cons tail)) (list elem) tail))
> (let ((tail (nthcdr (+ (length head) offset) head)))
> (append (ldiff head tail) (list elem) tail (cdr cons))))))

This doesn't work for me either when moving beyond the list head
(tail seems to work, though):

(move 'a (list 'a 'b 'c) -2)
The value -2 is not of type UNSIGNED-BYTE.

Thomas A. Russ

unread,

Dec 16, 2008, 2:48:37 PM12/16/08

to

"Leslie P. Polzer" <leslie...@gmx.net> writes:

> It does, almost:
>
> * (move 'a (list 'a 'b 'c) -1)
>
> => (B C A)

I think it was assumed you wanted wrap-around. Looking at the initial
examples, however, it seems you don't want that. So, interpreting the
specification you had in mind (but never directly expressed), I assume
that you never move anything past the ends of the list.

So a minor tweak to Alexander's code to calculate NEW-POS differently
gives you what you want.

(defun move (sym lst offset)
(let* ((pos (position sym lst))

(len (length lst))
(new-pos (max 0 (min (+ pos offset) (1- len))))

(stripped-lst (remove sym lst :count 1)))
(append (subseq stripped-lst 0 new-pos)
(cons sym (subseq stripped-lst new-pos)))))

--
Thomas A. Russ, USC/Information Sciences Institute

William James

unread,

Dec 16, 2008, 4:48:24 PM12/16/08

to

Thomas A. Russ wrote:

Ruby:

# Destructive (changes original list).
def move el, list, offset
from = list.index(el)
to = from + offset
0 <= to and to < list.size and list.delete(el) and
list.insert(to, el)
end

Madhu

unread,

Dec 16, 2008, 8:14:19 PM12/16/08

to

* "Leslie P. Polzer"
Wrote on Tue, 16 Dec 2008 09:49:20 -0800 (PST):

^^^^^ WTF are these non-whitespace characters that google introduces in
transit?

|> (let ((tail (nthcdr (+ (length head) offset) head)))
|> (append (ldiff head tail) (list elem) tail (cdr cons))))))
|
| This doesn't work for me either when moving beyond the list head
| (tail seems to work, though):

Becasuse moving beyound the list head makes no sense?
What meaning could it possibly have for a proper list?

| (move 'a (list 'a 'b 'c) -2)
| The value -2 is not of type UNSIGNED-BYTE.

The case is errenous input, and the program correctly signals an error.

--
Madhu

Madhu

unread,

Dec 16, 2008, 8:51:17 PM12/16/08

to

* (Thomas A. Russ) <ymitz93...@blackcat.isi.edu> :
Wrote on 16 Dec 2008 11:48:37 -0800:

[Sorry I did not notice this post before sending the replying saying
moving off the head of the list was incorrect behaviour]

I think the problem was not correctly specified, which is why I also
request the OP to supply best attempt before asking for alternatives as
it would help clarify the behaviour sought.

I assume the OP wants the wraparound behaviour at the list too.

| So a minor tweak to Alexander's code to calculate NEW-POS differently
| gives you what you want.

I think this approach to wraparound is not so good. Effectively OFFSET
would be working on a circular list.

What would you want fo if you have a list of 3 elements and OFFSET is
-200?

IMO, the designer of the MOVE routine ought to bound (OFFSET + position)
to lie WITHIN the list, and sanitize the value before calling the
routine.

If you have an INITIAL-OFFSET which moves you off the list, you can
compute

OFFSET = POSITION - (MOD (+ INITIAL-OFFSET POSITION) (LENGTH LIST))

i.e.

(setq offset
(let ((position (position elem list))
(length (length list)))
(- position (mod (+ offset position) length))))

Then you could use the pass this OFFSET to the posted MOVE routine.
[This appears to be cleaner to my eyes. Does this work ?]

--
Madhu

Madhu

unread,

Dec 16, 2008, 8:57:02 PM12/16/08

to

[Some corrections, until I get into the habit of proofreading before
sending...]

* Madhu <m3r6476...@moon.robolove.meer.net> :
Wrote on Wed, 17 Dec 2008 07:21:17 +0530:

| IMO, the designer of the MOVE routine ought to bound (OFFSET + position)
| to lie WITHIN the list, and sanitize the value before calling the
| routine.
|
| If you have an INITIAL-OFFSET which moves you off the list, you can
| compute
|
| OFFSET = POSITION - (MOD (+ INITIAL-OFFSET POSITION) (LENGTH LIST))

^^^

OFFSET = (MOD (+ INITIAL-OFFSET POSITION) (LENGTH LIST)) - POSITION

^^^
(- (mod (+ offset position) length) position)

--
Madhu

Leslie P. Polzer

unread,

Dec 17, 2008, 7:22:50 AM12/17/08

to

> What would you want fo if you have a list of 3 elements and OFFSET is
> -200?
>
> IMO, the designer of the MOVE routine ought to bound (OFFSET + position)
> to lie WITHIN the list, and sanitize the value before calling the
> routine.

Yes, that's an interesting consideration. I didn't worry about it
because I expect to call it with only either -1 or +1.

Personally I would not expect the caller to get this right, though.

I would insert a sanitizer at the beginning of the fun.

> Then you could use the pass this OFFSET to the posted MOVE routine.
> [This appears to be cleaner to my eyes. Does this work ?]

I haven't checked it but it should be easy to put this through
a modulo and get the correct value.

Leslie

Szymon 'tichy'

unread,

Dec 17, 2008, 2:00:47 PM12/17/08

to

(defparameter *list* (copy-list '()))

(loop for symbol in '(< * >) do
(loop for i from -8 upto 8 do
(format t "~&~2D: ~A" i (move symbol *list* i)))
(terpri) (terpri))

-8: ()
-7: ()
-6: ()
-5: ()
-4: ()
-3: ()
-2: ()
-1: ()
0: ()
1: (B < C D * E F G >)
2: (B C < D * E F G >)
3: (B C D < * E F G >)
4: (B C D * < E F G >)
5: (B C D * E < F G >)
6: (B C D * E F < G >)
7: (B C D * E F G < >)
8: (B C D * E F G > <)

-8: (* )
-7: (* )
-6: (* )
-5: (* )
-4: (* )
-3: (< * B C D E F G >)
-2: ()
-1: ()
0: ()
1: ()
2: ()
3: ()
4: ( *)
5: ( *)
6: ( *)
7: ( *)
8: ( *)

-8: (> B C D * E F G)
-6: ( C D * E F G)
-5: ( D * E F G)
-4: ( * E F G)
-3: ( E F G)
-2: ( F G)
-1: ( G)
0: ()
1: ()
2: ()
3: ()
4: ()
5: ()
6: ()
7: ()
8: ()

;; elegant part

(defun move (item list n &key (key #'identity) (test #'eql))
(%destrucive-move item (copy-list list) n key test))

;; gross ;)

(defun %ncdr (n list)
(loop with tail = list
repeat n
for next = (cdr tail)
do (if next (setq tail next) (loop-finish))
finally (return tail)))

(defun %destrucive-move (item list n key test &aux (orig list) (last list))
(unless list (return-from %destrucive-move))
(cond ((plusp n)
(if (funcall test item (funcall key (car list)))
(let* ((first orig)
(temp (%ncdr n orig))
(temp1 (cdr temp)))
(setq orig (cdr orig))
(rplacd temp first)
(rplacd first temp1))
(loop
(when (or (null list)
(funcall test item (funcall key (car list))))
(unless (cdr list) (return))
(let* ((item-cons list)
(temp (%ncdr n list))
(cdrtemp (cdr temp)))
(rplacd last (cdr list))
(rplacd temp item-cons)
(rplacd item-cons cdrtemp))
(return))
(unless (eq list orig)
(setq last (cdr last)))
(setq list (cdr list)))))
((minusp n)
(let ((counter -1) (n (abs n)) (place list))
(loop
(when (> counter n) (setq place (cdr place)))
(when (or (null list)
(funcall test item (funcall key (car list))))
(unless (> counter -1) (return))
(let ((item-cons list))
(rplacd last (cdr item-cons))
(rplacd item-cons (cdr place))
(rplacd place item-cons))
(when (< counter n)
(rotatef (car orig) (cadr orig)))
(return))
(unless (eq list orig)
(setq last (cdr last)))
(setq list (cdr list))
(incf counter)))))
orig)

.