41 MCODE - Polynomial & Derivatives Evaluation
12-18-2014, 04:24 PM (This post was last modified: 12-19-2014 05:35 PM by Ángel Martin.)
Post: #1
 Ángel Martin Senior Member Posts: 1,436 Joined: Dec 2013
41 MCODE - Polynomial & Derivatives Evaluation
Yes you heard correctly - here's a relatively short MCODE program to evaluate a given polynomial or its 1st. and 2nd. derivatives.

Newsflash: now updated to also calculate the primitive polynomial = i.e. the integral between 0 and x.-

It assumes the coefficients are already entered in contiguous data registers, from Rbb to Ree - where the degree of the polynomial is d = (ee-bb)

With the control word "bbb.eee" in Y and the evaluation point in X, simply execute the corresponding function to obtain the numeric value. In the blink of an eye the result will be returned to X.

Use a negative sign in the control word for the Integral case.

Here's the code for all you hidden-MCoder's, you know who you are ;-)

Code:
 Header    A447    0CC    "L"     Header    A448    050    "P"    Second derivative of Pol Header    A449    0B2    "2"    bbb.eee in Y, x in X Header    A44A    144    "d"    Ángel Martin d2PL2    A44B    0C8    SETF 10         A44C    184    CLRF 11         A44D    344    CLRF 12         A44E    083    JNC +16d    [MAIN2] Header    A44F    0CC    "L"    First derivative of Pol Header    A450    050    "P"    bbb.eee in Y, x in X Header    A451    144    "d"    Ángel Martin dPL2    A452    184    CLRF 11         A453    344    CLRF 12         A454    04B    JNC +09    [MAIN] Header    A455    0CC    "L"    Polynomial Value Header    A456    050    "P"    bbb.eee in Y, x in X PVL2    A457    188    SETF 11    Ángel Martin     A458    344    CLRF 12         A459    0B8    READ 2(Y)    bbb.eee     A45A    2FE    ?C#0 MS    is it negative?     A45B    013    JNC +02    no, skip     A45C    348    SETF 12    yes, -> INTEGRAL! MAIN    A45D    0C4    CLRF 10     MAIN2    A45E    2A0    SETDEC         A45F    0B8    READ 2(Y)    bbb.eee     A460    05E    C=0 MS    absolute value     A461    084    CLRF 5      Take Fractional Part     A462    0ED    ?NC XQ         A463    064    ->193B    [INTFRC]     A464    226    C=C+1 S&X         A465    226    C=C+1 S&X    multiply by 1,000     A466    226    C=C+1 S&X         A467    268    WRIT 9(Q)    eee     A468    0B8    READ 2(Y)    bbb.eee     A469    05E    C=0 MS    absolute value     A46A    088    SETF 5    Take Integer Part     A46B    0ED    ?NC XQ         A46C    064    ->193B    [INTFRC]     A46D    070    N=C  ALL    bbb     A46E    2BE    C=-C-1 MS             sign change     A46F    10E    A=C ALL    -bbb     A470    278    READ 9(Q)    eee     A471    01D    ?NC XQ    eee-bbb     A472    060    ->1807    [AD2_10]     A473    2FA    ?C#0 M     was eee=bbb? ERRDE    A474    0B5    ?NC GO    yes, bail out!     A475    0A2    ->282D    [ERRDE]     A476    2FE    ?C#0 MS    was eee>bbb?     A477    3EF    JC  -03    no, error     A478    001    ?NC XQ    prepare value for loop     A479    060    ->1800    [ADDONE]     A47A    34C    ?FSET 12    integral case?     A47B    001    ?C XQ    yes, one more!     A47C    061    ->1800    [ADDONE]     A47D    1E8    WRIT 7(O)    (n+1)  or (n+2) in O<ALL>     A47E    278    READ 9(Q)    eee in C<ALL>     A47F    260    SETHEX         A480    38D    ?NC XQ    convert C to Hex in C[S&X]     A481    008    ->02E3    [BCDBIN]     A482    18C    ?FSET 11    PVAL case?     A483    02F    JC  +05    yes, no need to adjust limit     A484    0CC    ?FSET 10    2nd. Derivative?     A485    013    JNC +02    no, skip one SECOND    A486    266    C=C-1 S&X    e' = e-2 FIRSTD    A487    266    C=C-1 S&X    e' = e-1 NEWLMT    A488    128    WRIT 4(L)    new limit  saved in [S&X]     A489    0B0    C=N ALL    bbb     A48A    38D    ?NC XQ    convert C to Hex in C[S&X]     A48B    008    ->02E3    [BCDBIN]     A48C    0CC    ?FSET 10    2nd. Derivative?     A48D    043    JNC +08    no, ignore section SECOND    A48E    106    A=C S&X    bbb to A[S&X]     A48F    138    READ 4(L)    eee-2     A490    0A6    A<>C S&X    bbb back to C[S&X]     A491    306    ?A<C S&X    is (eee-2) < bbb ?     A492    01B    JNC   +03    no, we're good to go     A493    04E    C=0 ALL    yes, the result is zero     A494    0A3    JNC +20d    [EXIT] NOTWO    A495    266    C=C-1 S&X    b-1     A496    228    WRIT 8(P)                   (bbb-1) in [S&X]     A497    104    CLRF 8    reset     A498    1A0    A=B=C=0    initial sum LOOP    A499    081    ?NC XQ    pre-selects Chip0      A49A    064    ->1920    [STSCR*]     A49B    1F8    READ 7(O)    k     A49C    1FD    ?NC XQ    {A,B} = C-1     A49D    100    ->407F    [DECC10] - sets DEC     A49E    18C    ?FSET 11    PVAL case?     A49F    033    JNC +06    no, we're ok     A4A0    34C    ?FSET 12    integral case?     A4A1    027    JC  +04    yes, also ok PVAL    A4A2    04E    C=0 ALL         A4A3    35C    PT= 12    C = 1     A4A4    050    LD@PT- 1         A4A5    1E8    WRIT 7(O)    adjustment factor     A4A6    013    JNC +02     RELAY    A4A7    193    JNC  +50d     STITCH    A4A8    260    SETHEX    needed as well     A4A9    138    READ 4(L)    limit in [S&X]     A4AA    106    A=C S&X         A4AB    238    READ 8(P)    n     A4AC    226    C=C+1 S&X    done in HEX!     A4AD    228    WRIT 8(P)                   k+1     A4AE    366    ?A#C S&X    reached the limit?     A4AF    017    JC  +02    no, skip     A4B0    108    SETF 8    yes, flag this      A4B1    358    ST=C XP    reg# for [ADRFCH]     A4B2    011    ?NC XQ         A4B3    000    ->0004    [ADRFCH] - uses F8/9 (!)     A4B4    070    N=C  ALL    ak     A4B5    04E    C=0 ALL         A4B6    270    RAMSLCT    select chip0     A4B7    2A0    SETDEC    not to forget…     A4B8    1F8    READ 7(O)    1, (k-1), or k     A4B9    34C    ?FSET 12    integral case?     A4BA    22D    ?C XQ    yes, 1/(k+1)     A4BB    061    ->188B    [1/X_10]     A4BC    10E    A=C ALL    1, (k-1), or 1/k     A4BD    0CC    ?FSET 10    2nd. Derivative?     A4BE    04B    JNC  +09    no, skip SECOND    A4BF    135    ?NC XQ    k^2     A4C0    060    ->184D    [MP2_10]     A4C1    1F8    READ 7(O)    k      A4C2    2BE    C=-C-1 MS             sign change     A4C3    000    NOP    let carry settle     A4C4    025    ?NC XQ    k^2 - k = k*(k-1)     A4C5    060    ->1809    [AD1-10]     A4C6    10E    A=C ALL     TWONOT    A4C7    0B0    C=N ALL    ak     A4C8    135    ?NC XQ         A4C9    060    ->184D    [MP2_10]     A4CA    0D1    ?NC XQ    partial result     A4CB    064    ->1934    [RCSCR]     A4CC    031    ?NC XQ         A4CD    060    ->180C    [AD2-13]     A4CE    10C    ?FSET 8    last term?     A4CF    02F    JC  +05    yes, exit loop     A4D0    0F8    READ 3(X)    x     A4D1    13D    ?NC XQ           A4D2    060    ->184F    [MP1_10]     A4D3    233    JNC  -58d    loop back     A4D4    34C    ?FSET 12    integral case?     A4D5    023    JNC +04    no, skip     A4D6    0F8    READ 3(X)    x     A4D7    13D    ?NC XQ           A4D8    060    ->184F    [MP1_10] EXIT    A4D9    070    N=C ALL    parameter passing     A4DA    260    SETHEX         A4DB    175    ?NC XQ    Adjust F10/11/12 Status     A4DC    114    ->455D    [ADJF10]     A4DD    3AD    PORT DEP:    Abandon ship     A4DE    08C    GO    in orderly fashion     A4DF    13E    ->AD3E    [NFRX2]
"

What you say, no MCODE capability? No worries, just download the SandMatrix Module revision "N" and take it for a spin...

"To live or die by your own sword one must first learn to wield it aptly."
 « Next Oldest | Next Newest »

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