论坛直接搜函数不能搜到相关用法贴一个vl-every函数用法

jun353835273

论坛直接搜函数貌似不能按内容检索，好像是按帖子主体关键字搜索的贴一个vl-every函数用法
(setq vl (list '(1 2 0 ) '(1 2 0 ) '(1 2 0 ) '(2 2 0 )))
(setq is (v-every '(lambda (x) (zerop (last x))) vL));判断是表最后元素是否为0
结果：T
(setq is (vl-every '(lambda (x) (= 1 (car x))) vL));判断是表第一个元素是否为1
结果：nil
(vl-every 'numberp '("h" 0.0 90.0 180.0 270.0 360.0));判断是否都为实数
结果：nil
(setq a (vl-remove-if '(lambda (x) (= 1 (car x)) ) vL));移除第一个元素是为1的表
结果：((2 2 0))
如判断用forach 或者mapcar 判断也行，但是感觉vl-every省事。
(setq lst (list '(1 2 3 4 5 6)  '(1 2 3 4 5 6) '(1 2 3 4 5 6) '(2 2 3 4 5 6)))
(setq fuz 1)
(setq a (car lst))
(vl-some
          (function (lambda ( x )
            (equal x a fuzz)
          ))
          (cdr lst)
        )

结果：T
(setq lst (list '(1 2 3 4 5 6)    '(2 2 3 4 5 6) '(7 8 9 10 11)))
(setq fuzz 1)
(setq a (car lst))
(vl-some
          (function (lambda ( x )
            (equal x a fuzz)
          ))
          (cdr lst)
        )

结果：nil

还有vl-some  这些用法大佬来贴码咯
;搬运的函数

(setq lst (list '(1 2 3 4 5 6)  '(1 2 3 4 5 6) '(1 2 3 4 5 6) '(2 2 3 4 5 6)))
;(uniquefuzz lst 1 )->((1 2 3 4 5 6) (2 2 3 4 5 6))
(defun uniquefuzz ( lst fuzz / a ll )
    (while (setq a (car lst))
      (if
        (vl-some
          (function (lambda ( x )
            (equal x a fuzz)
          ))
          (cdr lst)
        )
        (progn
          (setq ll (cons a ll))
          (setq lst
            (vl-remove-if
              (function (lambda ( x )
                (equal x a fuzz)
              ))
              (cdr lst)
            )
          )
        )
        (progn
          (setq ll (cons a ll))
          (setq lst (cdr lst))
        )
      )
    )
    (reverse ll)
  )
; Snaps a number to the closest ones in the list (if the num is equally between 2 vals, then it returns list of both values)

;将;http://www.lee-mac.com/uniqueduplicate.html
;; Unique-p  -  Lee Mac
;; Returns T if the supplied list contains distinct items.
;;如果提供的列表包含不同的项，则返回T。
(defun LM:Unique-p ( l )
    (vl-every (function (lambda ( x ) (not (member x (setq l (cdr l)))))) l)
)
_$ (LM:Unique-p '(1 2 3 4 5))
T
_$ (LM:Unique-p '(1 2 3 3 3 4 5))
nil

;; Unique with Fuzz  -  Lee Mac
;; Returns a list with all elements considered duplicate to
;;返回所有元素都被视为重复的列表
;; a given tolerance removed.
(defun LM:UniqueFuzz ( l f )
    (if l
        (cons (car l)
            (LM:UniqueFuzz
                (vl-remove-if
                    (function (lambda ( x ) (equal x (car l) f)))
                    (cdr l)
                )
                f
            )
        )
    )
)


;; Unique with Fuzz  -  Lee Mac
;; Returns a list with all elements considered duplicate to
;; a given tolerance removed.

(defun LM:UniqueFuzz ( l f / x r )
    (while l
        (setq x (car l)
              l (vl-remove-if (function (lambda ( y ) (equal x y f))) (cdr l))
              r (cons x r)
        )
    )
    (reverse r)
)


_$ (LM:UniqueFuzz '(1.0 1.1 2.0 2.01 2.2) 0.01)
(1.0 1.1 2.0 2.2)

_$ (LM:UniqueFuzz '(1.0 1.1 2.0 2.01 2.2) 0.15)
(1.0 2.0 2.2)


;; Unique-p with Fuzz  -  Lee Mac
;; Returns T if a list contains items considered distinct to
;; a given tolerance

(defun LM:UniqueFuzz-p ( l f )
    (or (null l)
        (and (not (vl-some (function (lambda ( x ) (equal x (car l) f))) (cdr l)))
             (LM:UniqueFuzz-p (cdr l) f)
        )
    )
)
;; Unique-p with Fuzz  -  Lee Mac
;; Returns T if a list contains items considered distinct to
;; a given tolerance

(defun LM:UniqueFuzz-p ( l f )
    (vl-every
        (function
            (lambda ( x )
                (not
                    (vl-some
                        (function
                            (lambda ( y ) (equal x y f))
                        )
                        (setq l (cdr l))
                    )
                )
            )
        )
        l
    )
)

_$ (LM:UniqueFuzz-p '(1.0 1.1 2.0 2.01 2.2) 0.01)
nil
_$ (LM:UniqueFuzz-p '(1.0 1.1 2.0 2.01 2.2) 0.001)
T一个数字捕捉到列表中最接近的数字（如果数字在2个vals之间相等，则返回两个值的列表）

; _$ (SnapNumber2 5 '(0 2 4 6)) -> (4 6)

; _$ (SnapNumber2 5.2 '(0 2 4 6)) -> 6

; _$ (SnapNumber2 45 '(0.0 90.0 180.0 270.0 360.0)) -> (0.0 90.0)

(defun SnapNumber2 ( n Ln / _Positions Ld rtn )

  (defun _Positions ( x lst / p ) ; MP ;;  find all the positions of x in lst ;;  (_Positions 1 '(0 0 1 0 0 1)) >> (2 5)

    (if (setq p (vl-position x lst))

      ( (lambda ( lst result )

        (while (setq p (vl-position x lst)) (setq result (cons (+ 1 p (car result)) result) lst (cdr (member x lst)) ) )

        (reverse result)

      )

      (cdr (member x lst)) (list p)

      )

    )   

  ); defun _Positions

  (cond

    ( (or (not (numberp n)) (not (vl-every 'numberp Ln))) (princ "\nInvalid inputs.") nil )

    ( (setq Ld (mapcar '(lambda (x) (abs (- n x))) Ln))

      (setq rtn (mapcar '(lambda (x) (nth x Ln)) (_Positions (apply 'min Ld) Ld)))

    )

  ); cond

  (cond ( (not rtn) nil) ( (= 1 (length rtn)) (car rtn) ) (rtn) )

)

vitalgg

jun353835273 发表于 2023-9-12 10:43
你这个就是函数手册上的，和翻手册差不多。

手册的解释就是用精准的语言表述函数的功能。如果能理解这个表述了，还需要看例子吗？
看例子的目的也是为了帮助理解函数函数的用法。

guosheyang

(setq vl (list '(1 2 0 ) '(1 2 0 ) '(1 2 0 ) '(2 2 0 )))
(setq is (vl-every '(lambda (x) (= 1 (car x))) vL));判断是表第一个元素是否为1
应该返回 nil

vitalgg

vl-every 等同于
(apply 'and (mapcar '测试函数 lst))


vl-some 等同于
(apply 'or (mapcar '测试函数 lst))

liuhe

6666666666666666666

jun353835273

liuhe 发表于 2023-9-12 10:14
6666666666666666666

来来来 贴一个

kucha007

学习一下！

jun353835273

vitalgg 发表于 2023-9-12 10:36
vl-every 等同于
(apply 'and (mapcar '测试函数 lst))

你这个就是函数手册上的，和翻手册差不多。

蓝天cayuer

看看楼主发帖内容

zj20190405

6666666666666666666