[LISP函数]：含精度的进位Fix

eachy

2. 
   
3. ;|
   
4. (xd-fix 12.55 0.1)
   
5. 12.6
   
6. (xd-fix 12.55 0.01)
   
7. 12.55
   
8. (xd-fix 12.55 1)
   
9. 13|;
   
10. (defun xd-fix (#s #sr)
    
11.   (* (fix (+ (/ (float #s) #sr) 0.5)) #sr)
    
12. )

<br /> ;|<br /> (xd-fix 12.55 0.1)<br /> 12.6 <br /> (xd-fix 12.55 0.01)<br /> 12.55<br /> (xd-fix 12.55 1)<br /> 13|;<br /> (defun xd-fix (#s #sr)<br />   (* (fix (+ (/ (float #s) #sr) 0.5)) #sr)<br /> )

狂刀

或者叫＂四舍五入＂？

小菜

修改为：
[PHP](defun xd-fix (#s #sr)
  (if (> #s 0.0)
  (* (fix (+ (/ (float #s) #sr) 0.5 1e-10)) #sr)
  (* (fix (- (/ (float #s) #sr) 0.5 1e-10)) #sr)
  )
)
[/PHP]
不进行误差控制会发生：(xd-fix 2.55 0.1)=2.5

aeo

命令: (XD-FIX 55555.555555 0.1)
55555.6
命令: (XD-FIX 55555.555555 0.3) ;;;如果写成0.3
55555.5

用整数表示

2. 
   
3. (defun fix2(num ## / a)
   
4.   (setq a (expt 10. ##))
   
5.   (* a(fix (+ (/ num a)0.5000000000001)))
   
6. )
   

<br /> (defun fix2(num ## / a)<br />   (setq a (expt 10. ##))<br />   (* a(fix (+ (/ num a)0.5000000000001)))<br /> )<br />

命令: (rtos (fix2 55555.555555 -3) 2 5)
"55555.55600"

命令: (rtos (fix2 55555.555555 -1) 2 5)
"55555.60000"

命令: (rtos (fix2 55555.555555 1) 2 5)
"55560.00000"

命令: (rtos (fix2 55555.555555 3) 2 5)
"56000.00000"

小菜

为什么要写成0.3？这个数字是参与运算的，写成0.3误差更难控制

wujimmy

受 xyp1964 提示:

(defun myfix (x / mid midd)
(atoi (rtos x 2 0))
)

楼下谁再测试一下看看哪种方法速度最快:)

小菜

上面这个函数怎么只有一个参数？位数如何控制？

fsxm

wujimmy
说的是这样的：
(defun myfix (x y/ mid midd)
  (atoi (rtos x 2 y))
)
如下:
(myfix 12.55 1)
12.6
(myfix 12.55 2)
12.55
(myfix 12.55 0)
13

wujimmy

速度测试:
结论:差不多

2. 
   
3. (defun myfix (x y / mid midd)
   
4. (atoi (rtos x 2 y))
   
5. )
   
6. (defun fix2(num ## / a)
   
7.   (setq a (expt 10. ##))
   
8.   (* a(fix (+ (/ num a)0.5000000000001)))
   
9. )
   
10. (defun xd-fix (#s #sr)
    
11.   (if (> #s 0.0)
    
12.   (* (fix (+ (/ (float #s) #sr) 0.5 1e-10)) #sr)
    
13.   (* (fix (- (/ (float #s) #sr) 0.5 1e-10)) #sr)
    
14.   )
    
15. )
    
16. 
    
17. (defun c:tt ()
    
18.   (setvar "cmdecho" 0)
    
19.   (setq re_times 10000)
    
20.   (setq funlist (list myfix fix2 xd-fix))
    
21.   ;(setq testlist (list 1111 2222 3333 4444 5555 6666 7777 8888 9999))
    
22. 
    
23.    (foreach fun funlist
    
24.     (progn
    
25.       (setq t1 (getvar "date")) ;_记录开始时间t1
    
26.       (repeat re_times
    
27.         (fun 12.555 2)
    
28.       ) ;_repeat
    
29.       (setq t2 (getvar "date")) ;_记录结束时间t2
    
30.       (princ "函数:")(princ fun)(princ "测试结果")
    
31.       (princ (menucmd (strcat "M=$(edtime," (rtos (- t2 t1) 2 16) ",HH:MM:SS:MSEC)")))
    
32.       (princ "\n")
    
33.     ) ;_progn
    
34. 
    
35.   ) ;_foreach
    
36.   (setvar "cmdecho" 1)
    
37.   (princ)
    
38. )
    

<br /> (defun myfix (x y / mid midd)<br /> (atoi (rtos x 2 y))<br /> )<br /> (defun fix2(num ## / a)<br />   (setq a (expt 10. ##))<br />   (* a(fix (+ (/ num a)0.5000000000001)))<br /> )<br /> (defun xd-fix (#s #sr) <br />   (if (> #s 0.0) <br />   (* (fix (+ (/ (float #s) #sr) 0.5 1e-10)) #sr) <br />   (* (fix (- (/ (float #s) #sr) 0.5 1e-10)) #sr) <br />   ) <br /> )<br /> <br /> (defun c:tt ()<br />   (setvar "cmdecho" 0)<br />   (setq re_times 10000)<br />   (setq funlist (list myfix fix2 xd-fix))<br />   ;(setq testlist (list 1111 2222 3333 4444 5555 6666 7777 8888 9999))<br /> <br />    (foreach fun funlist<br />     (progn<br />       (setq t1 (getvar "date")) ;_记录开始时间t1<br />       (repeat re_times<br />         (fun 12.555 2)<br />       ) ;_repeat<br />       (setq t2 (getvar "date")) ;_记录结束时间t2<br />       (princ "函数:")(princ fun)(princ "测试结果")<br />       (princ (menucmd (strcat "M=$(edtime," (rtos (- t2 t1) 2 16) ",HH:MM:SS:MSEC)")))<br />       (princ "\n")<br />     ) ;_progn<br /> <br />   ) ;_foreach<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )<br />