(06-13-2014 05:40 PM)rprosperi Wrote: Please do share it. The folks that know SysRPL will enjoy it (and likely attempt to improve it) and the folks that don't will get a taste of what SysRPL is like, to compare. Also, please post the analogous performance numbers as an additional incentive for the non-SysRPL folks.
OK. This was what I started out with, and there's certainly room for improvement.
To help those less familiar with SysRPL, I've included lots of comments to help clarify what the code is doing. This probably makes the code seem bigger than it really is; in compiled form, it only consumes 301.5 bytes. All of the UserRPL examples are larger than that, although Thomas' last submission is close at 318.5 bytes.
From a performance standpoint, when I test this code using the same loop as the others (converting 1000-1499) it shows a cycle time of 0.01923 sec.
Here's the code:
Code:
RPL
( constants [and their definitions] used by the app )
DEFINE TotalLAMs BINT3
DEFINE RomNumSub 1GETLAM EVAL
DEFINE GetResult 2GETLAM
DEFINE PutResult 2PUTLAM
DEFINE GetCurVal 3GETLAM
DEFINE PutCurVal 3PUTLAM
::
CK1NOLASTWD ( must have at least one item on stack )
CK&DISPATCH1 ( check the value's type [real or zint->real] )
real
::
COERCE ( LAM 3 - CurVal [converted to a BINT] )
NULL$ ( LAM 2 - Result )
' :: ( LAM 1 - RomNumSub subroutine )
( upon entry: SL2-> String, SL1-> Magnitude )
GetCurVal SWAP #/ ( divide current value by magnitude )
( note: #/ returns #r #q )
SWAP PutCurVal ( save remainder as new current value, )
( leave quotient on stack )
NDUPN ( make [quotient] copies of roman numerals )
DUP#0<> ( check to see if any digits need to be added )
ITE
:: ( yes - accumulate digits )
BEGIN
#1-DUP #0<> ( loop 1 less time than # of duplicates )
WHILE
:: UNROT &$SWAP ; ( combine digits, swap counter into SL1 )
REPEAT
DROP ( drop the duplicate count )
GetResult SWAP&$ PutResult ( append the new digits to the result )
;
DROP ( no digits to add - just drop the count )
;
NULLLAM TotalLAMs NDUPN DOBIND ( Bind LAMs )
( build the result string )
"M" # 3E8 RomNumSub ( 1000 )
"CM" # 384 RomNumSub ( 900 )
"D" # 1F4 RomNumSub ( 500 )
"CD" # 190 RomNumSub ( 400 )
"C" BINT100 RomNumSub ( 100 )
"XC" BINT90 RomNumSub ( 90 )
"L" BINT50 RomNumSub ( 50 )
"XL" BINT40 RomNumSub ( 40 )
"X" BINT10 RomNumSub ( 10 )
"IX" BINT9 RomNumSub ( 9 )
"V" BINT5 RomNumSub ( 5 )
"IV" BINT4 RomNumSub ( 4 )
"I" BINT1 RomNumSub ( 1 )
GetResult ( retreive result )
ABND ( abandon LAMs )
;
;