Post Reply 
Polynomial with real coefficients —> array w/ real coeff
11-27-2021, 03:33 PM (This post was last modified: 11-27-2021 03:42 PM by Gil.)
Post: #6
RE: Polynomial with real coefficients —> array w/ real coeff
Suppose you execute RCLVX
(to get the current variable)

and you get the variable name 't'.

Suppose that somewhere the 't' variable was already defined, then you will be requested, in the previous program version, to delete that variable 't'.

The question/request might be confusing and there is indeed no reason to delete that variable right now.

That's the purpose of changing, provisory, the current working variable VX into Y__. See then, right below, the added part in bold:

\<< "\[] Long Version 2g
(w/ use of strings)

2021.11.27

\[] 1 ALG Arg (''):

'(ai*X^i +) * 
+ 
+ (ak*X^k +) *  + '

\[] Order not important
\[] ai, ak : 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:
[an an-1a0], an \=/ 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\-> RCLVX DUPDUP \-> vx
\<< EVAL SAME NOT
IF
THEN 'Y\175\175' STOVX
END -105 SF EXPAND vx STOVX
\>>
-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 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
\>>
\>>



As it appears, this version is quite heavy.

A simpler/compacter version 3a is shown below,
with as output the initial argument and the final, resulting array.

\<< "\[] Compact Version 3a
(no use of strings)

2021.11.24

\[] 1 ALG Arg (''):

'(ai*X^i +) * 
+ 
+ (ak*X^k +) *  + '

\[] Order not important
\[] ai, ak : reals
\[] i, k : integers
\[] Any var name(already
existing! or not)

\[] Output:
[an an-1a0]

" DROP RCLF 0 \-> fg v
\<< DUP 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\-> RCLVX DUPDUP \-> vx
\<< EVAL SAME NOT
IF
THEN 'Y\175\175' STOVX
END -105 SF EXPAND -105 CF 'X\175\175' * SIMPLIFY DUP { } \-> f l
\<< DEGREE 1
START f 'X\175\175' / SIMPLIFY DUP 0 'X\175\175' STO \->NUM DUP "\|>" + ".\|>" "" SREPL DROP "\|>" "" SREPL DROP OBJ\-> l + 'l' STO - 'f' STO 'X\175\175' PURGE -1
STEP l OBJ\->
\>> vx STOVX
\>>
ELSE DUP -105 CF DROP2 EVAL "\|>" + ".\|>" "" SREPL DROP "\|>" "" SREPL DROP OBJ\-> 1
END \->ARRY "[ana0]" \->TAG fg STOF
\>>
\>>


Attached File(s)
.doc  P_Arr.Ver.02g.long.Doc (Size: 1.92 KB / Downloads: 4)
.doc  P_Arr.Ver.03.short.Doc (Size: 1,020 bytes / Downloads: 2)
Find all posts by this user
Quote this message in a reply
Post Reply 


Messages In This Thread
RE: Polynomial with real coefficients —> array w/ real coeff - Gil - 11-27-2021 03:33 PM



User(s) browsing this thread: 1 Guest(s)