Post Reply 
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
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...
Find all posts by this user
Quote this message in a reply
Post Reply 




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