Next up, dual number elliptic integrals... and a mystery.
The programs
DNEK,
DNEE,
DNEΠ and
DNEN compute respectively the dual number versions of K(k), E(k), Π(n, k) and q(k), the elliptic nome. They use the programs from
this thread on elliptic integrals. I am also including translations of the programs
DAGM and
DELK from the Double ROM manual.
Ángel Martin’s
Double ROM manual has programs for dual number AGM and E(k). The example on p.34 gives a value of -2.622842115+ε*2.858860658 for the input 0.5+ε, whereas with the same input I get the value 1.68575035482+ε*.541731848587 with both
DNEK and
DELK. Perhaps someone who is an HP-41 user familiar with the Double ROM can check my results and explain the different results.
I am listing the program as a directory including all dual number and elliptic integral programs needed to run them. The directory is thus self-contained and can be used with any RPL calculator, although the names of programs for Π(n, k) will have to be changed for the HP-28 due to its character set not having
Π.
Code:
DIR
DNEK
\<< DC\->R OVER Kk
ROT ROT SWAP dKk * R\->C
\>>
DNEE
\<< DC\->R OVER EKk DROP
ROT ROT SWAP dEk * R\->C
\>>
DNE\PI
\<< DC\->R ROT ROT DUP2 d\PIdk
ROT ROT \PInk ROT ROT * R\->C
\>>
DNEN
\<< DC\->R OVER ENOME
ROT ROT SWAP dNOME * R\->C
\>>
DAGM
\<<
IF DUP RE
THEN
DO DUP ROT ROT DUP2 + 2 DDIV
ROT ROT DMUL DSQRT
UNTIL ROT OVER ==
END DROP
END
\>>
DELK
\<< \pi \->NUM 1 ROT DSQ - DSQRT
1 SWAP DAGM DUP + DDIV
\>>
dKk
\<< 1 OVER SQ - OVER EKk
3 PICK * - ROT ROT * /
\>>
dEk
\<< DUP EKk - SWAP /
\>>
dNOME
\<< DUP ENOME \pi SQ \->NUM *
SWAP 1 OVER SQ - OVER Kk SQ
ROT 2 * * * /
\>>
d\PIdk
\<<
IF OVER ABS
THEN DUP2 \PInk ROT ROT DUP EKk DROP
OVER SQ 1 - /
4 ROLL + OVER *
ROT ROT SQ - /
ELSE NIP dKk
END
\>>
Kk
\<< DUP ABS 1
IF \=/
THEN 1 1 ROT SQ - \v/
DO DUP ROT ROT DUP2 + 2 /
ROT ROT * \v/
UNTIL ROT OVER ==
END DROP 2 * \pi \->NUM SWAP /
ELSE DROP MAXR \->NUM
END
\>>
EKk
\<< DUP ABS 1
IF \=/
THEN 1 SWAP SQ DUP2 - \v/
ROT 3 PICK 2 / 4 ROLLD .5 ROT ROT
WHILE ROT 2 * ROT ROT
DUP ROT ROT DUP2 * \v/
ROT ROT + 2 / ROT OVER \=/
REPEAT 4 ROLL OVER 4 * / SQ
4 PICK OVER * 6 ROLL +
5 ROLLD 4 ROLLD
END 5 ROLLD DROP2 DROP
\pi \->NUM SWAP 1 SWAP - OVER *
3 PICK 2 * / ROT 2 * ROT SWAP /
ELSE DROP 1 MAXR \->NUM
END
\>>
PInk
\<<
IF OVER ABS
THEN
IF OVER 1 == OVER ABS 1 == OR
THEN DROP2 MAXR \->NUM
ELSE
IF OVER DUP RE 1 > SWAP IM NOT AND
THEN DROP2 # 203h DOERR
ELSE SWAP 1 1 \-> n s q
\<< 1 1 ROT SQ - \v/ OVER n - ROT ROT
DO 3 DUPN * DUP2 + ROT ROT - OVER /
q * 2 / s 6 ROLLD 6 PICK
OVER + 's' STO 'q' STO
4 ROLL \v/ 2 * / SQ ROT ROT
DUP ROT ROT DUP2 + 2 / ROT ROT * \v/
UNTIL ROT OVER == 5 ROLL s == AND
END ROT ROT DROP2
s n 1 OVER - / * 2 +
\pi \->NUM * SWAP 4 * /
\>>
END
END
ELSE NIP Kk
END
\>>
ENOME
\<< 1 OVER SQ - \v/ Kk
\pi NEG \->NUM * SWAP Kk / EXP
\>>
DC\->R
\<< DUP TYPE 1 SAME
\<< C\->R
\>> 0 IFTE
\>>
DMUL
\<< DC\->R ROT DC\->R
OVER 5 PICK * 5 ROLLD
ROT ROT * ROT ROT * + R\->C
\>>
DDIV
\<< DC\->R ROT DC\->R
4 PICK * OVER 4 ROLL * -
SWAP 3 PICK / ROT ROT SWAP SQ / R\->C
\>>
DSQ
\<< DC\->R OVER SQ
ROT ROT * 2 * R\->C
\>>
DSQRT
\<< DC\->R SWAP \v/
SWAP OVER 2 * / R\->C
\>>
END
And a listing optimized for the HP 49 and 50.
Code:
DIR
DNEK
\<< DC\->R OVER Kk
UNROT SWAP dKk * R\->C
\>>
DNEE
\<< DC\->R OVER EKk DROP
UNROT SWAP dEk * R\->C
\>>
DNE\PI
\<< DC\->R UNROT DUP2 d\PIdk
UNROT \PInk UNROT * R\->C
\>>
DNEN
\<< DC\->R OVER ENOME
UNROT SWAP dNOME * R\->C
\>>
DAGM
\<<
IF DUP RE
THEN
DO DUP UNROT DUP2 + 2. DDIV
UNROT DMUL DSQRT
UNTIL ROT OVER ==
END DROP
END
\>>
DELK
\<< \pi \->NUM 1. ROT DSQ - DSQRT
1. SWAP DAGM DUP + DDIV
\>>
dKk
\<< 1. OVER SQ - OVER EKk
PICK3 * - UNROT * /
\>>
dEk
\<< DUP EKk - SWAP /
\>>
dNOME
\<< DUP ENOME \pi SQ \->NUM *
SWAP 1. OVER SQ - OVER Kk SQ
ROT 2. * * * /
\>>
d\PIdk
\<<
IF OVER ABS
THEN DUP2 \PInk UNROT DUP EKk DROP
OVER SQ 1. - /
4. ROLL + OVER *
UNROT SQ - /
ELSE NIP dKk
END
\>>
Kk
\<< DUP ABS 1.
IF \=/
THEN 1. 1. ROT SQ - \v/
DO DUP UNROT DUP2 + 2. / UNROT * \v/
UNTIL ROT OVER ==
END DROP 2. * \pi \->NUM SWAP /
ELSE DROP MAXR \->NUM
END
\>>
EKk
\<< DUP ABS 1.
IF \=/
THEN 1. SWAP SQ DUP2 - \v/
ROT PICK3 2. / 4. ROLLD .5 UNROT
WHILE ROT 2. * UNROT
DUP UNROT DUP2 * \v/
UNROT + 2. /
ROT OVER \=/
REPEAT 4. ROLL OVER 4. * / SQ
4. PICK OVER * 6. ROLL +
5. ROLLD 4. ROLLD
END 5. ROLLD DROP2 DROP
\pi \->NUM SWAP 1. SWAP - OVER *
PICK3 2. * / ROT 2. * ROT SWAP /
ELSE DROP 1. MAXR \->NUM
END
\>>
\PInk
\<< IF OVER ABS
THEN
IF OVER 1. == OVER ABS 1. == OR
THEN DROP2 MAXR \->NUM
ELSE
IF OVER DUP RE 1. > SWAP IM NOT AND
THEN DROP2 #203h DOERR
ELSE SWAP 1. 1. \-> n s q
\<< 1. 1. ROT SQ - \v/ OVER n - UNROT
DO PICK3 PICK3 PICK3 *
DUP2 + UNROT - OVER /
q * 2. / s 6. ROLLD 6. PICK
OVER + 's' STO 'q' STO
4. ROLL \v/ 2. * / SQ UNROT
DUP UNROT DUP2 + 2. / UNROT * \v/
UNTIL ROT OVER == 5. ROLL s == AND
END UNROT DROP2
s n 1. OVER - / * 2. +
\pi \->NUM * SWAP 4. * /
\>>
END
END
ELSE NIP Kk
END
\>>
ENOME
\<< 1. OVER SQ - \v/ Kk
\pi NEG \->NUM * SWAP Kk / EXP
\>>
DC\->R
\<< DUP TYPE 1. SAME :: C\->R 0. IFTE
\>>
DMUL
\<< DC\->R ROT DC\->R OVER 5. PICK * 5. ROLLD
UNROT * UNROT * + R\->C
\>>
DDIV
\<< DC\->R ROT DC\->R 4. PICK * OVER 4. ROLL * -
SWAP PICK3 / UNROT SWAP SQ / R\->C
\>>
DSQ
\<< DC\->R OVER SQ UNROT * 2 * R\->C
\>>
DSQRT
\<< DC\->R SWAP \v/ SWAP OVER 2 * / R\->C
\>>
END
Search
Member List
Calendar
Help
