리습 강좌 - 리습으로 만든 계산기 함수.

본 강좌는 아키오피스(김희태)에 의해 만들어 졌으며 어떠한 웹이나
출판물에 아키오피스(김희태)의 동의없이 올리는 것을 허락하지 않습니다.

 

리습으로 cal 과 비슷한 함수를 구현해 보았습니다.
쓸수있는 연산자는 더하기 "+", 빼기 "-", 곱하기 "x or X or *", 나누기 "/" 입니다.
중첩 괄호가 가능합니다.


(vl-kht-cal 산술식문자열)

=> 산술식이 올바르면 계산된 값을 리턴.

(vl-kht-cal "600 - (70 x (20 x (5 + 4 - 7)) X 6 / 2 + 3)")

=> -7803.0

(vl-kht-cal "((25 + (70 / 20 / (5 + 4) + 7) * 6 - 200 + 500 ) - 1000) * 3" )

=> -1892.0

(vl-kht-cal "2*3*100.53+3/2+23.63/4/4-200")

=> 406.157

 
코드
  
(defun str-subst (newstr paten stri / n)
  (setq n 0)
  (while (and (setq n (vl-string-position (ascii paten) stri n)) (/= stri (setq stri (vl-string-subst newstr paten stri n ))))
    (setq n (+ n (strlen newstr)))
  )
  stri
)


(defun str-count (paten stri / n)
  (setq n 0)
  (while (/= stri (setq stri (vl-string-subst "" paten stri))) (setq n (1+ n)) )
  n
)
	    


(defun vl-kht-cal (a / vl-kht-cal-sub  chk1 chk2 exchk1 exchk2 ex)

  (defun vl-kht-cal-sub (a / app+- app*/ ex)
    (mapcar '(lambda (x)
               (if (/= 'SYM (type x)) (setq x (if (listp x) (vl-kht-cal-sub x) (float x))))
               (cond
                 ((or (= '* x) (= '/ x))
                  (setq app*/ (list x ex))
                 )
                 ((or (= '+ x) (= '- x))
                  (if (and app*/ (= 2 (length app+-)) (or (= '+ (car app+-)) (= '- (car app+-))))
                    (setq app+- (list x (append app+- (list app*/))) app*/ nil)
                    (setq app+- (list x (if app+- (append app+- (list ex)) ex)) app*/ nil)
                  )
                 )
                 ((and (= 2 (length app*/)) (or (= '* (car app*/)) (= '/ (car app*/))))
                  (setq app*/ (append app*/ (list x)) ex app*/)
                 )
                 (t (setq ex x))
               )
             )
           a
    )
    (if app+-
      (append app+- (list ex))
      app*/
    )
  )
  

  (if (or (/= "(" (substr a 1 1)) (/= ")" (substr a (strlen a))))
    (setq a (strcat "(" a ")"))
  )
  (mapcar '(lambda (x y) (setq a (str-subst x y a)))
          '(""  "*" "*" " * " " (" ") " " + " " - " " / ")
          '("," "x" "X" "*"   "("  ")"  "+"   "-"   "/"  )
  )
  (setq chk1   (str-count "(" a)
        chk2   (str-count ")" a)
        ex     (vl-princ-to-string (read a))
        exchk1 (str-count "(" ex)
        exchk2 (str-count ")" ex)
  )
  (cond
    ((or (/= chk1 exchk1) (/= chk2 exchk2))
     (princ "\n 괄호의 갯수가 맞지않거나 잘못되었습니다.")
     nil
    )
    ((not (vl-every '(lambda (x) (or (= '- x) (= '+ x) (= '* x) (= '/ x) (= 'INT (type x)) (= 'REAL (type x))))
                    (read (strcat "(" (str-subst "" ")" (str-subst "" "(" a)) ")") )
     ))
     (princ "\n잘못된 연산자나 숫자를 입력했습니다.")
     nil
    )
    (t (eval (vl-kht-cal-sub (read a))))
  )
)