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>


[gile]

About speed,
IMO, it's just funny to compare LISP routines and most of the time the differences are minor. It become important if the routines are used in many iterations or recursive callings.
For example, the speed differences between command and entmake (entmod) or vla* functions realy doesn't mater while there're used with a user input.
More, if speed is the goal, we'd rather forget LISP and use other languages. We had a challenge here with "multi languages replys" and we can see .NET is about 2 times faster than LISP and C++ (ARX) about 10 times...

[Lee Mac]

Wow! Paul Kohut's version of C++ using pointers... 0.094 secs!!  Thats phenomenally quick...