让VL-POSITION返回多个索引

newer · 发表于 2017-5-15 09:38:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 newer 于 2017-5-16 20:46 编辑

我们知道，vl-position函数只能返回第一个找到元素的索引

比如：

命令: (vl-position 1 '(1 3 2 4 1 4 1))
0

我们自己写个函数 vl-positions , 能返回多个索引，比如上面的：

命令: (vl-positions 1 '(1 3 2 4 1 4 1))
(0 4 6)

抛砖引玉，我来一个：

(defun vl-positions1 ( x l / i )
(setq i -1)
(vl-remove nil (mapcar '(lambda ( y ) (setq i (1+ i)) (if (= x y) i)) l))
)

_$ (vl-positions1 1 '(1 3 2 4 1 4 1))
(0 4 6)
_$

附测试效率代码(xd::benchmark函数，需加载晓东通用LISP函数库2017.0518+版本）：

(defun vl-positions1 (x l / i)
(setq i -1)
(vl-remove nil
(mapcar '(lambda (y)
(setq i (1+ i))
(if (= x y)
i
)
)
l
)
)
)
(defun vl-positions2 (x l / I NEW Y)
(setq i -1)
(mapcar '(lambda (y)
(setq i (1+ i))
(if (= x y)
(setq New (cons i New))
)
)
l
)
(if New
(reverse New)
)
)
(defun vl-positions3 (x l / p)
(if (setq p (vl-positions3 x l))
(cons p
(mapcar
'(lambda (y)
(+ 1 p y)
)
(vl-positions3 x (cdr (member x l)))
)
)
)
)
(defun vl-positions4 (m l / a ll)
(setq a -1)
(foreach n l
(and
(setq a (1+ a))
(= m n)
(setq ll (cons a ll))
)
)
(reverse ll)
)
(defun vl-positions5 (itm lst / idn nlst)
(setq idx -1)
(while (< (setq idx (1+ idx))
(length lst)
)
(and
(= itm (nth idx lst))
(setq nlst (cons idx nlst))
)
)
(reverse nlst)
)
(defun vl-positions6 (m l / a b ll)
(while
(setq a (vl-position m l))
(setq l (cdr (member m l))
ll (cons (if (setq b (car ll))
(+ 1 a b)
a
)
ll
)
)
)
(reverse ll)
)
(defun vl-positions7 (m l / a b ll)
(setq a (vl-position m l)
ll (cons a ll)
l (cdr (member m l))
)
(while
(setq a (vl-position m l))
(setq l (cdr (member m l))
ll (cons (+ 1 a (car ll)) ll)
)
)
(reverse ll)
)
(defun vl-positions8 (n l / i j r)
(setq j -1)
(while
(setq i (vl-position n l))
(setq r (cons (setq j (+ 1 i j)) r))
(setq l (cdr (member n l)))
)
(reverse r)
)
(defun vl-position8 (n l / i ll)
(setq i 0)
(foreach x l
(if (eq x n)
(setq ll (cons i ll))
)
(setq i (1+ i))
)
(reverse ll)
)
(defun vl-positions9 (n l / i j r)
(setq j -1)
(while
(setq i (vl-position n l))
(setq r (cons (setq j (+ 1 i j)) r))
(setq l (cdr (member n l)))
)
(reverse r)
)
(defun vl-positions10 (l lst / n la ns)
(setq n 0
la (car lst)
)
(if (= la l)
(setq ns (cons n ns))
)
(while (setq lst (cdr lst))
(setq la (car lst)
n (1+ n)
)
(if (= la l)
(setq ns (cons n ns))
)
)
(reverse ns)
)
(defun vl-positions11 (a lst)
(setq i -1)
(setq flst
(vl-remove 0
(mapcar '*
(mapcar '(lambda (x)
(if (= a x)
1
0
)
)
lst
)
(mapcar '(lambda (y) (setq i (+ i 1))) lst)
)
)
)
(if (= a (car lst))
(setq flst (cons 0 flst))
)
flst
)
(defun c:test ()
(setq lst '(1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4))
(xd::benchmark
'((vl-positions1 1 lst)
(vl-positions2 1 lst)
(vl-positions4 1 lst)
(vl-positions5 1 lst)
(vl-positions6 1 lst)
(vl-positions7 1 lst)
(vl-positions8 1 lst)
(vl-positions9 1 lst)
(vl-positions10 1 lst)
(vl-positions11 1 lst)
)
)
(princ)
)

(defun vl-positions1 (x l / i) 
  (setq i -1) 
  (vl-remove nil 
             (mapcar '(lambda (y) 
                        (setq i (1+ i)) 
                        (if (= x y) 
                          i 
                        ) 
                      ) 
                     l 
             ) 
  ) 
) 
(defun vl-positions2 (x l / I NEW Y) 
  (setq i -1) 
  (mapcar '(lambda (y) 
             (setq i (1+ i)) 
             (if (= x y) 
               (setq New (cons i New)) 
             ) 
           ) 
          l 
  ) 
  (if New 
    (reverse New) 
  ) 
) 
(defun vl-positions3 (x l / p) 
  (if (setq p (vl-positions3 x l)) 
    (cons p 
          (mapcar 
            '(lambda (y) 
               (+ 1 p y) 
             ) 
            (vl-positions3 x (cdr (member x l))) 
          ) 
    ) 
  ) 
) 
(defun vl-positions4 (m l / a ll) 
  (setq a -1) 
  (foreach n l 
    (and 
      (setq a (1+ a)) 
      (= m n) 
      (setq ll (cons a ll)) 
    ) 
  ) 
  (reverse ll) 
) 
(defun vl-positions5 (itm lst / idn nlst) 
  (setq idx -1) 
  (while (< (setq idx (1+ idx)) 
            (length lst) 
         ) 
    (and 
      (= itm (nth idx lst)) 
      (setq nlst (cons idx nlst)) 
    ) 
  ) 
  (reverse nlst) 
) 
(defun vl-positions6 (m l / a b ll) 
  (while 
    (setq a (vl-position m l)) 
     (setq l  (cdr (member m l)) 
           ll (cons (if        (setq b (car ll)) 
                      (+ 1 a b) 
                      a 
                    ) 
                    ll 
              ) 
     ) 
  ) 
  (reverse ll) 
) 
(defun vl-positions7 (m l / a b ll) 
  (setq        a  (vl-position m l) 
        ll (cons a ll) 
        l  (cdr (member m l)) 
  ) 
  (while 
    (setq a (vl-position m l)) 
     (setq l  (cdr (member m l)) 
           ll (cons (+ 1 a (car ll)) ll) 
     ) 
  ) 
  (reverse ll) 
) 
(defun vl-positions8 (n l / i j r) 
  (setq j -1) 
  (while 
    (setq i (vl-position n l)) 
     (setq r (cons (setq j (+ 1 i j)) r)) 
     (setq l (cdr (member n l))) 
  ) 
  (reverse r) 
) 
(defun vl-position8 (n l / i ll) 
  (setq i 0) 
  (foreach x l 
    (if        (eq x n) 
      (setq ll (cons i ll)) 
    ) 
    (setq i (1+ i)) 
  ) 
  (reverse ll) 
) 
(defun vl-positions9 (n l / i j r) 
  (setq j -1) 
  (while 
    (setq i (vl-position n l)) 
     (setq r (cons (setq j (+ 1 i j)) r)) 
     (setq l (cdr (member n l))) 
  ) 
  (reverse r) 
) 
(defun vl-positions10 (l lst / n la ns) 
  (setq        n  0 
        la (car lst) 
  ) 
  (if (= la l) 
    (setq ns (cons n ns)) 
  ) 
  (while (setq lst (cdr lst)) 
    (setq la (car lst) 
          n  (1+ n) 
    ) 
    (if        (= la l) 
      (setq ns (cons n ns)) 
    ) 
  ) 
  (reverse ns) 
) 
(defun vl-positions11 (a lst) 
  (setq i -1) 
  (setq        flst 
         (vl-remove 0 
                    (mapcar '* 
                            (mapcar '(lambda (x) 
                                       (if (= a x) 
                                         1 
                                         0 
                                       ) 
                                     ) 
                                    lst 
                            ) 
                            (mapcar '(lambda (y) (setq i (+ i 1))) lst) 
                    ) 
         ) 
  ) 
  (if (= a (car lst)) 
    (setq flst (cons 0 flst)) 
  ) 
  flst 
) 
(defun c:test () 
  (setq lst '(1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4)) 
  (xd::benchmark 
    '((vl-positions1 1 lst) 
      (vl-positions2 1 lst) 
      (vl-positions4 1 lst) 
      (vl-positions5 1 lst) 
      (vl-positions6 1 lst) 
      (vl-positions7 1 lst) 
      (vl-positions8 1 lst) 
      (vl-positions9 1 lst) 
      (vl-positions10 1 lst) 
      (vl-positions11 1 lst) 
     ) 
  ) 
  (princ) 
)

aimisiyou 发表于 2017-5-16 14:20

加入vl-positions11测试结果

命令: (repeat 5 (c:test))
Elapsed milliseconds / relative speed for 32768 iteration(s):
(VL-POSITIONS7 1 LST)......1437 / 2.76 <fastest>
(VL-POSITIONS9 1 LST)......1609 / 2.47
(VL-POSITIONS6 1 LST)......1625 / 2.44
(VL-POSITIONS10 1 LST).....1671 / 2.38
(VL-POSITIONS8 1 LST)......1859 / 2.14
(VL-POSITIONS1 1 LST)......1938 / 2.05
(VL-POSITIONS2 1 LST)......1968 / 2.02
(VL-POSITIONS4 1 LST)......1984 / 2
(VL-POSITIONS5 1 LST)......2156 / 1.84
(VL-POSITIONS11 1 LST).....3969 / 1 <slowest>
Elapsed milliseconds / relative speed for 32768 iteration(s):
(VL-POSITIONS6 1 LST).......1985 / 8.45 <fastest>
(VL-POSITIONS8 1 LST).......2172 / 7.72
(VL-POSITIONS7 1 LST).......2250 / 7.45
(VL-POSITIONS4 1 LST).......2406 / 6.97
(VL-POSITIONS2 1 LST).......2860 / 5.86
(VL-POSITIONS5 1 LST).......2938 / 5.71
(VL-POSITIONS1 1 LST).......3047 / 5.5
(VL-POSITIONS9 1 LST).......3703 / 4.53
(VL-POSITIONS10 1 LST)......6687 / 2.51
(VL-POSITIONS11 1 LST).....16765 / 1 <slowest>
Elapsed milliseconds / relative speed for 32768 iteration(s):
(VL-POSITIONS6 1 LST)......1735 / 2.22 <fastest>
(VL-POSITIONS8 1 LST)......1906 / 2.02
(VL-POSITIONS9 1 LST)......2000 / 1.92
(VL-POSITIONS7 1 LST)......2016 / 1.91
(VL-POSITIONS10 1 LST).....2203 / 1.74
(VL-POSITIONS4 1 LST)......2297 / 1.67
(VL-POSITIONS5 1 LST)......2407 / 1.6
(VL-POSITIONS2 1 LST)......2672 / 1.44
(VL-POSITIONS1 1 LST)......2766 / 1.39
(VL-POSITIONS11 1 LST).....3844 / 1 <slowest>
Elapsed milliseconds / relative speed for 32768 iteration(s):
(VL-POSITIONS7 1 LST)......1375 / 2.64 <fastest>
(VL-POSITIONS8 1 LST)......1406 / 2.58
(VL-POSITIONS9 1 LST)......1531 / 2.37
(VL-POSITIONS6 1 LST)......1594 / 2.27
(VL-POSITIONS4 1 LST)......2000 / 1.81
(VL-POSITIONS10 1 LST).....2016 / 1.8
(VL-POSITIONS5 1 LST)......2500 / 1.45
(VL-POSITIONS2 1 LST)......2531 / 1.43
(VL-POSITIONS1 1 LST)......2859 / 1.27
(VL-POSITIONS11 1 LST).....3625 / 1 <slowest>
Elapsed milliseconds / relative speed for 32768 iteration(s):
(VL-POSITIONS7 1 LST)......1343 / 2.62 <fastest>
(VL-POSITIONS8 1 LST)......1469 / 2.39
(VL-POSITIONS6 1 LST)......1547 / 2.27
(VL-POSITIONS9 1 LST)......1687 / 2.08
(VL-POSITIONS4 1 LST)......1984 / 1.77
(VL-POSITIONS1 1 LST)......2047 / 1.72
(VL-POSITIONS10 1 LST).....2219 / 1.58
(VL-POSITIONS2 1 LST)......2250 / 1.56
(VL-POSITIONS5 1 LST)......2281 / 1.54
(VL-POSITIONS11 1 LST).....3516 / 1 <slowest>

复制代码

目前，wowan1314的 vl-positions7 表现最好

/db_自贡黄明儒_ · 发表于 2017-5-15 10:31:26

本帖最后由 newer 于 2017-5-15 17:25 编辑

(defun vl-positions2 (x l / I NEW Y)
(setq i -1)
(mapcar '(lambda (y)
(setq i (1+ i))
(if (= x y)
(setq New (cons i New))
)
)
l
)
(if New (reverse New))
)

marting · 发表于 2017-5-15 14:49:48

本帖最后由 newer 于 2017-5-16 20:09 编辑

来一个递归的

(defun vl-positions3 (x l / p)
(if (setq p (vl-position x l))
(cons p
(mapcar
'(lambda (y)
(+ 1 p y)
)
(vl-positions3 x (cdr (member x l)))
)
)
)
)

wowan1314 · 发表于 2017-5-15 17:14:52

本帖最后由 newer 于 2017-5-15 19:08 编辑

(defun vl-positions4 (m l / a ll) (setq a -1)
(foreach n l
(and
(setq a (1+ a))
(= m n)
(setq ll (cons a ll))
)
)
(reverse ll)
)

Lisphk · 发表于 2017-5-15 17:23:05

本帖最后由 newer 于 2017-5-15 19:08 编辑

(defun vl-positions5 (itm lst / idn nlst)
(setq idx -1)
(while (< (setq idx (1+ idx))
(length lst)
)
(and
(= itm (nth idx lst))
(setq nlst (cons idx nlst))
)
)
(reverse nlst)
)

wowan1314 · 发表于 2017-5-15 18:17:46

本帖最后由 newer 于 2017-5-15 19:08 编辑

(defun vl-positions6 (m l / a b ll)
(while
(setq a (vl-position m l))
(setq l (cdr (member m l))ll (cons (if (setq b (car ll)) (+ 1 a b) a) ll))
)
(reverse ll)
)

还是二楼递归的叼！

newer · 发表于 2017-5-15 18:35:47

wowan1314 发表于 2017-5-15 18:17

你说的叼，是指的哪方面？
1、代码美？
2、代码快？
3，如果其他，是什么？

wowan1314 · 发表于 2017-5-15 18:54:23

newer 发表于 2017-5-15 18:35

是指比我叼，呵呵，一开始我也想递归来着，没递出来！

newer · 发表于 2017-5-15 19:07:29

本帖最后由 newer 于 2017-5-15 19:10 编辑

wowan1314 发表于 2017-5-15 18:54

公布下测试结果

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

(VL-POSITIONS6 1 LST).....1328 / 1.34 <fastest>
(VL-POSITIONS4 1 LST).....1359 / 1.31
(VL-POSITIONS5 1 LST).....1625 / 1.1
(VL-POSITIONS1 1 LST).....1719 / 1.04
(VL-POSITIONS2 1 LST).....1781 / 1 <slowest>

不幸的是，递归那个测试时候堆栈溢出，所以尽可能还是别用递归，大数据不行。

目前，暂时，最快的是VL-POSITIONS6，最慢的是VL-POSITIONS2

看看，谁还能写出更快的不？测试工具在一楼， c:test

wowan1314 · 发表于 2017-5-15 19:13:14

newer 发表于 2017-5-15 19:07

哈哈！我写的两个最快！

处理树结构的数据，必须递归啊！树啊树啊！一直让我纠结

newer · 发表于 2017-5-15 19:15:52

/db_自贡黄明儒_ 发表于 2017-5-15 10:31

老黄，暂时你这个效率是最慢的，看看能改进改进不？

newer · 发表于 2017-5-15 19:17:02

wowan1314 发表于 2017-5-15 19:13

是的，只能用递归的时候在用递归吧，能迭代处理的就迭代，否则大数据递归要死人的。

wowan1314 · 发表于 2017-5-15 19:21:22

本帖最后由 newer 于 2017-5-15 19:28 编辑

(defun vl-positions7 (m l / a b ll)
(setq ll (cons (vl-position m l) ll) l (cdr (member m l)))
(while
(setq a (vl-position m l))
(setq l (cdr (member m l))ll(cons(+ 1 a (car ll))ll))
)
(reverse ll)
)

把6再优化下，看看是不是能快点。

newer · 发表于 2017-5-15 19:26:52

wowan1314 发表于 2017-5-15 19:21

还是6快

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

(VL-POSITIONS6 1 LST).....1203 / 1.66 <fastest>
(VL-POSITIONS7 1 LST).....1281 / 1.56
(VL-POSITIONS4 1 LST).....1344 / 1.49
(VL-POSITIONS5 1 LST).....1750 / 1.14
(VL-POSITIONS1 1 LST).....1953 / 1.02
(VL-POSITIONS2 1 LST).....2000 / 1 <slowest>

wowan1314 · 发表于 2017-5-15 19:28:45

newer 发表于 2017-5-15 19:26

没道理啊！明明减少了while里面代码了。按道理应该快些的

账号		自动登录	找回密码
密码			立即注册

[有奖答题] 让VL-POSITION返回多个索引

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分

评分

评分

评分