(49G) Arabic to Pseudo-Roman Representation (OEIS A093788) - Gerald H - 09-03-2015 03:46 PM
The programme takes an integer as input & returns the Roman representation in Arabic numerals.
eg For input
1953
otherwise known as
MCMLIII
the programme returns
1000100100050111
which is the letter by letter, left to right, value of the Roman letters.
For further info see
http://oeis.org/A093788
Code:
::
CK1&Dispatch
# FF
::
FPTR2 ^DupQIsZero?
caseSIZEERR
FPTR2 ^Z>S
TOTEMPOB
CODE 00048 8FB97601438F15811137135CD472819F1CCC4C213414F14A14C149171181CD5BE8F34150
NULL$SWAP
DUPLEN$
#1+_ONE_DO
DUPINDEX@
SUB$1#
BINT48
#-
::
DUP#0=
?SEMI
BINT1
#=casedrop
{
Z1_
}
BINT2
#=casedrop
{
Z1_
Z1_
}
BINT3
#=casedrop
{
Z1_
Z1_
Z1_
}
BINT4
#=casedrop
{
Z5_
Z1_
}
BINT5
#=casedrop
{
Z5_
}
BINT6
#=casedrop
{
Z1_
Z5_
}
BINT7
#=casedrop
{
Z1_
Z1_
Z5_
}
BINT8
#=case
{
Z1_
Z1_
Z1_
Z5_
}
{
Z10_
Z1_
}
;
DUP#0=ITE
DROPNULL$
::
INNERCOMP
NULL$SWAP
ZERO_DO
SWAP
Z10_
JINDEX@
#1-
FPTR2 ^RP#
FPTR2 ^RMULText
FPTR2 ^Z>S
&$
LOOP
;
ROT
&$SWAP
LOOP
DROP
FPTR2 ^S>Z
;
;
RE: HP 49G: Arabic to Pseudo-Roman Representation (OEIS A093788) - Gerald H - 09-04-2015 08:10 AM
Here a slightly improved version of the programme:
Code:
::
CK1&Dispatch
# FF
::
FPTR2 ^DupQIsZero?
caseSIZEERR
FPTR2 ^Z>S
NULL$SWAP
DUPLEN$
ZERO_DO
DUP
ISTOP-INDEX
SUB$1#
BINT48
#-
::
DUP#0=csDROP
::
BINT1
#=casedrop
{
Z1_
}
BINT2
#=casedrop
{
Z1_
Z1_
}
BINT3
#=casedrop
{
Z1_
Z1_
Z1_
}
BINT4
#=casedrop
{
Z5_
Z1_
}
BINT5
#=casedrop
{
Z5_
}
BINT6
#=casedrop
{
Z1_
Z5_
}
BINT7
#=casedrop
{
Z1_
Z1_
Z5_
}
BINT8
#=case
{
Z1_
Z1_
Z1_
Z5_
}
{
Z10_
Z1_
}
;
INNERCOMP
NULL$SWAP
ZERO_DO
SWAP
Z10_
JINDEX@
FPTR2 ^RP#
FPTR2 ^RMULText
FPTR2 ^Z>S
&$
LOOP
ROT
&$SWAP
;
LOOP
DROP
FPTR2 ^S>Z
;
;
RE: HP 49G: Arabic to Pseudo-Roman Representation (OEIS A093788) - Gerald H - 02-21-2017 11:51 AM
Another improved(?) version:
Code:
::
CK1&Dispatch
# FF
::
FPTR2 ^DupQIsZero?
caseSIZEERR
{
{
Z1_
}
{
Z1_
Z1_
}
{
Z1_
Z1_
Z1_
}
{
Z1_
Z5_
}
{
Z5_
}
{
Z5_
Z1_
}
{
Z5_
Z1_
Z1_
}
{
Z5_
Z1_
Z1_
Z1_
}
{
Z1_
Z10_
}
}
NULL$
ROT
FPTR2 ^Z>S
DUPLEN$
ZERO_DO
DUP
ISTOP-INDEX
SUB$1#
BINT48
#-
::
DUP#0=csedrp
NULL$
4PICKSWAP
NTHCOMPDROP
INNERCOMP
NULL$SWAP
ZERO_DO
SWAP
Z10_
JINDEX@
FPTR2 ^RP#
FPTR2 ^RMULText
FPTR2 ^Z>S
SWAP&$
LOOP
;
ROT
&$SWAP
LOOP
DROPSWAPDROP
FPTR2 ^S>Z
;
;
|