Topic: Looking for a faster version of delete_nth, insert_nth and switch_nth

[terrycadd]

I have recently been very interested in your threads of modifying lists.
I have three functions which I wrote a long while back that can be improved upon to improve the speed of execution. Until I read your recent threads I always felt “If it’s not broke don’t fix it.”  Here are the three functions I am referring to.
* A delete nth or remove nth function.

Code: [Select]

;-------------------------------------------------------------------------------
; Delete_nth - Deletes the nth item from a list.
; Arguments: 2
;   Num# = Nth number in list to delete
;   OldList@ = List to delete the nth item
; Returns: A list with the nth item deleted.
;-------------------------------------------------------------------------------
(defun Delete_nth (Num# OldList@ / Cnt# Item NewList@)
  (if (and (= (type Num#) 'int)(= (type OldList@) 'list))
    (progn
      (setq Cnt# 0)
      (foreach Item OldList@
        (if (/= Cnt# Num#)
          (if NewList@
            (setq NewList@ (append NewList@ (list Item)))
            (setq NewList@ (list Item))
          );if
        );if
        (setq Cnt# (1+ Cnt#))
      );foreach
    );progn
    (setq NewList@ OldList@)
  );if
  NewList@
);defun Delete_nth
* A insert nth or add an nth function.

Code: [Select]

;-------------------------------------------------------------------------------
; Insert_nth - Inserts a new item value into the nth number in list.
; Arguments: 3
;   Num# = Nth number in list to insert item value
;   Value = Item value to insert
;   OldList@ = List to insert item value
; Returns: A list with the new item value inserted.
;-------------------------------------------------------------------------------
(defun Insert_nth (Num# Value OldList@ / Cnt# Item NewList@)
  (if (and (= (type Num#) 'int)(= (type OldList@) 'list))
    (progn
      (setq Cnt# 0)
      (foreach Item OldList@
        (if (= Cnt# Num#)
          (progn
            (if NewList@
              (setq NewList@ (append NewList@ (list Value)))
              (setq NewList@ (list Value))
            );if
            (if NewList@
              (setq NewList@ (append NewList@ (list Item)))
              (setq NewList@ (list Item))
            );if
          );progn
          (if NewList@
            (setq NewList@ (append NewList@ (list Item)))
            (setq NewList@ (list Item))
          );if
        );if
        (setq Cnt# (1+ Cnt#))
      );foreach
      (if (>= Num# (length OldList@))
        (if NewList@
          (setq NewList@ (append NewList@ (list Value)))
          (setq NewList@ (list Value))
        );if
      );if
    );progn
    (setq NewList@ OldList@)
  );if
  NewList@
);defun Insert_nth
* A switch nth or swap two nths function.

Code: [Select]

;-------------------------------------------------------------------------------
; Switch_nth - Switches the nth Num1# and Num2# item values in a list.
; Arguments: 3
;   Num1# = nth number in list to switch with nth Num2#
;   Num2# = nth number in list to switch with nth Num1#
;   OldList@ = List to switch item values
; Returns: A list with two item values switched.
;-------------------------------------------------------------------------------
(defun Switch_nth (Num1# Num2# OldList@ / Cnt# Item NewList@ NewValue Valid)
  (if (and (= (type Num1#) 'int)(= (type Num2#) 'int)(= (type OldList@) 'list))
    (setq Valid t)
  );if
  (if (and Valid (< Num1# (length OldList@))(< Num2# (length OldList@))
      (/= Num1# Num2#)
    );and
    (progn
      (setq Cnt# 0)
      (foreach Item OldList@
        (cond
          ((= Cnt# Num1#)(setq NewValue (nth Num2# OldList@)))
          ((= Cnt# Num2#)(setq NewValue (nth Num1# OldList@)))
          (t (setq NewValue Item))
        );cond
        (if NewList@
          (setq NewList@ (append NewList@ (list NewValue)))
          (setq NewList@ (list NewValue))
        );if
        (setq Cnt# (1+ Cnt#))
      );foreach
    );progn
    (setq NewList@ OldList@)
  );if
  NewList@
);defun Switch_nth
P.S. Also where can I find the mentioned BenchMark function?

[CAB]

To get the Benchmark.lsp

[CAB]

Well for remove you could convert this one

Code: [Select]

;;  CAB 12/27/2006
;;  (RemoveNth 3 '(0 1 2 3 4 5))
;;  (0 1 2 4 5)
(defun removeNth (i lst)
  (setq i (1+ i))
  (vl-remove-if '(lambda(x) (zerop (setq i (1- i)))) lst)
)To replace yours like this:

Code: [Select]

;-------------------------------------------------------------------------------
; Delete_nth - Deletes the nth item from a list.
; Arguments: 2
;   Num# = Nth number in list to delete
;   lst = List to delete the nth item
; Returns: A list with the nth item deleted.
;-------------------------------------------------------------------------------
(defun Delete_nth (i lst )
  (if (and (= (type i) 'int)
           (listp lst)
           (> (length lst) 0))
    (progn
      (setq i (1+ i))
      (vl-remove-if '(lambda(x) (zerop (setq i (1- i)))) lst)
    )
    lst
  )
);defun Delete_nth

Code: [Select]

(defun c:test()
  (print (Delete_nth 0 '(0 1 2 3 4 5 6 7)))
  (print (Delete_nth 4 '(0 1 2 3 4 5 6 7)))
  (print (Delete_nth 7 '(0 1 2 3 4 5 6 7)))
  (print (Delete_nth -1 '(0 1 2 3 4 5 6 7)))
  (print (Delete_nth 2.0 '(0 1 2 3 4 5 6 7)))
  (print (Delete_nth -1 nil))
  (princ)
)

Code: [Select]

Command: test

(1 2 3 4 5 6 7)
(0 1 2 3 5 6 7)
(0 1 2 3 4 5 6)
(0 1 2 3 4 5 6 7)
(0 1 2 3 4 5 6 7)
nil
Note that is you are testing for a list with this (= (type lst) 'list) a nil for lst will return true
so you need to test length as well with this (> (length lst) 0)

[CAB]

For the swap you could use this.
Did not add you additional error check.

Code: [Select]

;;  CAB 01/02/2007
;;  Swap i1 to i2 & i2 to i1 in list
(defun SwapNth (i1 i2 lst / idx)
  (setq idx -1)
  (if (and (< -1 i1 (length lst)) (< -1 i2 (length lst)))
    (mapcar '(lambda (x)
               (setq idx (1+ idx))
               (cond
                 ((= idx i2) (nth i1 lst))
                 ((= idx i1) (nth i2 lst))
                 (x)
               )
             )
      lst
    )
    lst ; reSwap this line if you want nil returned if out of range
  )
)

Code: [Select]

(defun c:test ()
  (print (SwapNth 3 1 '("a" "b" "c" "d" "e" "f")))
  (print (SwapNth 1 3 '("a" "b" "c" "d" "e" "f")))
  (print (SwapNth 0 4 '("a" "b" "c" "d" "e" "f")))
  (print (SwapNth 1 10 '("a" "b" "c" "d" "e" "f")))
  (print (SwapNth 10 1 '("a" "b" "c" "d" "e" "f")))
  (princ)
)

Code: [Select]

Command: test

("a" "d" "c" "b" "e" "f")
("a" "d" "c" "b" "e" "f")
("e" "b" "c" "d" "a" "f")
("a" "b" "c" "d" "e" "f")
("a" "b" "c" "d" "e" "f")

[terrycadd]

CAB,
I just got through testing your RemoveNth and SwapNth functions in this thread and they are incredibly fast.
Thanks,
Terry
P.S. I still looking for an insert_nth function.

[CAB]

Have  a look here:  http://www.theswamp.org/index.php?topic=1984.msg25655#msg25655

[CAB]

I think this will be the fastest routine. I lost track of where I got it though.

Code: [Select]

;; by Reni U.
;;; Insert atom in list at pos n
(defun insert (lst x n)
  (cond
    ((zerop n) (cons x lst))
    (T (cons (car lst) (insert (cdr lst) x (1- n))))))

[terrycadd]

CAB,
Thanks for your leads and tips. Here are the two versions that worked the fastest.
Both functions were modified to accept only nth positions between 0 and 1+ the length of the original list.
Insertnth is based upon the last Insert@ example, and Insert-nth is based upon the Insert example.

Code: [Select]

(defun Insertnth (pos item lst / tmp)
  (if (< -1 pos (1+ (length lst)))
    (progn
      (repeat pos
        (setq tmp (cons (car lst) tmp)
              lst (cdr lst)
        );setq
      );repeat
      (append (reverse tmp) (list item) lst)
    );progn
    lst
  );if
);defun

(defun Insert-nth (pos item lst)
  (if (< -1 pos (1+ (length lst)))
    (cond
      ((zerop pos) (cons pos lst))
      (t (cons (car lst)(Insert-nth (1- pos) item (cdr lst))))
    );cond
    lst
  );if
);defun