Polynomial with real coefficients —> array w/ real coeff

[Gil]

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

\[] Any var name(already
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
WHILE l0 HEAD 0 ==
REPEAT l0 TAIL 'l0' STO
END
END l0 OBJ\->
\>>
ELSE DROP EVAL \->STR "'" + ".'" "" SREPL DROP OBJ\-> DUP 1
END \->ARRY "[ana0]" \->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

ž Any var name(already
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
WHILE l0 HEAD 0 ==
REPEAT l0 TAIL 'l0' STO
END
END l0 OBJ
»
ELSE DROP EVAL STR "'" + ".'" "" SREPL DROP OBJ DUP 1
END ARRY "[ana0]" TAG fg STOF
»
»