Author Topic: Infix to Lisp  (Read 11502 times)

0 Members and 1 Guest are viewing this topic.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Infix to Lisp
« on: May 08, 2012, 07:16:15 AM »
Having a perusal on something else, I decided to try and implement an infix->prefix function. So a user can enter a formula in "normal" format and have lisp evaluate it (without using the cal addon - which is rather slow: as found somewhere else).

Here's my first attempt:
Code - Auto/Visual Lisp: [Select]
  1. (defun ^ (number power) (expt number power))
  2.  
  3. (setq *operators*       '(+ - * / ^)
  4.       *unary-operators* '(1+ 1- abs atan cos exp fix float log sin sqrt)
  5.       *functions*       '(logand logior max min rem))
  6.  
  7. (defun split-list  (lst n / l1 l2 i)
  8.   (setq i (length lst))
  9.   (foreach item  (reverse lst)
  10.     (setq i (1- i))
  11.     (if (< i n)
  12.       (setq l1 (cons item l1))
  13.       (setq l2 (cons item l2))))
  14.   (cons l1 l2))
  15.  
  16. (defun infix->prefix  (infix-expression / split)
  17.   (cond ((not (listp infix-expression)) infix-expression)
  18.         ((= (length infix-expression) 1) (infix->prefix (car infix-expression)))
  19.         ((member (car infix-expression) *functions*)
  20.          (if (cdddr infix-expression)
  21.            (cons (caddr infix-expression)
  22.                  (list (infix->prefix (list (car infix-expression) (cadr infix-expression)))
  23.                        (infix->prefix (cdddr infix-expression))))
  24.            (if (listp (cadr infix-expression))
  25.              (cons (car infix-expression) (mapcar (function infix->prefix) (cadr infix-expression)))
  26.              (list (car infix-expression) (cadr infix-expression)))))
  27.         ((member (car infix-expression) *unary-operators*)
  28.          (append (list (car infix-expression) (infix->prefix (cadr infix-expression)))
  29.                  (infix->prefix (cddr infix-expression))))
  30.         ((> (setq split (car (vl-remove-if
  31.                                'null
  32.                                (mapcar (function (lambda (item) (vl-position item infix-expression))) *operators*))))
  33.             0)
  34.          (list (nth split infix-expression)
  35.                (infix->prefix (car (setq split (split-list infix-expression split))))
  36.                (infix->prefix (cddr split))))
  37.         (t (mapcar (function infix->prefix) infix-expression))))
It appears to work "reasonably:
Code: [Select]
_$ (infix->prefix '(5 ^ 6 / 3 + max ((A / 5) 2) * (8 + 7 * min (4 (9 + 5)) - 5)))
(+ (/ (^ 5 6) 3) (* (MAX (/ A 5) 2) (+ 8 (- (* 7 (MIN 4 (+ 9 5))) 5))))

Now to get a string from user input into a list for conversion seems "easy":
Code - Auto/Visual Lisp: [Select]
  1. (defun infix-read (str / ) (read (strcat "(" str ")")))
Only, there's an issue when asking a user to enter a formula: Sometimes it's acceptable to not have spaces between operators and parameters. E.g. 1+2 should be read as congruent to 1 + 2. But simply adding spaces around each operator would cause problems with negative numbers. Anyone any ideas?
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Infix to Lisp
« Reply #1 on: May 08, 2012, 07:26:01 AM »
Here's a cheats' way:

Code - Auto/Visual Lisp: [Select]
  1. (defun _doMath ( expr / scr res )
  2.     (if (setq scr (vla-getinterfaceobject (vlax-get-acad-object) "ScriptControl"))
  3.         (progn
  4.             (vl-catch-all-apply 'vlax-put-property (list scr 'language "VBScript"))
  5.             (setq res (vl-catch-all-apply 'vlax-invoke (list scr 'eval expr)))
  6.             (vlax-release-object scr)
  7.             (if (not (vl-catch-all-error-p res)) res)
  8.         )
  9.     )
  10. )

Code - Auto/Visual Lisp: [Select]
  1. (_doMath "2+2")

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #2 on: May 08, 2012, 08:00:09 AM »
Even after I've installed this: http://www.microsoft.com/en-us/download/confirmation.aspx?id=1949
I'm getting an error:
Code: [Select]
; error: Automation Error. Problem in loading applicationWhat version of SC are you using?

Anyhow, what's the difference between doing it that way and using the geomcal.arx and its cal function? Actually, it means you can't have variable references inside the formula as you can with the cal function. And it's a bit slow in comparison to eval.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Infix to Lisp
« Reply #3 on: May 08, 2012, 08:12:32 AM »
Even after I've installed this: http://www.microsoft.com/en-us/download/confirmation.aspx?id=1949
I'm getting an error:
Code: [Select]
; error: Automation Error. Problem in loading applicationWhat version of SC are you using?

I believe version 1.0, but afaik its preinstalled with Windows7 Ultimate.

Anyhow, what's the difference between doing it that way and using the geomcal.arx and its cal function? Actually, it means you can't have variable references inside the formula as you can with the cal function. And it's a bit slow in comparison to eval.

Probably no difference, but I just wanted to offer an alternative way to evaluate user-readable mathematical expressions, without the hard work of performing the conversion to LISP.

With respect to your above function, you might find the following function (by Highflyingbird) useful, which used to convert mathematical expressions to LISP:

fxsm-cal.lsp

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #4 on: May 08, 2012, 09:24:16 AM »
Probably no difference, but I just wanted to offer an alternative way to evaluate user-readable mathematical expressions, without the hard work of performing the conversion to LISP.
Thanks! It is nice to see other ways, it's just that I actually wanted to perform this as fast as possible.

Thanks for HyflyingBird's code as well, I'll look at how he's done it previously - perhaps I could use such in mine.

Anyhow, I've found some bugs in mine with the internal functions. My newest version:
Code - Auto/Visual Lisp: [Select]
  1. (defun ^ (number power) (expt number power))
  2.  
  3. (setq *operators*       '(+ - * / ^)
  4.       *unary-operators* '(1+ 1- abs atan cos exp fix float log sin sqrt logand logior max min rem))
  5.  
  6. (defun split-list  (lst n / l1 l2 i)
  7.   (setq i (length lst))
  8.   (foreach item  (reverse lst)
  9.     (setq i (1- i))
  10.     (if (< i n)
  11.       (setq l1 (cons item l1))
  12.       (setq l2 (cons item l2))))
  13.   (cons l1 l2))
  14.  
  15. (defun infix->prefix  (infix-expression / split)
  16.   (cond ((not (listp infix-expression)) infix-expression)
  17.         ((= (length infix-expression) 1) (infix->prefix (car infix-expression)))
  18.         ((member (car infix-expression) *functions*)
  19.          (if (cdddr infix-expression)
  20.            (cons (caddr infix-expression)
  21.                  (list (infix->prefix (list (car infix-expression) (cadr infix-expression)))
  22.                        (infix->prefix (cdddr infix-expression))))
  23.            (if (listp (cadr infix-expression))
  24.              (cons (car infix-expression) (mapcar (function infix->prefix) (cadr infix-expression)))
  25.              (list (car infix-expression) (cadr infix-expression)))))
  26.         ((> (setq split (car (vl-remove-if
  27.                                'null
  28.                                (mapcar (function (lambda (item) (vl-position item infix-expression))) *operators*))))
  29.             0)
  30.          (list (nth split infix-expression)
  31.                (infix->prefix (car (setq split (split-list infix-expression split))))
  32.                (infix->prefix (cddr split))))
  33.         (t (mapcar (function infix->prefix) infix-expression))))
  34.  
  35. (defun infix-read (str / ) (read (strcat "(" str ")")))
Still have an error:
Code: [Select]
_$ (infix->prefix '(sin (5) ^ cos (6) / 3 + max ((A / 5) 2) * (abs 8 + 7 * min (4 (9 + 5)) - atan (5))))
(SIN 5 + (/ (^ COS 6) 3) (* (MAX (/ A 5) 2) (ABS 8 + 7 * MIN (4 (+ 9 5)) - ATAN 5)))
That's just plain WRONG! Will have to do some debugging  :-[
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #5 on: May 08, 2012, 09:29:22 AM »
Actually, sorry  :-[ :'( I had one STUPID mistake:
Code - Auto/Visual Lisp: [Select]
  1. (defun ^ (number power) (expt number power))
  2.  
  3. (setq *operators* '(+ - * / ^)
  4.       *functions* '(1+ 1- abs atan cos exp fix float log sin sqrt logand logior max min rem))
  5.  
  6. (defun split-list  (lst n / l1 l2 i)
  7.   (setq i (length lst))
  8.   (foreach item  (reverse lst)
  9.     (setq i (1- i))
  10.     (if (< i n)
  11.       (setq l1 (cons item l1))
  12.       (setq l2 (cons item l2))))
  13.   (cons l1 l2))
  14.  
  15. (defun infix->prefix  (infix-expression / split)
  16.   (cond ((not (listp infix-expression)) infix-expression)
  17.         ((= (length infix-expression) 1) (infix->prefix (car infix-expression)))
  18.         ((member (car infix-expression) *functions*)
  19.          (if (cdddr infix-expression)
  20.            (cons (caddr infix-expression)
  21.                  (list (infix->prefix (list (car infix-expression) (cadr infix-expression)))
  22.                        (infix->prefix (cdddr infix-expression))))
  23.            (if (listp (cadr infix-expression))
  24.              (cons (car infix-expression) (mapcar (function infix->prefix) (cadr infix-expression)))
  25.              (list (car infix-expression) (cadr infix-expression)))))
  26.         ((> (setq split (car (vl-remove-if
  27.                                'null
  28.                                (mapcar (function (lambda (item) (vl-position item infix-expression))) *operators*))))
  29.             0)
  30.          (list (nth split infix-expression)
  31.                (infix->prefix (car (setq split (split-list infix-expression split))))
  32.                (infix->prefix (cddr split))))
  33.         (t (mapcar (function infix->prefix) infix-expression))))
  34.  
  35. (defun infix-read (str /) (read (strcat "(" str ")")))
Code: [Select]
_$ (infix->prefix '(sin (5) ^ cos (6) / 3 + max ((A / 5) 2) * (abs 8 + 7 * min (4 (9 + 5)) - atan (5))))
(^ (SIN 5) (/ (COS 6) (+ 3 (* (MAX (/ A 5) 2) (+ (ABS 8) (- (* 7 (MIN 4 (+ 9 5))) (ATAN 5)))))))
Slightly closer, though that exponent betwee sin(5) ^ cos(6) seems to go haywire! Something screws up the operator precedence.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Ketxu

  • Newt
  • Posts: 109
Re: Infix to Lisp
« Reply #6 on: May 09, 2012, 12:17:08 AM »
Did i make a wrong test ?
Quote
Command: (infix->prefix '(1+2-3))
1+2-3
Srr, i didn't put spaces. Srr ^^
« Last Edit: May 09, 2012, 12:21:13 AM by Ketxu »

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #7 on: May 09, 2012, 03:27:52 AM »
Yes, that's the issue I've noted at the start. Unfortunately (at this moment) you need to separate the terms & operators by spaces.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #8 on: May 09, 2012, 05:04:03 AM »
I think I've got it!
Code - Auto/Visual Lisp: [Select]
  1. (defun lg (d) (* 0.4342944819032518276511289189166 (log d)))
  2. (defun sqr (d) (* d d))
  3. (defun asin (d) (atan d (sqrt (- 1 (* d d)))))
  4. (defun acos (d) (atan (sqrt (- 1 (* d d))) d))
  5. (defun tan (d) (/ (sin d) (cos d)))
  6. (defun ctan (d) (/ (cos d) (sin d)))
  7. (defun sin2 (d) (sin (* d (/ pi 180))))
  8. (defun cos2 (d) (cos (* d (/ pi 180))))
  9. (defun tan2 (d / r) (setq r (* d (/ pi 180))) (/ (sin r) (cos r)))
  10. (setq ^   expt
  11.       inc 1+
  12.       dec 1-
  13.       ln  log
  14.       mod rem)
  15.  
  16. (defun split-list  (lst n / l1 l2 i)
  17.   (setq i (length lst))
  18.   (foreach item  (reverse lst)
  19.     (setq i (1- i))
  20.     (if (< i n)
  21.       (setq l1 (cons item l1))
  22.       (setq l2 (cons item l2))))
  23.   (cons l1 l2))
  24.  
  25. (defun infix->prefix  (infix-expression / str->lst inf->pre-help placeholders operators functions placeholder-revert)
  26.   (setq operators '(+ - * / ^)
  27.         functions '(ABS ACOS ASIN ATAN COS COS2 CTAN DEC EXP FIX FLOAT INC LG LN LOG LOGAND LOGIOR MAX MIN REM SIN SIN2
  28.                     SQR SQRT TAN TAN2))
  29.  
  30.   ;; Derived from format1 by HyflyingBird
  31.   (defun str->lst  (str / char funs lastfun lst tmp lastchar)
  32.     (vl-load-com)
  33.     (setq lastfun "(")
  34.     (setq funs '("+" "-" "*" "/" "^" "%" "(" ")" " "))
  35.     (setq tmp "")
  36.     (while (/= str "")
  37.       (setq char (substr str 1 1)
  38.             str  (substr str 2))
  39.       (if (and (member char funs)
  40.                (not (and lastfun (/= lastfun ")") (= char "-")))
  41.                (not (and lastchar (or (= char "-") (= char "+")))))
  42.         (progn (setq lst      (vl-list* char tmp lst)
  43.                      tmp      ""
  44.                      lastfun  char
  45.                      lastchar nil)
  46.                (princ))
  47.         (progn (setq tmp (strcat tmp char)) (setq lastfun nil) (setq lastchar (= char "e")) (princ))))
  48.     (read (vl-princ-to-string (vl-remove "" (vl-remove " " (reverse (cons tmp lst)))))))
  49.  
  50.   ;; Helper to recursively prefix the infix list
  51.   (defun inf->pre-help  (infix-expression / split)
  52.     (cond ((not (listp infix-expression)) infix-expression)
  53.           ((= (length infix-expression) 1) (inf->pre-help (car infix-expression)))
  54.           ((member (car infix-expression) functions)
  55.            (setq split        (list (read (strcat "$placeholder" (itoa (length placeholders))))
  56.                                     (car infix-expression)
  57.                                     (cadr infix-expression))
  58.                  placeholders (cons split placeholders))
  59.            (inf->pre-help (cons (car split) (cddr infix-expression))))
  60.           ((> (setq split (car (vl-remove-if
  61.                                  'null
  62.                                  (mapcar (function (lambda (item) (vl-position item infix-expression))) operators))))
  63.               0)
  64.            (list (cadr (setq split (split-list infix-expression split)))
  65.                  (inf->pre-help (car split))
  66.                  (inf->pre-help (cddr split))))
  67.           (t (mapcar (function inf->pre-help) infix-expression))))
  68.  
  69.   ;; Helper to add back the placeholders
  70.   (defun placeholder-revert  (prefix-expression / place)
  71.     (mapcar (function (lambda (item)
  72.                         (cond ((listp item) (placeholder-revert item))
  73.                               ((setq place (assoc item placeholders))
  74.                                (if (listp (caddr place))
  75.                                  (cons (cadr place) (placeholder-revert (mapcar 'inf->pre-help (caddr place))))
  76.                                  (cdr place)))
  77.                               (t item))))
  78.             prefix-expression))
  79.  
  80.   (placeholder-revert
  81.     (inf->pre-help
  82.       (if (listp infix-expression)
  83.         infix-expression
  84.         (str->lst infix-expression)))))
I've used Highflyingbir's format1 function with some slight modification to convert a string into a list. Then I've split out the function references into a later iteration.

Thus far it seems to perform well, even on strings without any spaces:
Code: [Select]
_$ (infix->prefix '(sin (5) ^ cos (1.23423478754359045098) / -3 + max ((A / 5) 2) * (abs 8 + 7 * min (4 (9 + 5)) - atan (5))))
(+ (/ (^ (SIN 5) (COS 1.23423)) -3) (* (MAX (/ A 5) 2) (+ (ABS 8) (- (* 7 (MIN 4 (+ 9 5))) (ATAN 5)))))
_$ (infix->prefix "sin(5)^cos(1.23423478754359045098)/-3+max((A/5)2)*(abs 8+7*min(4(9+5))-atan(5))")
(+ (/ (^ (SIN 5) (COS 1.23423)) -3) (* (MAX (/ A 5) 2) (+ (ABS 8) (- (* 7 (MIN 4 (+ 9 5))) (ATAN 5)))))
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #9 on: May 11, 2012, 06:50:02 AM »
Now, for the graphing functions:
Code: [Select]
(vl-load-com)

;;; Draw a spline along the points defined by evaluating the formula,
;;; incrementing X by a factor from startpoint to endpoint.
;;; forumla   = Prefix (lisp-like) list to be evaluated. Only allowed
;;;             X as a variable
;;; start     = Starting value for X
;;; stop      = End value for X
;;; increment = A number to increment X by at each step
(defun GraphFX2D (formula start stop increment / x lst pt1 pt2 array spline t1 t2 n)
  (setq x stop
        pt2 (list x (eval formula) 0.)
        x start
        pt1 (list x (eval formula) 0.)
        x (- start increment)
        t1 (mapcar '- pt1 (list x (eval formula) 0.))
        x (+ stop increment)
        t2 (mapcar '- (list x (eval formula) 0.) pt2)
        x start
        n 0)
  (while (< (setq x (+ x increment)) stop) (setq lst (append lst (list x (eval formula) 0.))))
  (setq array (vlax-make-safearray vlax-vbdouble (cons 0 (+ 5 (length lst)))))
  (vlax-safearray-fill array (append pt1 lst pt2))
  (setq spline (vla-AddSpline (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-make-variant array) (vlax-3d-point t1) (vlax-3d-point t2)))
  (vla-put-FitTolerance spline 0.)
  (vla-put-Degree2 spline 3)
  (vla-put-SplineFrame spline 1)
  (vla-put-SplineMethod spline 0)
  (while (< (setq x (+ x increment)) stop) (vla-SetFitpoint spline (setq n (1+ n)) (vlax-3d-point x (eval formula) 0.)))
  spline)

;;; Draw a 3d Mesh along the points defined by evaluating the formula,
;;; incrementing X & Y by a factor from startpoint to endpoint.
;;; forumla = Prefix (lisp-like) list to be evaluated. Only allowed
;;;           X and Y as variables
;;; Xstart  = Starting value for X
;;; Xstop   = End value for X
;;; Xincr   = A number to increment X by at each step
;;; Ystart  = Starting value for Y
;;; Ystop   = End value for Y
;;; Yincr   = A number to increment Y by at each step
(defun GraphFX3D (formula Xstart Xstop Xincr Ystart Ystop Yincr / x y m n lst array)
  (setq m 0 y (- Ystart Yincr) Xstop (+ Xstop Xincr) Ystop (+ Ystop Yincr))
  (while (< (setq y (+ y Yincr)) Ystop)
    (setq m (1+ m) x (- Xstart Xincr))
    (while (< (setq x (+ x Xincr)) Xstop)
      (setq lst (cons (eval formula) (cons y (cons x lst)))))
    (if (not n) (setq n (length lst))))
  (setq array (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length lst)))))
  (vlax-safearray-fill array (reverse lst))
  (vla-Add3dMesh (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) m n (vlax-make-variant array)))

Some samples:
(GraphFX2D (infix->prefix "0.2*x^2-5") -10.0 10.0 0.5)

(graphFX3D (infix->prefix "(y^2-x^2)/10.") -10. 10. 0.5 -10. 10. 0.5)

Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

Ketxu

  • Newt
  • Posts: 109
Re: Infix to Lisp
« Reply #10 on: May 19, 2012, 10:34:24 AM »
Thanks Irneb, i  have just made some test :
Quote
Command: (infix->prefix "sin(pi/2)")
; error: bad argument type: listp $PLACEHOLDER0

Command: (infix->prefix "sin(pi/2)+0")
(+ (SIN PI / 2) 0)

Command: (infix->prefix "sin((pi/2))")
; error: bad argument type: listp $PLACEHOLDER0

Command: (infix->prefix "sin((pi/2))+0")
(+ (SIN (/ PI 2)) 0)

Command: (infix->prefix "sqrt(2)")
; error: bad argument type: listp $PLACEHOLDER0



irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #11 on: May 22, 2012, 03:29:15 AM »
Thanks for finding some bugs!  ;)

It helped me fix some code:
Code - Auto/Visual Lisp: [Select]
  1. (defun lg (d) (* 0.4342944819032518276511289189166 (log d)))
  2. (defun sqr (d) (* d d))
  3. (defun asin (d) (atan d (sqrt (- 1 (* d d)))))
  4. (defun acos (d) (atan (sqrt (- 1 (* d d))) d))
  5. (defun tan (d) (/ (sin d) (cos d)))
  6. (defun ctan (d) (/ (cos d) (sin d)))
  7. (defun sin2 (d) (sin (* d (/ pi 180))))
  8. (defun cos2 (d) (cos (* d (/ pi 180))))
  9. (defun tan2 (d / r) (setq r (* d (/ pi 180))) (/ (sin r) (cos r)))
  10. (setq ^   expt
  11.       inc 1+
  12.       dec 1-
  13.       ln  log
  14.       mod rem)
  15.  
  16. (defun split-list  (lst n / l1 l2 i)
  17.   (setq i (length lst))
  18.   (foreach item  (reverse lst)
  19.     (setq i (1- i))
  20.     (if (< i n)
  21.       (setq l1 (cons item l1))
  22.       (setq l2 (cons item l2))))
  23.   (cons l1 l2))
  24.  
  25. (defun infix->prefix  (infix-expression / str->lst inf->pre-help placeholders operators functions placeholder-revert)
  26.   (setq operators '(+ - * / ^)
  27.         functions '(ABS ACOS ASIN ATAN COS COS2 CTAN DEC EXP FIX FLOAT INC LG LN LOG LOGAND LOGIOR MAX MIN REM SIN SIN2
  28.                     SQR SQRT TAN TAN2))
  29.  
  30.   ;; Derived from format1 by HyflyingBird
  31.   (defun str->lst  (str / char funs lastfun lst tmp lastchar)
  32.     (setq lastfun "(")
  33.     (setq funs '("+" "-" "*" "/" "^" "%" "(" ")" " "))
  34.     (setq tmp "")
  35.     (while (/= str "")
  36.       (setq char (substr str 1 1)
  37.             str  (substr str 2))
  38.       (if (and (member char funs)
  39.                (not (and lastfun (/= lastfun ")") (= char "-")))
  40.                (not (and lastchar (or (= char "-") (= char "+")))))
  41.         (progn (setq lst      (vl-list* char tmp lst)
  42.                      tmp      ""
  43.                      lastfun  char
  44.                      lastchar nil)
  45.                (princ))
  46.         (progn (setq tmp (strcat tmp char)) (setq lastfun nil) (setq lastchar (= char "e")) (princ))))
  47.     (read (vl-princ-to-string (vl-remove "" (vl-remove " " (reverse (cons tmp lst)))))))
  48.  
  49.   ;; Helper to recursively prefix the infix list
  50.   (defun inf->pre-help  (infix-expression / split)
  51.     (cond ((not (listp infix-expression)) infix-expression)
  52.           ((= (length infix-expression) 1) (inf->pre-help (car infix-expression)))
  53.           ((member (car infix-expression) functions)
  54.            (setq split        (list (read (strcat "$placeholder" (itoa (length placeholders))))
  55.                                     (car infix-expression)
  56.                                     (cadr infix-expression))
  57.                  placeholders (cons split placeholders))
  58.            (inf->pre-help (cons (car split) (cddr infix-expression))))
  59.           ((> (setq split (car (vl-remove-if
  60.                                  'null
  61.                                  (mapcar (function (lambda (item) (vl-position item infix-expression))) operators))))
  62.               0)
  63.            (list (cadr (setq split (split-list infix-expression split)))
  64.                  (inf->pre-help (car split))
  65.                  (inf->pre-help (cddr split))))
  66.           (t (mapcar (function inf->pre-help) infix-expression))))
  67.  
  68.   ;; Helper to add back the placeholders
  69.   (defun placeholder-revert  (prefix-expression / place tmp)
  70.     (mapcar (function (lambda (item)
  71.                         (cond ((listp item) (placeholder-revert item))
  72.                               ((setq place (assoc item placeholders))
  73.                                (setq tmp (placeholder-revert (inf->pre-help (caddr place))))
  74.                                (if (member (car tmp) (append operators functions))
  75.                                  (cons (cadr place) (list tmp))
  76.                                  (cons (cadr place) tmp)))
  77.                               (t item))))
  78.             (if (listp prefix-expression) prefix-expression (list prefix-expression))))
  79.  
  80.   (if (and (setq placeholders (placeholder-revert (inf->pre-help (if (listp infix-expression)
  81.                                                                    infix-expression
  82.                                                                    (str->lst infix-expression)))))
  83.            (<= (length placeholders) 1)
  84.            (listp (car placeholders)))
  85.     (car placeholders)
  86.     placeholders))
Seems to work fine now:
Code: [Select]
_$ (infix->prefix "sin((pi/2))")
(SIN (/ PI 2))
_$ (infix->prefix "sqrt(2)")
(SQRT 2)
_$ (infix->prefix "sin(pi/2)+0")
(+ (SIN (/ PI 2)) 0)
_$ (infix->prefix "sin(2^3/6)")
(SIN (/ (^ 2 3) 6))
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #12 on: May 22, 2012, 04:53:40 AM »
Another small change to allow for curly / square brackets.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #13 on: May 22, 2012, 05:21:37 AM »
There's one case where I still have a problem, from one of the other threads over here:
Code: [Select]
_$ (infix->prefix "-A*S")
(* -A S)
The problem is that -A might be a symbol instead of meaning (- A).

It is possible to use the "more correct" method of writing it though:
Code: [Select]
_$ (infix->prefix "0-A*S")
(- 0 (* A S))
Or forcing it:
Code: [Select]
_$ (infix->prefix "(- A)*S")
(* (- A) S)
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.

irneb

  • Water Moccasin
  • Posts: 1794
  • ACad R9-2016, Revit Arch 6-2016
Re: Infix to Lisp
« Reply #14 on: May 22, 2012, 12:47:03 PM »
And for those wanting to know why you'd want this routine:
Code: [Select]
(setq infix "2*x^2+5*x+4")
(setq prefix (infix->prefix infix)) ;(+ (* 2 (^ X 2)) (+ (* 5 X) 4))
(setq x 5)
(eval prefix) ;79
(eval (infix->prefix infix)) ;79
(cal infix) ;79.0
(quickbench '((cal infix) (eval (infix->prefix infix)) (eval prefix)))
Benchmarking ... done for 16384 iterations. Sorted from fastest.
Statement                                Increment  Time(ms) Normalize  Relative
--------------------------------------------------------------------------------
(EVAL PREFIX)                                16384      1388      1388      5.40
(cal INFIX)                                   4096      1498      5992      1.25
(EVAL (INFIX->PREFIX INFIX))                  4096      1873      7492      1.00
--------------------------------------------------------------------------------
So it's only slightly slower than sending the infix string to the GeoCal.ARX cal function, but once you've converted the infix string to a prefix list you need only apply the eval function on that - and this is a lot faster than cal.
Common sense - the curse in disguise. Because if you have it, you have to live with those that don't.