Topic: List Operation Driving me up the wall...

[Lee Mac]

Ok, I'm not normally the one to come asking for help without slaving over it myself... but this has been driving me up the wall.

I am in the process of making my TabSort.lsp program compatible with a multi-tab selection and have accomplished everything except for the "up" and "down" buttons - which have kept me puzzled all day...  

If I focus on the "Up" button, I can just reverse the process for the "Down" button...

So here is my dilemma:

I need to pass the function an index list of items to be moved, and for it to return a new list with those items moved.

The items at the specific indexes need to be moved "up" a position [to the (n-1)th position], but there are some exceptions.

I'll provide a few examples:

Say we have a list:

Code: [Select]

(setq lst '[color=red](0 1 2 3 4 5)[/color])

Code: [Select]

(list_up '(2 3) lst)  [color=navy]Returns:[/color] (0 [color=red]2 3[/color] 1 4 5)


Code: [Select]

(list_up '(0 3) lst) [color=navy] Returns:[/color] ([color=red]0[/color] 1 [color=red]3[/color] 2 4 5)


Code: [Select]

(list_up '(0 1 4 5) lst)  [color=navy]Returns:[/color]  ([color=red]0 1[/color] 2 [color=red]4 5[/color] 3)

As you can see from the examples, the elements need to move up, except when they are consecutively in positions 0 1 2 3... etc

I have had a stab at it, but I really am getting nowhere and its driving me c r a z y   :ugly:

Here is my attempt:

Code: [Select]

(defun List_up (ilst rlst)

  
  (defun Remove_nth (i lst / j)
    (setq j -1)
    (vl-remove-if
      (function
        (lambda (x)
          (eq i (setq j (1+ j))))) lst))
  

  (defun Put_j_at_i (j i lst / r lst)  
    (setq r (nth j lst) i (1+ i))
    (mapcar
      (function
        (lambda (x y)
          (cond ((zerop (setq i (1- i))) r)
                ((minusp i) y) (x))))
      lst (cons nil (remove_nth j lst))))

  (foreach x ilst
    (setq rlst
      (if (zerop x) rlst
        (cond ((vl-position (1- x) ilst) rlst)
              (Put_j_at_i x (1- x) rlst)))))

  rlst)

Any help/advice is appreciated,

Lee

[uncoolperson]

Code: [Select]

(defun reorder_up (item remainlist)
  (cond ((= item (car (cdr remainlist)))
(cons
item
(cons
(car remainlist)
(reorder_up item (cddr remainlist))
)))
(remainlist
(cons (car remainlist) (reorder_up item (cdr remainlist))))
  )
)

(defun multireorder_up (items alist)
  (foreach item items
    (setq alist (reorder item alist)))
  alist)

(defun multireorder_down (items alist)
  (reverse (multireorder_up item (reverse alist))))

(defun reorder_down (item alist)
  (reverse (reorder_up item (reverse alist))))

_$ (setq lst '(0 1 2 3 4 5))
(0 1 2 3 4 5)
_$ (reorder_up '(2 3) lst)
(0 1 2 3 4 5)
_$ (multireorder_up '(2 3) lst)
(0 2 3 1 4 5)
_$ (setq lst '(0 1 2 3 4 5))
(0 1 2 3 4 5)
_$ (multireorder_up '(2 3) lst)
(0 2 3 1 4 5)
_$ (multireorder_up '(0 3) lst)
(0 1 3 2 4 5)
_$ (multireorder_up '(0 1 4 5) lst)
(1 0 2 4 5 3)

didn't really read into the tabs thing, but had to have some fun

(scratch that, didn't like the last one)

[alanjt]

This is ugly, but I wanted to play.

Code: [Select]

(defun at_up (nL L / i L1 L2)
  (setq i -1)
  (foreach x L
    (or (member (setq i (1+ i)) nL)
        (setq L2 (cons x L2))
    ) ;_ or
  ) ;_ foreach
  (setq i -1)
  (foreach x nL
    (setq L1 (cons (nth x L) L1))
  ) ;_ foreach
  (append (reverse L1) (reverse L2))
) ;_ defun


[gile]

Something like this ?

Code: [Select]

(defun list_up (ind lst)
  (cond
    ((or (null ind) (null lst)) lst)
    ((= 0 (car ind))
     (cons (car lst) (list_up (cdr (mapcar '1- ind)) (cdr lst)))
    )
    ((= 1 (car ind))
     (cons (cadr lst) (list_up (cdr (mapcar '1- ind)) (cons (car lst) (cddr lst)))
     )
    )
    (T (cons (car lst) (list_up (mapcar '1- ind) (cdr lst))))
  )
)

[VovKa]

Something like this ?

sounds like a "dismissed!" command to me.
now i'm free to go to sleep
thanks, gile

ps it's cool

[Lee Mac]

Hey Guys,

Many thanks for all your responses - a lot to look at and dissect 

Gile - that is absolutely brilliant, works perfectly 

So, I spend all day (well, maybe not all day) racking my brain on this one, and within an hour or less, Mr Gile comes up with a perfect recursive solution... you guys still amaze me. 

Thanks,

Lee

[gile]

You're welcome, I had fun

[Lee Mac]

You're welcome, I had fun

I'm having fun trying to get my head around it 

[Maverick®]

I wonder where "drive up the wall" originated?

[Lee Mac]

Thanks Gile - I managed to make a list_down based on your example:

Code: [Select]

(defun list_down (ind lst)
  (reverse
    (list_up
      (reverse
        (mapcar
          (function
            (lambda (x)
              (- (1- (length lst)) x))) ind))
      (reverse lst))))


 

[gile]

Another way using an iterative (while) process avoid using a reverse on the result list (maybe a little faster with long lists)

Code: [Select]

(defun list_down (ind lst / len rslt)
  (setq len (length lst)
        ind (reverse (mapcar (function (lambda (x) (- len x))) ind))
        lst (reverse lst)
  )
  (while lst
    (cond
      ((= 1 (car ind))
       (setq ind (cdr (mapcar '1- ind))
             rslt (cons (car lst) rslt)
             lst  (cdr lst)
             )
       )
      ((= 2 (car ind))
       (setq ind  (cdr (mapcar '1- ind))
             rslt (cons (cadr lst) rslt)
             lst  (cons (car lst) (cddr lst))
       )
      )
      (T
       (setq ind  (mapcar '1- ind)
             rslt (cons (car lst) rslt)
             lst  (cdr lst)
       )
      )
    )
  )
  rslt
)

[Lee Mac]

I suppose the same logic could be applied to the list_up function?  I assume a While is faster than recursion...

[gile]

Yes, most of the time while is faster than recursion (on long lists)

But in list_up we don't need any reverse and the recursive callings stops when the index list is empty (the remaining list is returned "as is"). With a while statement, you have to continue the loop while the list is empty or use a call to append which is slow.
So if the greatest index is closed to to the last item of the list, a while statement should be a little faster otherwise it probably won't.

In all cases, if you're using these routines while an user input, the speed difference doesn't mean anything: the user will always be slower than the routine...

[Lee Mac]

Interesting stuff, thanks Gile.

I always find it interesting to know what functions/processes are faster than others, like, for instance: I use vl-position over member for pretty much everything, just for that small speed difference.

That said, I didn't realise that reverse was a slow process...

[Lee Mac]

Just for kicks, not sure if this is really a "valid" test, but:

Code: [Select]

(defun rev-erse (lst / x result)
  (while (setq x (car lst))
    (setq result (cons x result) lst (cdr lst)))
  result)

{ ^^ Best alternative to reverse I could think of }

Code: [Select]

  (setq lst '(0 1 2 3 4 5 6 7 8 9 0))

  (Benchmark
    '(
      (reverse lst)
      (rev-erse lst)
    )
  )


Code: [Select]

Elapsed milliseconds / relative speed for 32768 iteration(s):

    (REVERSE LST)......1810 / 1.47 <fastest>
    (REV-ERSE LST).....2652 / 1.00 <slowest>