[SOLVED] DSRN (dog slow roman numerals)

[DavidM]

(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                                  )
  ;
;