求各路高手帮小弟学一个计算式程序

飞诗(fsxm)

呵呵~我只是写了一个处理有优化级的函数一个例子~

sin之类的没有优化级别更好处理~

只要提前将sin(XXX)用字符处理成(sin XX)就行了~用不到表处理`!

字符替代 "sin(" -> "(sin"

狂刀无痕

;| xcal = 计算字符串表达式------- by lxx.2007.7.22
格式: (xcal 运算过程式 返回值表达式)
返回: 实数 (可用rtos提取)
命令: xxcal
实例:
(xcal "" "1e+2*5^3*exp(5.31)" )
-> 2.52938e+006
(xcal "a=1e+2*5^3*exp(5.31):" "a" )
->2.52938e+006
(rtos (xcal "a=1e+2*5^3*exp(5.31):" "a" ) 2 10)
-> "2529377.854851844"
(xcal "a=3 : for i = 1 to 100000 : a=a+i+5^3*exp(5.31) : b=a^2*sin(a) : c=sqr(a)*b : next :" "c" )
->　1.59322e+021  ;;返回 c值,10万次计算,1~2秒
版本:
v1.0 2007.7.22
|;

 命令行方式演示,重复运算100万次, <1秒得结果.

其实计算不是lisp的强项。用c系列语言，甚至vb都快得多。上面的方法是在lisp中调用vb计算。C我不懂，肯定能更快。大家继续。。。

 

飞诗(fsxm)

;;;分离出变量与函数
(defun format1 (str / char funs lastfun lst tmp lastchar)
  (setq funs '("+" "-" "*" "/" "^" "%" "(" ")" " "))
  (setq tmp "")
  (while (/= str "")
    (setq char (substr str 1 1))
    (setq str (substr str 2))
    (if (and (member char funs)
      ;;负号特别处理
      (not (and lastfun (/= lastfun ")") (= char "-")))
      ;;"e"科学计数法特别处理
      (not (and lastchar (or (= char "-") (= char "+"))))
 )
      (setq lst      (vl-list* char tmp lst)
     tmp      ""
     lastfun  char
     lastchar nil
      )
      (setq tmp      (strcat tmp char)
     lastfun  nil
     lastchar (if (= (strcase char) "E") t)
      )
    )
  )
  (vl-remove "" (vl-remove " " (reverse (cons tmp lst))))
)
;;;处理简单无优先级别函数运算
(defun format1_1 (lst funs / fun lasta nlst tmp)
  (foreach a lst
    (cond
      ((setq tmp (assoc (strcase a) funs))
       (setq fun (cadr tmp))
      )
      ((and (= a "(") fun)
       (setq nlst (vl-list* fun "(" nlst))
       (setq fun nil)
      )
      ((and (= a "(")
     (not (member lasta '(nil "+" "-" "*" "/" "^" "%" "(" ")")))
       )
       (setq nlst (vl-list* lasta "(" (cdr nlst)))
      )
      (t (setq nlst (cons a nlst)))
    )
    (setq lasta a)
  )
  (reverse nlst)
)
;;;带return的apply
(defun Fsxm-Apply ($Sym $Lst / $$ return $rt)
  (defun Return (var) (setq Return nil) (setq $$ var) (exit))
  (setq $rt (vl-catch-all-apply $Sym $Lst))
  (if Return $rt $$)
)
;;递归处理括号
(defun format2 (lst / a i lst2 nlst tmp var)
  (setq i 0)
  (while lst
    (setq a (car lst))
    (setq lst (cdr lst))
    (setq i (1+ i))
    (cond ((= a "(")
    (setq var (fsxm-apply 'format2 (list lst)))
    (repeat (car var) (setq lst (cdr lst)))
    (setq i (+ i (car var)))
    (setq nlst (cons (cadr var) nlst))
    (setq tmp (cons (cadr var) tmp))
   )
   ((= a ")")
    (return (list i (reverse tmp)))
   )
   (t
    (setq tmp (cons a tmp))
    (setq nlst (cons a nlst))
   )
    )
  )
  (reverse nlst)
)
;;递归转化计算式格式
(defun format3 (lst funs / lasta nlst tmp fun)
  (foreach a lst
    (cond ((setq fun (assoc a funs))
    (setq tmp (list lasta (cadr fun)))
   )
   (t
    (if (listp a)
      (setq a (format3 a funs))
    )
    (if tmp
      (setq lasta (reverse (cons a tmp))
     nlst  (cons lasta (cdr nlst))
     tmp  nil
      )
      (setq lasta a
     nlst  (cons lasta nlst)
      )
    )
   )
    )
  )
  (reverse nlst)
)
;;递归处理掉多余的括号,
;;常量str->浮点数real 变量str->符号sym
(defun format4 (lst)
  (mapcar '(lambda (a / x)
      (cond ((listp a)
      (if (listp (car a))
        (format4 (car a))
        (format4 a)
      )
     )
     ((= (type a) 'str)
      (or (setq x (distof a))
   (setq x (read a))
      )
      x
     )
     (t a)
      )
    )
   lst
  )
)
(defun trans_format (str / lst)
  ;;预处理 去空字符&转括号
  (setq str (vl-string-translate "{[]}\t\n," "(())   " str))
  ;;分离出变量与函数
  (setq lst (format1 str))
  ;;处理无优先级别函数运算
  (setq lst (format1_1 lst '(("COS" cos2) ("SIN" sin2) ("TAN" tan2))))
  ;;递归处理括号
  (setq lst (format2 lst))
  ;;优先计算  开方
  (setq lst (format3 lst '(("^" expt))))
  ;;再次计算  乘 除 取模
  (setq lst (format3 lst '(("*" *) ("/" /) ("%" rem))))
  ;;最后计算 加减
  (setq lst (format3 lst '(("+" +) ("-" -))))
  ;;后处理
  (car (format4 lst))
)

(defun sin2 (d)
  (sin (* d (/ pi 180)))
)
(defun cos2 (d)
  (cos (* d (/ pi 180)))
)
(defun tan2 (d)
  (setq d (* d (/ pi 180)))
  (/ (sin d) (cos d))
)
;;====================功能测试1:====================
(setq str1 (strcat "(1/(cos(-2)*-3)+"
    "min(22,abs(-5),0.5,8)"
    "*(2-5))/3^(sin(pi/5)+2)-1e+2*5"
   )
)
(eval (trans_format str1))  ;-> -500.201
(eval (trans_format "min(22 , abs(-5) , 0.5 , 8)")) ;-> 0.5
;;因min(22,abs(-5),0.5,8) -> 0.5 现在用cal验证结果
(setq str2 "(1/(cos(-2)*-3)+0.5*(2-5))/3^(sin(pi/5)+2)-1e+2*5")
(c:cal str2)    ;-> -500.201

;;功能测试通过

;;====================效率测试====================
;;计时子函数
(defun time0 () (setq t0 (getvar "TDUSRTIMER")))
(defun time1 ()
  (princ "用时:")
  (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
  (princ "(S)")
  (princ)
)
(setq str "(1/(cos(-2)*-3)+0.5*(2-5))/3^(sin(pi/5)+2)-1e+2*5")
(defun c:t1 (/ t0)   ;用CAL对比
  (time0)
  (repeat 5000 (cal str))
  (time1)
)
(defun c:t2 (/ t0)   ;多次eval+多次trans_format(比cal慢)
  (time0)
  (repeat 5000 (eval (trans_format str)))
  (time1)
)
(defun c:t3 (/ t0)   ;多次eval+1次trans_format(与cal差不多)
  (time0)
  (setq trans_lst (trans_format str))
  (repeat 5000 (eval trans_lst))
  (time1)
)
(defun c:t4 (/ t0 test)   ;1次eval+1次trans_format(比cal快)
  (time0)
  (eval (list 'defun 'test nil (trans_format str)))
  (repeat 5000 (test))
  (time1)
)

后语:
事实上基于字符解释与表处理的trans_format
它的单次运算效率是不如cal的,约比cal慢20倍
但是因为它的最终解释结果为lisp表达式,
在很多次运算"解释结果"时,运算效率将比cal快10倍以上
它开放式的程式构架,赋予了很多cal函数所没有功能.比如:
trans_format可以运算"自定义函数"也可以运算"变量",还可以自定义"运算子"的优先级别
-----fsxm2007.07.23~2007.07.24

希望以上程序代码能对各位有点帮助!

highflybir

看来飞诗已经研究出来了，佩服佩服！
先下载下来学习学习。
建议，函数不应局限于lisp中的有限几个，可以扩展一些。
感觉速度上应该还可以提高。
关于为什么要转换，请大家看下面的例子：就是平方运算:

3. ;;;平方表达式的lisp运算和cal运算。
4. (defun C:test(/ cal-express lisp-express)
5.   (arxload "Geomcal.arx")
6.   (setq cal-express "x^2")
7.   ;;假设我已经准确地翻译"X^2"成如下函数
8.   (setq lisp-express (read "(* x x)"))
9.   ;;则
10.   (eval
11.     (list 'defun 'lisp-sqr (list 'x)
12.       lisp-express
13.     )
14.   )
15.   (defun cal-sqr (x)
16.     (cal cal-express)
17.   )
18.   ;;lisp
19.   (time0)
20.   (setq i 0)
21.   (repeat 10000
22.     (lisp-sqr i)
23.     (setq i (1+ i))
24.   )
25.   (time1)
26.   ;;cal
27.   (time0)
28.   (setq i 0)
29.   (repeat 10000
30.     (cal-sqr i)
31.     (setq i (1+ i))
32.   )
33.   (time1)
34. )

;;;平方表达式的lisp运算和cal运算。 (defun C:test(/ cal-express lisp-express)   (arxload "Geomcal.arx")   (setq cal-express "x^2")   ;;假设我已经准确地翻译"X^2"成如下函数   (setq lisp-express (read "(* x x)"))   ;;则   (eval     (list 'defun 'lisp-sqr (list 'x)       lisp-express     )   )   (defun cal-sqr (x)     (cal cal-express)   )   ;;lisp   (time0)   (setq i 0)   (repeat 10000     (lisp-sqr i)     (setq i (1+ i))   )   (time1)   ;;cal   (time0)   (setq i 0)   (repeat 10000     (cal-sqr i)     (setq i (1+ i))   )   (time1) )

实际结果发现对于是一个变量的表达式子，如果经lisp翻译后（假设这种翻译是完全准确而且不冗余的）的运算速度可能要比cal快100倍以上。这还是没有经过编译的。

3. ;;计时子函数
4. (defun time0 () (setq t0 (getvar "TDUSRTIMER")))
5. (defun time1 ()
6.   (princ "用时:")
7.   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
8.   (princ "秒")
9.   (princ)
10. )

;;计时子函数 (defun time0 () (setq t0 (getvar "TDUSRTIMER"))) (defun time1 ()   (princ "用时:")   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))   (princ "秒")   (princ) )

狂刀无痕

要说表处理和cad更容易结合,我没话说.但是说比cal快那我得说点不同意见.
cal也是arx(c系列语言)编写的.怎么可能慢.
上面的测试本来就是个错误.为什么这么说.单就计算本身(比如1次运算),cal快是没画说.但是为什么多次运算又慢了呢?根本不是计算的效率问题.而是程序的结构问题.是lisp把它拖慢的.因为没计算一次,数据传给计算函数计算,结果传回lisp,慢就慢在传出传入上.是错误的应用方法.发挥不了优势. 要慢也不是因为cal慢.
就是说,如果用cal或其它用vb,vc等编写的函数或模块来进行大量运算,应该把要计算的条件一次传入,计算(包括多次循环)完了,再一次性把结果传回lisp.
因此,对简单的计算.用lisp或其它都无所谓,时间感觉不出来.
要进行大量运算.就放手让外部计算程序计算.一次出结果.不要把时间花在lisp的数据转换上面.

2. ;;;平方表达式的lisp运算和cal运算。
3. (defun C:test (/ cal-express lisp-express)
4.   (arxload "Geomcal.arx")
5.   (setq cal-express "x^2")
6.   (setq lisp-express (read "(* x x)"))
7.   (defun cal-sqr (x)
8.     (cal cal-express)
9.   )
10.   (eval (list 'defun  'lisp-sqr  (list 'x)  lisp-express ))
11.   (time0)
12.   (setq i 0)
13.   (repeat 10000
14.     (setq end (cal-sqr i))
15.     (setq i (1+ i))
16.   )
17.   (time1)
18.   (print (rtos end 2 8))
19.   (princ)
20. )
21. ;;; 对比测试:
22. (defun c:xx ()
23. (setq n  (getdist "\n 输入运算次数:"))
24. (time0)
25. (setq end
26. (xcal (strcat "a=0 : for i = 1 to "
27.         (itoa (fix n))
28.         " : a=i^2 : next :") "a" ))  ;; 可在12楼下载本函数
29. (time1)
30. (print (rtos end 2 8))
31. (princ)
32. )

;;;平方表达式的lisp运算和cal运算。 (defun C:test (/ cal-express lisp-express)   (arxload "Geomcal.arx")   (setq cal-express "x^2")   (setq lisp-express (read "(* x x)"))   (defun cal-sqr (x)     (cal cal-express)   )   (eval (list 'defun  'lisp-sqr  (list 'x)  lisp-express ))   (time0)   (setq i 0)   (repeat 10000     (setq end (cal-sqr i))     (setq i (1+ i))   )   (time1)   (print (rtos end 2 8))   (princ) ) ;;; 对比测试: (defun c:xx () (setq n  (getdist "\n 输入运算次数:")) (time0) (setq end (xcal (strcat "a=0 : for i = 1 to "         (itoa (fix n))         " : a=i^2 : next :") "a" ))  ;; 可在12楼下载本函数 (time1) (print (rtos end 2 8)) (princ) )

测试结果:

1. 命令: test
2. 用时:11.984秒
3. "99980001.00000002"
4. 命令:
5. 命令: xx
6. 输入运算次数:10000
7. 用时:0.016秒
8. "100000000.0000000"
9. 命令:
10. 命令: xx
11. 输入运算次数:1000000
12. 用时:1.656秒
13. "1000000000000.000"
14. 命令:
15. 命令:
16. XX
17. 输入运算次数:8000000
18. 用时:11.609秒
19. "64000000000000.00"

复制代码

也就是说,用xcal函数(调用了vba) 800万次运算和用lisp1万次运算用时相当.而且越到后面每次运算时间需要更多, 因为是 (* x x)
如果都是1万次运算.11.984秒 秒和0.016秒有多大差别,不用说了吧....
另外,test的测试结果有误差(几次测试都是),可能是浮点运算造成,楼上可再检查一下

highflybir

回楼上的，我觉得应该这样做比较：
(注意是：lisp-sqr,而不是cal-sqr)

3. ;;;平方表达式的lisp运算和cal运算。
4. (defun C:test (/ i lisp-express)
5.   (setq n  (getreal "\n 输入运算次数:"))
6.   (setq lisp-express (read "(* x x)"))
7.   (eval
8.     (list 'defun
9.    'lisp-sqr
10.    (list 'x)
11.    lisp-express
12.     )
13.   )
14.   (time0)
15.   (setq i 0.0)
16.   (repeat (fix n)
17.     (setq end1 (lisp-sqr i))
18.     (setq i (1+ i))
19.   )
20.   (time1)
21.   (print (rtos end1 2 8))
22.   (princ)
23. )
24. ;;; 对比测试:(
25. (defun c:xx ()
26.   (setq n  (getreal "\n 输入运算次数:"))
27.   (time0)
28.   (setq end1
29.   (xcal (strcat "a=0 : for i = 1 to "
30.          (itoa (fix n))
31.          " : a=i^2 : next :"
32.         )
33.         "a"
34.   )
35.   )
36.   ;; 可在12楼下载本函数
37.   (time1)
38.   (print (rtos end1 2 8))
39.   (princ)
40. )
41. ;;计时子函数
42. (defun time0 () (setq t0 (getvar "TDUSRTIMER")))
43. (defun time1 ()
44.   (princ "\n用时:")
45.   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))
46.   (princ "秒")
47.   (princ)
48. )

;;;平方表达式的lisp运算和cal运算。 (defun C:test (/ i lisp-express)   (setq n  (getreal "\n 输入运算次数:"))   (setq lisp-express (read "(* x x)"))   (eval     (list 'defun    'lisp-sqr    (list 'x)    lisp-express     )   )   (time0)   (setq i 0.0)   (repeat (fix n)     (setq end1 (lisp-sqr i))     (setq i (1+ i))   )   (time1)   (print (rtos end1 2 8))   (princ) ) ;;; 对比测试:( (defun c:xx ()   (setq n  (getreal "\n 输入运算次数:"))   (time0)   (setq end1   (xcal (strcat "a=0 : for i = 1 to "          (itoa (fix n))          " : a=i^2 : next :"         )         "a"   )   )   ;; 可在12楼下载本函数   (time1)   (print (rtos end1 2 8))   (princ) ) ;;计时子函数 (defun time0 () (setq t0 (getvar "TDUSRTIMER"))) (defun time1 ()   (princ "\n用时:")   (princ (* (- (getvar "TDUSRTIMER") t0) 86400))   (princ "秒")   (princ) )

把这个程序编译成vlx后发现两者在1000000次以内基本打平。不信大家去测试.

highflybir

下面是一个一亿次的运算测试：

命令:
命令: test
 输入运算次数:100000000

用时:86.203秒
"9999999800000001"

命令:
命令: xx
 输入运算次数:100000000

用时:59.093秒
"1.00000000E+16"

可见在亿次上才可能看见差别。然而这个差别不大，不是数量级的差别。

至于为什么后面返回的结果不同，也许大家能猜得到。

狂刀无痕

不得不说,编译我vlx后lisp的速度确优化了不少.因为vlx被编译为一种介lisp和机器码之间的编码,所以速度提高.

虽然不是数量级的差别,但是也不会基本打平拉 (我的电脑cpu是 amd3200 内存512兆),另外,连10次运算,在100内都有19的的误差,不知道哪个敢用.

TEST
 输入运算次数:10

用时:0.0秒
"81.00000000"

命令:
命令: xx

 输入运算次数:10

用时:0.0秒
"100.00000000"

命令: test
 输入运算次数:1e4
用时:0.031秒
"99980001.00000000"
命令: xx
 输入运算次数:1e4
用时:0.016秒
"100000000.0000000"
命令:
命令: test
 输入运算次数:1e6
用时:3.563秒
"999998000001.0001"
命令:
命令: xx
 输入运算次数:1e6
用时:1.297秒
"1000000000000.000"
命令:
命令: test
 输入运算次数:1e6
用时:3.672秒
"999998000001.0001"
命令:
命令: xx
 输入运算次数:1e6
用时:1.578秒
"1000000000000.000"
命令:
命令: test
 输入运算次数:1e7
用时:36.5秒
"99999980000001.00"
命令:
命令: xx
 输入运算次数:1e7
用时:13.984秒
"100000000000000.0"

命令: test

 输入运算次数:1e8

用时:433.89秒
"9999999800000001"

命令:
XX
 输入运算次数:1e8

用时:160.031秒
"1.00000000E+16"

飞诗(fsxm)

我们不要只是简单的说运行的快慢~

效率是在实际应用上体现出来的! 如果没有用的"快"远不如有用的"慢"

现在给一个应用例子:

y = x^3+x*x+5x+cos(x+pi/5)+0.5

现在用CAD画这个方程线: 取值0<=X<=100 步进为1e-4

用trans_format运算一次 转化为lisp表达式计算,

只要给出不同的x就可以算出对应的y,

cal/vbs呵呵你总不可以"a=* : for i = 1 to 10000...."来计算吧!

就是一个变量就足以说明与实际应用结合之后的效率问题,

不管你有多快~如果不能用"变量"快了也没用! 用了"变量"后,这下看你还快不快!!

如果没有一个"变量"计算多次的结果还是一样的,去计算N次也就没有意义了哦!

highflybir:建议，函数不应局限于lisp中的有限几个，可以扩展一些。

回: 谢谢提议,不过现在程序就是可以运算自定义函数的啊!

来个简明的:

(defun test (a b)
  (+ (* a b) (/ a b))
)

_$ (eval (trans_format "test(5,6)"))
30.8333

highflybir

狂刀无痕发表于2007-7-25 20:27:00不得不说,编译我vlx后lisp的速度确优化了不少.因为vlx被编译为一种介lisp和机器码之间的编码,所以速度提高.虽然不是数量级的差别,但是也不会基本打平拉 (我的电脑cpu是 amd3200 内存512兆),另外

对于1百万次的运算才相差一秒，我认为这个结果是可以接受的。而且用lisp语言就能完成这个功能，而不用其他语言，所以我认为fxsm的程序是有效的。

至于你说的误差，我想也许你可能没弄清楚lisp的递增加法和vb的不同之处。-这并不是lisp的计算出现失误，相反我认为是正确的，你得出的最后结果反而是错误的。

因为我们知道：计算机计数是从0开始，假设要重复运算10次，那么实际上第10次平方应该是9X9=81,而不是10X10=100,

这就是为什么在10次以内存在19的差距。lisp是先求值后计数器加1。（当然你也可以改变这流程）

在我的电脑上是持平的，也许电脑可能有差别，我的电脑是1G内存，3.0G intel pentium D。不同的cpu对浮点运算是有区别的。