Conversion: Algebraic - Polish - Reverse Polish - LISP ?

[Martin Hepperle]

Recently I have been playing with old LISP implementations on MS-DOS, namely muLISP from Soft Warehouse in Hawaii (which are also known for muMATH and Derive, both written in muLISP).

When implementing numeric algorithms, it is rather cumbersome and error prone to write more complex nested expressions in LISP (e.g. polynomial approximations).

It would be nice if I could use (at least for crosschecking) a translator program which would take an algebraic expression like

Code:

x*(1+x*(1-x))*sin(x)

and convert it to the equivalent LISP form:

Code:

(* (* x (+ 1 (* x (- 1 x)))) (SIN x))

or (with the outer multiplications combined):

Code:

(* x (+ 1 (* x (- 1 x))) (SIN x))

For RPN friends: the LISP code is written in Polish Notation (PN) - the operator is placed before the operands and (depending on LISP variant) can operate on multiple operands (e.g.: (+ 1 2 3 4) would sum all four numbers in one go, the same can be achieved with a dyadic '+' operator by nesting multiple (+...) blocks, which is close to RPN or RPL).

At the same time such a tool could also produce output in PN or RPN notation.

Some time ago I wrote a BASIC implementation of the "shunting yard algorithm" to create RPN from algebraic expressions and could rework this, but maybe there is already a tool available for this purpose.
Something written in RPL for the HP 4x family of calculators would be an option - it is not necessary to run this on the PC or write it in LISP.

Martin

[Thomas Klemm]

(11-01-2024 09:52 AM)Martin Hepperle Wrote:  Something written in RPL for the HP 4x family of calculators would be an option

On the HP-48 you can run the TEACH command, which creates an EXAMPLES directory.
In the PRGS subdirectory you will find the following program →RPN:

Code:

« OBJ→
  IF OVER
  THEN → n f
    « 1 n
      FOR i
        IF DUP TYPE 9 SAME
        THEN →RPN
        END n ROLLD
      NEXT
      IF DUP TYPE 5 ≠
      THEN 1 →LIST
      END
      IF n 1 >
      THEN 2 n
        START +
        NEXT
      END f +
    »
  ELSE 1 →LIST SWAP DROP
  END
»

The algebraic expression 'x*(1+x*(1-x))*SIN(x)' is converted into an RPN program:

{ x 1 x 1 x - * + * x SIN * }

Using REVLIST we can reverse the list:

{ * SIN x * + * - x 1 x 1 x }

Now we need to insert the missing parentheses:

{ * {SIN x} {* {+ {* {- x 1} x} 1} x} }

Let's swap the arguments of the binary operators:

{* {* x {+ 1 {* x {- 1 x}}}} {SIN x}}

Compare it with:

(* (* x (+ 1 (* x (- 1 x)))) (SIN x))

Maybe you can modify the program to do that automatically for you.

[Albert Chan]

Hi, Martin Hepperle

I am unfamiliar with LISP macros, but I made calc macro for Chez scheme.
It by-passed Scheme built-in syntax extensions, work directly with syntax-objects, thus compile very fast.

Of course, same code work with quoted objects too.
Here, I strip out Scheme syntax-object manipulations, to produce equivalent function '$'

Code:

(define ^ expt)
(define (process e) (scan (cdr  e) ($ (car e)) '()))
(define (rest e)    (scan (cddr e) ($ (cadr e)) '()))
(define (do-term a term)    (set-car! (cdr term) a) term)
(define (build a term)      (fold-left do-term a term))

(define (scan e a term)
    (cond
        ((null? e)
            (build a term))
        ((memq (car e) '(+ -))
            (if (null? (cdr e))
                (build (list (car e) a) term)       ; unary +/- in front
                (if (memq (cadr e) '(+ - * / ^ @))  ; unary +/- after op
                    (scan (cdr e) (list (car e) a) term)
                    (list (car e) (rest e) (build a term)))))
        ((memq (car e) '(* /))
            (scan (cddr e) ($ (cadr e)) (cons (list (car e) #f a) term)))
        ((eq? (car e) '^)
            (scan (cddr e) (list (car e) ($ (cadr e)) a) term))
        ((eq? (car e) '@)
            (scan (cddr e) (list ($ (cadr e)) a) term))            
        (else  ; implied multiply
            (scan (cdr  e) ($ (car e)) (cons (list '* #f a) term)))))

(define ($ e) ; infix -> prefix
    (cond
        ((atom? e)               e)     ; nothing to do
        ((eq? (car e) '@) (cons (cadr e) (map $ (cddr e)))) ; (@ f ...) -> (f ...)        
        (else (process (reverse e)))))  ; process in reverse

(defmacro ($$ . arg) (eval ($ arg)))

scheme> ($ '(x (1 + x (1 - x)) (@ sin x)))
(* (* x (+ 1 (* x (- 1 x)))) (sin x))

(12-23-2022 02:59 AM)Albert Chan Wrote:  And, for Mach number test. Spaces are needed to separate the tokens.

scheme> (sqrt (calc 5 *(((((1 + .2 *(350 / 661.5)^ 2)^ 3.5 - 1)* (1 - 6.875E-6 * 25500)^ - 5.2656)+ 1)^ .286 - 1)))
0.8357245351752515

scheme> (def v ($ '(5 *(((((1 + .2 *(350 / 661.5)^ 2)^ 3.5 - 1)* (1 - 6.875E-6 * 25500)^ - 5.2656)+ 1)^ .286 - 1))))
scheme> (sqrt (eval v))
0.8357245351752515

Note: this is not the right way to evaluate complicated expression. It should have broken up.

Udpate:
1. unary @ operator now process f arguments
2. infix @ operator added
3. $​​$ macro added, for convenience

[Thomas Klemm]

It turned out to be easier than I expected.
Save the following program in →PN:

Code:

« OBJ→
  IF OVER
  THEN → n f
    « 1 n
      FOR i
        IF DUP TYPE 9 SAME
        THEN →PN
        END 1 →LIST n ROLLD
      NEXT
      IF n 1 >
      THEN 2 n
        START +
        NEXT
      END f SWAP +
    »
  ELSE 1 →LIST SWAP DROP
  END
»

Example

'x*(1+x*(1-x))*SIN(x)'
→PN

{ * { * x { + 1 { * x { - 1 x } } } } { SIN x } }

[FLISZT]

Hello,

Martin, I don't know if you're aware of these 3 links below, but perhaps they might be of interest to you (or to other persons).

• Lisp compiler for HP 28S.
• For HP 48SX from same author. In fact, this is the program for the 28S, downloadable but less readable IMHO.
  The 1st one is perfect for a printing. Both contain comments.
• Quote: "Takes an algebraic or a list and converts it to a Lisp expression." (for RPL calculators ≥ HP 49G)
  

[John Keith]

(11-01-2024 07:08 PM)Thomas Klemm Wrote:  It turned out to be easier than I expected.
Save the following program in →PN:

Code:

« OBJ→
  IF OVER
  THEN → n f
    « 1 n
      FOR i
        IF DUP TYPE 9 SAME
        THEN →PN
        END 1 →LIST n ROLLD
      NEXT
      IF n 1 >
      THEN 2 n
        START +
        NEXT
      END f SWAP +
    »
  ELSE 1 →LIST SWAP DROP
  END
»

Very neat program! One question: Is there a reason that the first loop is a FOR loop rather than a START loop? I don't see a reference to i anywhere in the program.

[Thomas Klemm]

(11-02-2024 12:57 PM)John Keith Wrote:  One question: Is there a reason that the first loop is a FOR loop rather than a START loop? I don't see a reference to i anywhere in the program.

I didn't put too much effort into it. I just single stepped through the original →RPN program and noticed that I had to put everything into a list using: 1 →LIST.
But this made the following check for list obsolete: TYPE 5 ≠. Therefore I dropped that.
And then I had to insert a SWAP so that the operator in the local variable f is added to the head of the list.
Therefore you'd have to ask the developer of the TEACH command.

Thinking about optimizations we might also combine both loops into a single one.

[Thomas Klemm]

Or then use DOLIST:

Code:

 « OBJ→
  IF OVER
  THEN → f
    « →LIST 1
      «
        IF DUP TYPE 9 SAME
        THEN →PN
        END
      » DOLIST f SWAP +
    »
  ELSE 1 →LIST SWAP DROP
  END
»

[Thomas Klemm]

A little shorter:

Code:

«
  IF DUP TYPE 9 SAME
  THEN OBJ→ → f
    « →LIST 1
      « →PN
      » DOLIST f SWAP +
    »
  END
»

I am not aware of any algebraic expression that ends with an empty list when OBJ→ is called on it. In such a case, the following DOLIST will fail.

[Martin Hepperle]

Thank you all for the helpful replies and programs.

The first RPL program supplied by Thomas works fine for me.
The second, shorter variant works for expressions with monadic and dyadic operands (which is what I actually need) but fails if the expression which includes functions mith more parameters like INT('SIN(x)',x,1).

I typed the first program into my HP 49G and added a postprocessing program which SREPLaces braces by parentheses and removes the space characters behind resp. before the braces. This simple postprocessor also replaces the square root sign by a "SQRT".

The OBJ→ function benefits from the fact that the expression was already parsed into a tree when it was ENTERed. So the ugly parsing work is already done by the calculator.
Implement the input line parsing myself (e.g. in BASIC or LISP) results in quite elongated code to properly recognize the lexical tokens (numbers, operands, functions, parentheses).
Thank you OBJ→ ;-)

The LISP implementation for the HP 28S, mentioned by Bruno, is astonishing.
It is rather small but still seems to be usable. I will also try to run it on the HP 49G just for the fun of it.

And the example given by Albert Chan demonstrates nicely how LISP-like languages can be used to transform data into code and vice versa. But it seems to be a challenge to translate this to simpler LISPs like muLISP.

Martin

[Thomas Klemm]

(11-03-2024 09:18 AM)Martin Hepperle Wrote:  The second, shorter variant works for expressions with monadic and dyadic operands (which is what I actually need) but fails if the expression which includes functions with more parameters like INT('SIN(x)',x,1).

It works for:

'∫(0,1,SIN(x),x)'
→PN

{ ∫ 0 1 { SIN x } x }

Multiple parameters shouldn't be an issue.

[John Keith]

FWIW, all three of Thomas' programs work with the Mach number formula, returning
{ \v/ { * 5. { - { ^ { + { * { - { ^ { + 1. { * .2 { ^ { / 350. 661.5 } 2. } } } 3.5 } 1. } { ^ { - 1. { * .000006875 25500. } } -5.2656 } } 1. } .286 } 1. } } }.

Another small point: When the number of arguments is 1, DOLIST and DOSUBS work identically and DOSUBS is faster. Also DOSUBS allows null tags which can save a few bytes.

[Thomas Klemm]

I tend to forget these details. Thanks for reminding me.

Code:

«
  IF DUP TYPE 9 SAME
  THEN OBJ→ → f
    « →LIST 1 :: →PN DOSUBS f SWAP +
    »
  END
»

[John Keith]

(11-03-2024 02:22 PM)Thomas Klemm Wrote:  I tend to forget these details. Thanks for reminding me.

Code:

«
  IF DUP TYPE 9 SAME
  THEN OBJ→ → f
    « →LIST 1 :: →PN DOSUBS f SWAP +
    »
  END
»

I tend to obsess over these details. Going even further, for the 49 and 50 with ListExt we can use LMAP instead of DOLIST/DOSUBS when the number of arguments is 1. We now have

Code:


\<<
  IF DUP TYPE 9. SAME
  THEN OBJ\-> \-> f
    \<< \->LIST
      :: \->PN LMAP
      f SWAP +
    \>>
  END
\>>

at 74.5 bytes.

[Albert Chan]

(11-03-2024 09:18 AM)Martin Hepperle Wrote:  And the example given by Albert Chan demonstrates nicely how LISP-like languages can be used to transform data into code and vice versa. But it seems to be a challenge to translate this to simpler LISPs like muLISP.

Scheme to Lisp is almost 1-to-1, with minor changes (define → defun, null? → null, ...)
Below '$', translated to muLisp, tested on Microsoft DOS MuLISP-86 5.10

Code:

(defun ^(x y) (expt x y)) ; need common.lsp expt
(defun process(e)       (scan (cdr  e) ($ (car e)) nil))
(defun rest(e)          (scan (cddr e) ($ (cadr e)) nil))
(defun do-term(a term)  (cons (car term) (cons a (cddr term))))
(defun build(a term)    (reduce do-term term a))

(defun scan(e a term)
    (cond
        ((null e)
            (build a term))
        ((member (car e) '(+ -))
            (if (null (cdr e))
                (build (list (car e) a) term)       ; unary +/- in front
                (if (member (cadr e) '(+ - * / ^ @)); unary +/- after op
                    (scan (cdr e) (list (car e) a) term)
                    (list (car e) (rest e) (build a term)))))
        ((member (car e) '(* /))
            (scan (cddr e) ($ (cadr e)) (cons (list (car e) #f a) term)))
        ((eq (car e) '^)
            (scan (cddr e) (list (car e) ($ (cadr e)) a) term))
        ((eq (car e) '@) ; (f @ x) -> (f x)
            (scan (cddr e) (list         ($ (cadr e)) a) term))
        (else  ; implied multiply
            (scan (cdr  e) ($ (car e)) (cons (list '* #f a) term)))))

(defun $(e) ; infix -> prefix
    (cond
        ((atom e) e) ; nothing to do
        ((eq (car e) '@) (cons (cadr e) (mapcar $ (cddr e)))) ; (@ f ...) --> (f ...)
        (else (process (reverse e)))))  ; process in reverse

(defmacro $$(. _arg) (eval ($ _arg)))

D:\MULISP> mulisp common

; I have not figured out how to load lisp code, so I just cut/paste to muLisp REPL

$ ($ '(x (1 + x (1 - x)) (@ sin x)))
(* (* X (+ 1 (* X (- 1 X)))) (SIN X))

(11-01-2024 06:45 PM)Albert Chan Wrote:  scheme> (def v ($ '(5 *(((((1 + .2 *(350 / 661.5)^ 2)^ 3.5 - 1)* (1 - 6.875E-6 * 25500)^ - 5.2656)+ 1)^ .286 - 1))))
scheme> (sqrt (eval v))
0.8357245351752515

; muLisp does not understand number starting with decimal point, nor exponential notation

$ (setq v ($
'(5 *(((((1 + 0.2 *(350 / 661.5)^ 2)^ 3.5 - 1) *
(1 - 0.000006875 * 25500)^ - 5.2656)+ 1)^ 0.286 - 1))))

(* 5 (- (^ (+ (* (- (^ (+ 1 (* 0.2 (^ (/ 350 661.5) 2))) 3.5) 1) (^ (- 1 (*
0.0000068 25500)) (- 5.2656))) 1) 0.286) 1))

$ (sqrt (eval v))
0.8357245

---

Udpate:
1. unary @ operator now process f arguments
2. infix @ operator added
3. $​​$ macro added, for convenience

$ ($​$ 4 atan @ 1)
3.1415929

4. (defmacro $$(. e) (eval ($ e)))

Changed name of macro arguments, from e to _arg
e cause exp to fail. (e = 2.71828..., needed inside exp)
Coming from hygienic Scheme world, this is unexpected.

Interestingly, replace e with exp is OK too, even for exp.
So ... check out stored constants names, for conflicts.

Below is *before* argument name change.

$ ($​$ exp @ 1)

Nonnumeric Argument Break: (EXP @)
Continue, Break, Abort, Top-level, Restart, System? A

[Albert Chan]

Here is a quick and dirty translation of rpn-aux, from Chez scheme rpn macro
(I cut corners with 'dup', without assigning result to a variable)

Code:

(defun ^(x y) (expt x y)) ; need common.lsp expt
(defun rpn2(lst) (scan2 (cdr lst) (car lst) nil))

(defun scan2(e t s) ; e=expression, t=top of stack, s=stack
    (cond
        ((null e)   ; return stack
            (if (null s) t (cons t s)))
        ((member (car e) '(+ - * / ^))
            (scan2 (cdr e) (list (car e) (car s) t) (cdr s)))
        ((eq (car e) '@)
            (scan2 (cdr e) (list t (car s)) (cdr s)))            
        ((eq (car e) 'swap) 
            (scan2 (cdr e) (car s) (cons t (cdr s))))
        ((eq (car e) 'dup) 
            (scan2 (cdr e) t (cons t s)))
        (else       ; push data
            (scan2 (cdr e) (car e) (cons t s)))))

D:\MULISP> mulisp common

; I have not figured out how to load lisp code, so I just cut/paste to muLisp REPL

$ (rpn2 '(x 1 x 1 x - * + * x sin @ *))
(* (* X (+ 1 (* X (- 1 X)))) (SIN X))

; Mach number example

$ (eval (rpn2
      '(350 661.5 / 2 ^ 0.2 * 1 + 3.5 ^ 1 -
      1 0.000006875 25500 * - -5.2656 ^ *
      1 + 0.286 ^ 1 - 5 * sqrt @)))

0.8357245

[Martin Hepperle]

Albert,

thank you for taking the time to create the muLISP implementation. I will just tried it and in muLISP-90 it works with loading the IRRATNAL.LSP file (for EXPT, SIN, ...).
An expression with a function like SIN having a "complex" argument like SIN(1+X) seems to be out of scope for the LISP version?
($ '(@ SIN (1 + X)))
produces
(SIN (1 + X))
instead of
(SIN (+ 1 X))

I am using muLISP-90 which is a large improvement compared to -85 and -86 and -87.

In muLISP-90 you can
(LOAD XYZ)
to read a file XYZ.LSP into the system (the file name can also be specified as XYZ.LSP or C:XYZ.LSP).

In earlier muLISPs one uses the (RDS XYZ) form and after the input file has been read (RDS) to switch the reader back to the console input stream.
All muLISP versions work well in DOSBox-X.

I think I got muLISP-90 from archive.org, but now I cannot find it there anymore... [EDIT: found, search for "MULISP90" without hyphen: https://archive.org/search?query=muLISP90]
(Unfortunately no manual for muLISP-8x or -9x has ever been scanned)

Martin

[Albert Chan]

(11-04-2024 10:04 AM)Martin Hepperle Wrote:  ($ '(@ SIN (1 + X)))
produces
(SIN (1 + X))
instead of
(SIN (+ 1 X))

My code was for 4 bangers, with function as afterthought. That's why it simply drop the '@'
Here is the updated '$' to recurse f arguments too.

Code:

(defun $(e) ; infix -> prefix
    (cond
        ((atom e) e) ; nothing to do
        ((eq (car e) '@) (cons (cadr e) (mapcar $ (cddr e)))) ; (@ f ...) --> (f ...)
        (else (process (reverse e)))))

$ ($ '(@ SIN (1 + X)))
(SIN (+ 1 X))

$ ($ '(@ f (1 + 2) (2 * 3 ^ 4) (3 * - 3))) ; multiple arguments
(F (+ 1 2) (* 2 (^ 3 4)) (* 3 (- 3)))

$ (eval ($ '(@ sqrt
(5 *(((((1 + 0.2 *(350 / 661.5)^ 2)^ 3.5 - 1) *
(1 - 0.000006875 * 25500)^ - 5.2656)+ 1)^ 0.286 - 1)))))
0.8357245

Quote:(Unfortunately no manual for muLISP-8x or -9x has ever been scanned)

Do you have older muLisp versions documentation?
I still don't know how to quit muLisp (Ctrl-C doesn't work)
For now, I forced undefined function break, then system out.

$ (0)

Undefined Function Break: (0)
Continue, Break, Abort, Top-level, Restart, System? S
Are you sure (Y/N)? Y

Quote:In muLISP-90 you can (LOAD XYZ) to read a file XYZ.LSP into the system

Thanks! load now work!

[Martin Hepperle]

muLISP: zu exit back to the DOS prompt:
(system)
(reminds you of Microsoft BASIC)

Some documentation exists for CP/M versions of muLISP and muMATH, but this is only partially applicable to later versions.

The only documentation I found covering the muLISP-8x versions of muLISP is a Russian web site with more than 100 LISP lessons. They use muLISP-85 and -86 and the short lessons are often referring to these versions of LISP.

I have created a document with this web site translated to English.
See
https://forum.vcfed.org/index.php?thread...ocs.39826/
https://forum.vcfed.org/index.php?attach...f.1288161/
Too large to attach here.

PS: muLISP-90 still has support for cursor positioning for these two systems built-in:
6 = Hewlett-Packard HP-150 Computer
7 = Hewlett-Packard HP-110 Computer
so that this thread is still related to HP computers ;-)

[Albert Chan]

$ ($ '(@ asin (@ acos (@ atan (@ tan (@ cos (@ sin x)))))))
(ASIN (ACOS (ATAN (TAN (COS (SIN X))))))

Unary @ look ugly. Perhaps we add a infix @ too?
Note: infix @ has highest precedence, same as ^

$ ($ '(asin @ acos @ atan @ tan @ cos @ sin @ x))
(ASIN (ACOS (ATAN (TAN (COS (SIN X))))))


$ ($ '((@ exp (- x x / 2)) / (@ sqrt (2 pi))))
(/ (EXP (/ (* (- X) X) 2)) (SQRT (* 2 PI)))

$ ($ '(exp @ (- x x / 2) / sqrt @ (2 pi)))
(/ (EXP (/ (* (- X) X) 2)) (SQRT (* 2 PI)))


Added infix @ rule to my first post here
Also, added $​$ macro, for convenience

$ ($​$ 4 atan @ 1)
3.1415929