+- HP Forums (https://www.hpmuseum.org/forum)
+-- Forum: HP Software Libraries (/forum-10.html)
+--- Forum: HP-41C Software Library (/forum-11.html)
+--- Thread: 41 MCODE - Polynomial & Derivatives Evaluation (/thread-2658.html)
41 MCODE - Polynomial & Derivatives Evaluation - Ángel Martin - 12-18-2014 04:24 PM
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...