Topic: -={Challenge}=- Shift items in a list (group/singluar)

[T.Willey]

I was trying to update one of my routines, and I wanted to edit the order of a list and I wanted it to be a single routine for in-/decrease the indexes.  I wanted the ability to move them by a group or singular.  It took me awhile to find a solution (not very elegant), and thought maybe people here would find it fun.  I'm sure you guys will come up with better versions of what I have.

The routine will take three arguments:
the amount of places to move
an ordered list of indexes (lowest to greatest)
the list to reorder.

If the indexes are consecutive, then they move as a group.

Code: [Select]

Command: !lst
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)

Command: (func_move 4 '(0 5 6 11 12 13) lst)
(1 2 3 4 0 7 8 9 10 5 6 14 15 16 17 11 12 13 18 19)

Command: (func_move 1 '(0 5 6 11 12 13) lst)
(1 0 2 3 4 7 5 6 8 9 10 14 11 12 13 15 16 17 18 19)

Command: (func_move -1 '(1 5 6 11 12 13) lst)
(1 0 2 3 5 6 4 7 8 9 11 12 13 10 14 15 16 17 18 19)

Command: (func_move -2 '(2 5 6 11 12 13) lst)
(2 0 1 5 6 3 4 7 8 11 12 13 9 10 14 15 16 17 18 19)

Command: (func_move -1 '(1 2 3 4) '("a" "b" "c" "d" "e" "f"))
("b" "c" "d" "e" "a" "f")

Mine has no error checking, but if the first index is 0 then it will only increase the indexes, same as if the last index is equal to one-less then the length of the list; only decrease.

[irneb]

Question1: Can it be assumed that the list of indexes are always sorted? Or must the routine ensure it's sorted?
Question2: Is the list of indexes deemed the index before any insertions happened, as in an index of 5 after a 2 actually the new index 6? Or is that 5 actually the old index position 4?

[T.Willey]

Question1: Can it be assumed that the list of indexes are always sorted? Or must the routine ensure it's sorted?

They are always sorted.

Question2: Is the list of indexes deemed the index before any insertions happened, as in an index of 5 after a 2 actually the new index 6? Or is that 5 actually the old index position 4?

The indexes passed to the code are the indexes to be moved.

In my example the returned list of the reordered list of items, that is why I added one at the end that shows a list of strings before and after the function is ran on it.  Hope that clears some things up.

[Grrr1337]

Well I had the same thought few days ago, so I wrote this:

Code: [Select]

; Shift list with grread - move items one position to the "Left" or to the "Right" :
(defun C:test ( / *error* Lst SysVars LoopFlag UserIn TypeUserIn ReturnChar )

(or ; the starting list - experiment with one of these
; (setq Lst (list "A" "B" "C" "D" "E" "F"))
(setq Lst (list 1 2 3 4 5 6))
)

(defun *error* (msg)
(if SysVars
(mapcar
(function (lambda (a b) (setvar a b)))
(mapcar 'car SysVars)
(mapcar 'cadr SysVars)
)
); if
(princ)
)

(setq SysVars
(mapcar
(function (lambda (x) (list x (getvar x))))
(list 'CMDECHO 'CLIPROMPTLINES )
)
)
(mapcar
(function (lambda (a b) (setvar a b)))
(mapcar 'car SysVars)
(list 0 3)
)

(princ "\nPress [A/D] to Shift the list or e[X]it: ")
(print Lst)
(setq LoopFlag T)
(while LoopFlag
(setq
UserIn (grread T)
TypeUserIn (car UserIn)
ReturnChar (cadr UserIn)
); setq
(cond
((and (= TypeUserIn 2)(= ReturnChar (ascii (strcase "A" T))))
(princ "\nPress [A/D] to Shift the list or e[X]it: ")
(setq Lst (ShiftListLeft Lst))
(princ "\n\"A\" key is pressed, shifting the list to the Left: \n")
(print Lst)
)
((and (= TypeUserIn 2)(= ReturnChar (ascii (strcase "D" T))))
(princ "\nPress [A/D] to Shift the list or e[X]it: ")
(setq Lst (ShiftListRight Lst))
(princ "\n\"D\" key is pressed, shifting the list to the Right: \n")
(print Lst)
)
((and (= TypeUserIn 2)(= ReturnChar (ascii (strcase "X" T))))
(princ "\nExiting! Final list is: \n")
(print Lst)
(setq LoopFlag nil)
)
(T nil)
); cond
); while LoopFlag
(mapcar
(function (lambda (a b) (setvar a b)))
(mapcar 'car SysVars)
(mapcar 'cadr SysVars)
)

(princ)
); defun


(defun ShiftListRight ( Lst / nLst )
(if (listp Lst)
(setq nLst (append (list (last Lst)) (reverse (cdr (reverse Lst)))))
)
)
(defun ShiftListLeft ( Lst / nLst )
(if (listp Lst)
(setq nLst (append (cdr Lst) (list (car Lst))))
)
)EDIT: Just wanted to make clear:
The "grread" stuff is a template, which I use often, it was posted by fixo, who wrote that the original author is CAB.
About the Shift* functions, I think I took some list-assembling code fragment from Lee Mac, and modified it to perform this "shifting" 1 position to the left/right.
So overall this code is 1 huge assembly, which can be used as a template for something useful.

[Lee Mac]

The following is based on a function by gile:

Code - Auto/Visual Lisp: [Select]

1. (defun foo ( dsp idx lst / len )
2.     (cond
3.         (   (zerop  dsp) lst)
4.         (   (minusp dsp) (foo (1+ dsp) (mapcar '1- idx) (bar idx lst)))
5.         (   (setq len (length lst))
6.             (reverse (foo (- dsp) (reverse (mapcar '(lambda ( x ) (- len x 1)) idx)) (reverse lst)))
7.         )
8.     )
9. )
10. (defun bar ( idx lst )
11.     (cond
12.         (   (not (and idx lst)) lst)
13.         (   (> 1 (car idx)) (cons (car  lst) (bar (mapcar '1- (cdr idx)) (cdr lst))))
14.         (   (= 1 (car idx)) (cons (cadr lst) (bar (mapcar '1- (cdr idx)) (cons (car lst) (cddr lst)))))
15.         (   (cons (car lst) (bar (mapcar '1- idx) (cdr lst))))
16.     )
17. )

Code - Auto/Visual Lisp: [Select]

1. _$ (foo -2 '(2 3) '(0 1 2 3 4 5))
2. (2 3 0 1 4 5)
3. _$ (foo 2 '(2 3) '(0 1 2 3 4 5))
4. (0 1 4 5 2 3)
5. _$ (foo -1 '(2 4) '(0 1 2 3 4 5))
6. (0 2 1 4 3 5)
7. _$ (foo 1 '(2 4) '(0 1 2 3 4 5))
8. (0 1 3 2 5 4)

Though I doubt that the above is an overall efficient method for this operation.

[Lee Mac]

Another:

Code - Auto/Visual Lisp: [Select]

1. (defun foo ( dsp idx lst )
2.     (if (< 0 dsp)
3.         (reverse (foo (- dsp) (reverse (mapcar '(lambda ( x ) (- (length lst) x 1)) idx)) (reverse lst)))
4.         (bar dsp idx lst)
5.     )
6. )
7. (defun bar ( dsp idx lst )
8.     (cond
9.         (   (not (and idx lst)) lst)
10.         (   (> 1 (+ (car idx) dsp)) (cons (nth (car idx) lst) (bar dsp (mapcar '1- (cdr idx)) (baz (car idx) lst))))
11.         (   (cons (car lst) (bar dsp (mapcar '1- idx) (cdr lst))))
12.     )
13. )
14. (defun baz ( idx lst )
15.     (if lst
16.         (if (< 0 idx)
17.             (cons (car lst) (baz (1- idx) (cdr lst)))
18.             (cdr lst)
19.         )
20.     )
21. )

Code - Auto/Visual Lisp: [Select]

1. _$ (foo -2 '(2 3) '(0 1 2 3 4 5))
2. (2 3 0 1 4 5)
3. _$ (foo -1 '(2 3) '(0 1 2 3 4 5))
4. (0 2 3 1 4 5)
5. _$ (foo  1 '(2 3) '(0 1 2 3 4 5))
6. (0 1 4 2 3 5)
7. _$ (foo  2 '(2 3) '(0 1 2 3 4 5))
8. (0 1 4 5 2 3)
9. _$ (foo  2 '(2 4) '(0 1 2 3 4 5))
10. (0 1 3 5 2 4)

[T.Willey]

Nice Lee!

I remember now why I stopped trying to make short code with you recursive masters.  I will have to study this and see how it works.

Here is my non-recursive function.

Code: [Select]

(defun func_move ( amnt idxs items / countconsec
                                     cnt len nidxs glist pos grp idx lst )
    (defun countconsec ( idxs / cnt len num grp tnum glist )
        (setq cnt 0)
        (setq len (length idxs))
        (while (< cnt len)
            (setq num (nth cnt idxs))
            (setq grp 1)
            (while (equal (setq tnum (nth (+ cnt grp) idxs)) (+ num grp))
                (setq grp (+ grp 1))
            )
            (repeat grp (setq glist (cons grp glist)))
            (setq cnt (+ cnt grp))
        )
        (reverse glist)
    )
    ;------------------------------------------------------------
    (setq cnt 0)
    (setq len (length items))
    (setq nidxs (mapcar (function (lambda (x) (+ x amnt))) idxs))
    (setq glist (countconsec idxs))
    (while (< cnt len)
        (cond
            ((setq pos (vl-position cnt nidxs))
                (setq grp (nth pos glist))
                (setq idx (nth pos idxs))
                (repeat grp
                    (setq lst (cons idx lst))
                    (setq idx (+ idx 1))
                )
                (repeat (abs amnt)
                    (setq lst (cons cnt lst))
                    (setq cnt (+ cnt 1))
                )
                (setq cnt (+ cnt grp))
            )
            ((setq pos (vl-position cnt idxs))
                (setq grp (nth pos glist))
                (repeat (abs amnt)
                    (setq lst (cons (+ cnt grp) lst))
                    (setq cnt (+ cnt 1))
                )
                (setq idx (nth pos idxs))
                (repeat grp
                    (setq lst (cons idx lst))
                    (setq idx (+ idx 1))
                )
                (setq cnt (+ cnt grp))
            )
            (t
                (setq lst (cons cnt lst))
                (setq cnt (+ cnt 1))
            )
        )
    )
    (mapcar (function (lambda (x) (nth x items))) (reverse lst))
)


[Grrr1337]

Sorry for bumping up this thread, but recently I was browsing this:
http://www.lee-mac.com/listboxfunctions.html
and I felt it belongs to this thread, since it seems the most "flexible" way for manual reposition of a items in a list.