（XD::Math:SnapNumber）从表中找到和参数值最近的值

Lispboy · 发表于 2017-5-7 22:47:25

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

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

×

(defun XD::Math:SnapNumber (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)
)
)
)
(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
((not rtn)
nil
)
((= 1 (length rtn))
(car rtn)
)
(rtn)
)
)

(defun XD::Math:SnapNumber (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) 
      ) 
    ) 
  )                                        
  (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 
    ((not rtn) 
      nil 
    ) 
    ((= 1 (length rtn)) 
      (car rtn) 
    ) 
    (rtn) 
  ) 
)

命令: (XD::MATH:SNAPNUMBER 4 '(1 3 5 6))
(3 5)
命令: (XD::MATH:SNAPNUMBER 4.1 '(1 3 5 6))
5
命令: (XD::MATH:SNAPNUMBER 23 '(0 15 30 45 60 75 90))
30

434939575 · 发表于 2017-5-8 10:27:18

这个挺好的，谢谢！

llsheng_73 · 发表于 2017-5-9 10:29:13

(defun SnapNumber(n lst)
(cdar(vl-sort(mapcar'(lambda(x)(cons(abs(- x n))x))lst)'(lambda(x y)(<(car x)(car y))))))

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

[数学] （XD::Math:SnapNumber）从表中找到和参数值最近的值

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