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

fjmnch · 发表于 2007-7-21 11:53

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

功能如下:

假设在CAD中输入一个数学式子1):1+4+5*2+(5+5)/2+[(6+6)/2+(5+5)/2]

利用(lisp)程序中的命令js(计算的第一个字母)得出该式子的结果

(1):1+4+5*2+(5+5)/2+[(6+6)/2+(5+5)/2]=31

谢谢高手们帮帮忙..........

zml84 · 发表于 2007-7-21 12:09

这个问题很有意思，

我想按照运算符分级的思路（层层剥皮）是可以。

飞诗(fsxm) · 发表于 2007-7-21 12:22

"{" "[" "]" "}" 之类的要全替换成小括号"(" ")"

CAD中本来就有CAL命令

到了lisp中成了函数 (C:CAL 字符表达式)

试试是你想要的吧~

还有就是调用VBA中的的eval方法来计算

在VBS，js中也有eval函数也可以用vlisp调用的

nonsmall · 发表于 2007-7-21 13:46

三楼说的不错，CAD自带CAL命令。

如果你想编程实现，那就用需要用到类似于实现lisp编辑器的功能，对括号的判断和运算符的移位处理。

highflybir · 发表于 2007-7-21 14:43

这个题目有挑战性。

我以前也有这个想法。

因为用cal的方法或者smallVBA的方法速度上要打一个很大的折扣，特别是VBS，我以前曾经做过试验，对于同一个计算表达式，如果用VBS的方法求，速度要比翻译成lisp的函数慢上100倍。

CAL也没有翻译成lisp的函数的快。而且对于角的度量单位来说，CAL用的是角度，而不是弧度，要转换，很不方便。

当然计算量不大的情况下可以CAL和VBS都可以。如果运算达到上万次就不太适用了。

希望大家共同把这个难题完成。

zml84 · 发表于 2007-7-21 17:17

好主意，那我们就开始挑战吧。。。

lazybug · 发表于 2007-7-21 19:48

highflybir发表于2007-7-21 14:43:00这个题目有挑战性。我以前也有这个想法。因为用cal的方法或者smallVBA的方法速度上要打一个很大的折扣，特别是VBS，我以前曾经做过试验，对于同一个计算表达式，如果用VBS的方法求，速度要比翻

在CAD里手动输入上万次的运算不大现实，其实cal已经足够用了

至于角度单位可以自己写程序处理一下，再调用cal

highflybir · 发表于 2007-7-21 23:12

本帖最后由作者于 2007-7-21 23:14:28 编辑

你没能明白我的意思。

有些情况是可能重复运算某个表达式一万次以上，

譬如，我们得到一个: x^2-sin(x)+[(x-x^2+exp(x))*2-2]之类的复杂表达式，这里x是个变量，要对这个变量计算万次以上的值时，cal就不够用了。

楼主的情况跟这个类似，也都可以用lisp函数来表达。

在很多语言里面，都能把表达式直接翻译成函数，但是lisp中没有，所以我希望能完成这个挑战。

飞诗(fsxm) · 发表于 2007-7-23 21:03

本帖最后由作者于 2007-7-23 21:04:28 编辑

我先起个头,发一个我刚写好的函数~
事实上它的处理速度还是远比不上cal的~
就算是转化之后的格式用eval调用也与cal不相上下,
这一点足够让这个程序找不到实用性~
因为这只是eval函数的速率的问题了!
看看算法也就行了,以后你可能用的

;;;分离出变量与函数
(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 "" (reverse (cons tmp lst)))
)
;;;带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 str (vl-list->string (vl-remove 32 (vl-string->list str))))
;;分离出变量与函数
(setq lst (format1 str))
;;递归处理括号
(setq lst (format2 lst))
;;优先计算开方
(setq lst (format3 lst '(("^" expt))))
;;再次计算乘除取模
(setq lst (format3 lst '(("*" *) ("/" /) ("%" rem))))
;;最后计算加减
(setq lst (format3 lst '(("+" +) ("-" -))))
;;后处理
(car (format4 lst))
)
;;测试1:
(setq str "(1/2+22*2-5)/3^3+2-1e+2*5")
(defun c:t1 ()
(eval (trans_format str))
)
(defun c:t2 ()
(c:cal str)
)
;;测试2:
(defun c:t3 ()
(setq trans_lst (trans_format str))
(repeat 10000
(eval trans_lst)
)
)
(defun c:t4 ()
(repeat 10000
(c:cal str)
)
)

;;;分离出变量与函数
(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 "" (reverse (cons tmp lst)))
)
;;;带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 str (vl-list->string (vl-remove 32 (vl-string->list str))))
  ;;分离出变量与函数
  (setq lst (format1 str))
  ;;递归处理括号
  (setq lst (format2 lst))
  ;;优先计算  开方
  (setq lst (format3 lst '(("^" expt))))
  ;;再次计算  乘 除 取模
  (setq lst (format3 lst '(("*" *) ("/" /) ("%" rem))))
  ;;最后计算 加减
  (setq lst (format3 lst '(("+" +) ("-" -))))
  ;;后处理
  (car (format4 lst))
)
;;测试1:
(setq str "(1/2+22*2-5)/3^3+2-1e+2*5")
(defun c:t1 ()
  (eval (trans_format str))
)
(defun c:t2 ()
  (c:cal str)
)
;;测试2:
(defun c:t3 ()
  (setq trans_lst (trans_format str))
  (repeat 10000
    (eval trans_lst)
  )
)
(defun c:t4 ()
  (repeat 10000
    (c:cal str)
  )
)

zml84 · 发表于 2007-7-23 21:48

对诸如sin、int等函数不好辨别处理啊！

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