Polynomial with real coefficients —> array w/ real coeff
11-23-2021, 11:23 AM (This post was last modified: 11-23-2021 01:44 PM by Gil.)
Post: #4
 Gil Senior Member Posts: 637 Joined: Oct 2019
RE: Polynomial with real coefficients
Version 2b

As a special "polynomial", now you can introduce such non simplified expressions
'2*x-2*x',
'3*x-x^2+4-x^2-4+-3*x' and alike always equal to zero.

The output will be, for the first one:
'2*x-2*x' (original input expression at stack level 3)
0 (simplified, "cleanest" expression, here always without a dot, at stack level 2)
an...a0: [0] (smallest possible array, here always without a dot, with a tag label, at stack level 1).

This version, as the previous one, accepts, as input, just a variable name (then never evaluated), existing or not in the directory, or only one or several real/integer numbers.

't' P—>ARR returns
't' (original input expression, here the variable t, in stack level 3)
't' (simplified, cleanest" expression, but never evaluated for a single variable, here then the variable name t again)
an...a0: [1 0] (smallest possible array, with a tag label, at stack level 1).

'120-20.' P—>ARR returns
'120-20.' (original input expression in stack level 3)
100 (simplified expression/value, if possible without a dot like here, in stack level 2)
an...a0: [100] (smallest possible array, if possible without dots like here, with a tag label, at stack level 1).

'0.' P—>ARR returns
0. (original input expression/value in stack level 3)
0 (simplified expression/value in stack level 2, if possible without a dot like here)
an...a0: [0] (smallest possible array, if possible without a dot like here, with a tag label).

Just in case, here is the full code:

\<< "\[] Version 2b
2021.11.23

\[] 1 ALG Arg (''):

'(ai*X^i +) *
+
+ (ak*X^k +) *  + '

\[] Order not important
\[] ai, ak : reals
\[] i, k : integers
existing! or not)
\[] By default: Polynom.
degree is n.MAX=15
(to change it: 1st
instruction after
DROP, 6 lines below)

\[] Output:
[an an-1a0], an \=/ 0

" DROP 15 RCLF 0 0 0 0 \-> d.MAX fg s STR p v
\<< DUP d.MAX XQ 'd.MAX' STO LVAR DUP TYPE 5 \=/
IF
THEN DUP OBJ\-> OBJ\-> DROP XQ \-> nv
\<< nv 1 >
IF
THEN nv \->LIST \->STR nv "Here " SWAP + " var
" + SWAP + ":

Use only 1 !" + SWAP ROT DROP2 DOERR
END
\>> SWAP DROP "" + 'v' STO \->STR v "X\175\175" SREPL DROP OBJ\-> -105 SF EXPAND -105 CF \->STR "+-" "-" SREPL DROP "-(" "+" SREPL 0 >
IF
THEN ")" "" SREPL DROP "E-" "E\175" SREPL DROP "-" "\175\|>" SREPL DROP "+" "-" SREPL DROP "\175\|>" "+" SREPL DROP "E\175" "E-" SREPL DROP
END ".+" "+" SREPL DROP ".-" "-" SREPL DROP ".*" "*" SREPL DROP ".'" "'" SREPL DROP "\|>" + ".\|>" "" SREPL DROP "\|>" "" SREPL DROP DUP "X\175\175" v SREPL DROP OBJ\-> SWAP "+X\175\175" "+1*X\175\175" SREPL DROP "-X\175\175" "-1*X\175\175" SREPL DROP "'X\175\175" "'+1*X\175\175" SREPL DROP "'" "" SREPL DROP DUP SIZE 's' STO 'STR' STO { } d.MAX 2 XQ
FOR i STR "^" i + POS 'p' STO p 0 \=/
IF
THEN STR 1 p 5 - SUB OBJ\-> STR p i \->STR SIZE + 1 + s SUB DUP SIZE 's' STO 'STR' STO
ELSE 0
END + -1 XQ
STEP STR DUP "X" POS DUP 'p' STO 2 - 1 SWAP SUB DUP "" \=/
IF
THEN OBJ\->
ELSE DROP 0
END + STR p DUP 0 \=/ 3 1 IFTE + s SUB DUP "" \=/
IF
THEN OBJ\->
ELSE DROP 0
END + DUP SIZE { 0 } \-> l s l0
\<< 1 d.MAX 1 +
FOR i l i GET 0 \=/
IF
THEN l 'l0' STO d.MAX 1 + 'i' STO
END
NEXT l0 l SAME
IF
THEN
REPEAT l0 TAIL 'l0' STO
END
END l0 OBJ\->
\>>
ELSE DROP EVAL \->STR "'" + ".'" "" SREPL DROP OBJ\-> DUP 1
END \->ARRY "[ana0]" \->TAG fg STOF
\>>
\>>

Other format (with non readable characters ):

« " Version 2b
2021.11.23

 1 ALG Arg (''):

'(ai*X^i +) *
+
+ (ak*X^k +) *  + '

 Order not important
 ai, ak : reals
 i, k : integers
existing! or not)
 By default: Polynom.
degree is n.MAX=15
(to change it: 1st
instruction after
DROP, 6 lines below)

 Output:
[an an-1a0], an  0

" DROP 15 RCLF 0 0 0 0  d.MAX fg s STR p v
« DUP d.MAX XQ 'd.MAX' STO LVAR DUP TYPE 5 
IF
THEN DUP OBJ OBJ DROP XQ  nv
« nv 1 >
IF
THEN nv LIST STR nv "Here " SWAP + " var
" + SWAP + ":

Use only 1 !" + SWAP ROT DROP2 DOERR
END
» SWAP DROP "" + 'v' STO STR v "X¯¯" SREPL DROP OBJ -105 SF EXPAND -105 CF STR "+-" "-" SREPL DROP "-(" "+" SREPL 0 >
IF
THEN ")" "" SREPL DROP "E-" "E¯" SREPL DROP "-" "¯" SREPL DROP "+" "-" SREPL DROP "¯" "+" SREPL DROP "E¯" "E-" SREPL DROP
END ".+" "+" SREPL DROP ".-" "-" SREPL DROP ".*" "*" SREPL DROP ".'" "'" SREPL DROP "" + "." "" SREPL DROP "" "" SREPL DROP DUP "X¯¯" v SREPL DROP OBJ SWAP "+X¯¯" "+1*X¯¯" SREPL DROP "-X¯¯" "-1*X¯¯" SREPL DROP "'X¯¯" "'+1*X¯¯" SREPL DROP "'" "" SREPL DROP DUP SIZE 's' STO 'STR' STO { } d.MAX 2 XQ
FOR i STR "^" i + POS 'p' STO p 0 
IF
THEN STR 1 p 5 - SUB OBJ STR p i STR SIZE + 1 + s SUB DUP SIZE 's' STO 'STR' STO
ELSE 0
END + -1 XQ
STEP STR DUP "X" POS DUP 'p' STO 2 - 1 SWAP SUB DUP "" 
IF
THEN OBJ
ELSE DROP 0
END + STR p DUP 0  3 1 IFTE + s SUB DUP "" 
IF
THEN OBJ
ELSE DROP 0
END + DUP SIZE { 0 }  l s l0
« 1 d.MAX 1 +
FOR i l i GET 0 
IF
THEN l 'l0' STO d.MAX 1 + 'i' STO
END
NEXT l0 l SAME
IF
THEN
REPEAT l0 TAIL 'l0' STO
END
END l0 OBJ
»
ELSE DROP EVAL STR "'" + ".'" "" SREPL DROP OBJ DUP 1
END ARRY "[ana0]" TAG fg STOF
»
»

Attached File(s)