Post Reply 
Puzzle - RPL and others
04-23-2021, 09:05 PM (This post was last modified: 04-26-2021 10:56 PM by 3298.)
Post: #10
RE: Puzzle - RPL and others
People are posting programs, the 18 hours are over, so here are mine:
- UserRPL, smaller (203.5 bytes, #A034h, 15.2 ... 15.25 seconds):
Code:
\<<
  { { # 0h 0. } }
  1. 9. FOR d
    1. \<<
      EVAL 10. *DUPDUP d MOD - d +
      SWAP 9. + FOR n
        2. n 10. MOD ^ R\->B
        IF DUP2 AND B\->R
        THEN DROP
        ELSE OVER OR n 2. \->LIST SWAP
        END
      d STEP
      DROP
    \>> DOLIST
  NEXT
  EVAL EVAL NIP
\>>
- UserRPL, faster (248 bytes, #3FD8h, 13.62 ... 13.66 seconds):
Code:
\<<
  # 1h
  1. 8. START
    DUP SL
  NEXT
  9. \->LIST
  \-> b \<<
    { { # 0h 0. } }
    1. 9. FOR d
      1. \<<
        EVAL 10. *DUPDUP d MOD - d +
        SWAP 9. + FOR n
          b n 10. MOD GET
          IF DUP2 AND B\->R
          THEN DROP
          ELSE OVER OR n 2. \->LIST SWAP
          END
        d STEP
        DROP
      \>> DOLIST
    NEXT
    EVAL EVAL NIP
  \>>
\>>
In SysRPL I used the same algorithm, but I had to change some things when translating the loops. DOLIST was replaced with my iteration snippet previously posted in the ListExt thread, and the numbers in the inner FOR loop go beyond the range supported by BINTs (which DO ... LOOP, the most direct equivalent of FOR, would use), so that part got a DO ... UNTIL treatment with real numbers.
Adding a cache like the faster UserRPL program yields the fastest SysRPL program I could manage. 190 bytes, #3468h, 3.95 ... 3.97 seconds:
Code:
::
  BINT1
  BINT9 ONE_DO
    DUP #2*
  LOOP
  ' NULLLAM BINT9 NDUPN DOBIND
  { BINT0 %0 } BINT1
  BINT10 ONE_DO
    {}N ZEROSWAP
    ::
      >R IDUP RSAP ticR
      NOTcase COLASKIP RSWAP
      3@REVAL AGAIN
    ;
    ::
      INCOMPDROP %10* DUPINDEX@
      UNCOERCE SWAP 2DUPSWAP %MOD
      %- %+SWAP %9 %+
      BEGIN
        OVER %10 %MOD COERCE GETLAM
        4PICKOVER #AND #0<>
        ITE_DROP
        ::
          4PICK#+ 3PICK TWO{}N
          5UNROLL 4ROLL #1+ 4UNROLL
        ;
        SWAPINDEX@ UNCOERCE %+SWAP
      2DUP %> UNTIL
      3DROP
    ;
  LOOP
  DROP TWONTHCOMPDROP_ ABND
;
I also experimented with another optimization, which consists of replacing the list iteration with an indefinite loop pulling elements out of a meta further up the stack. Surprisingly, this slows things down by about 0.23 seconds - I would've expected the lists to be slower due to the construction of larger objects, but apparently the additional stackrobatics to support metas have the bigger impact. It's smaller though, since the iteration snippet can go, so this is my choice for a small solution. 145 bytes, #2B1Ah, 6.99 ... 7.02 seconds:
Code:
::
  { BINT0 %0 } #ZERO#ONE
  BINT10 ONE_DO
    BEGIN
      OVER#2+UNROL DUP#1+ #2+ROLL
      INCOMPDROP %10* DUPINDEX@
      UNCOERCE SWAP 2DUPSWAP %MOD
      %- %+SWAP %9 %+
      BEGIN
        %2 3PICK %10 %MOD %^ COERCE
        4PICKOVER #AND #0<>
        ITE_DROP
        ::
          4PICK#+ 3PICK TWO{}N
          5UNROLL 4ROLL #1+ 4UNROLL
        ;
        SWAPINDEX@ UNCOERCE %+SWAP
      2DUP %> UNTIL
      3DROP get1 #1-
    #0=UNTIL
    SWAP
  LOOP
  2DROP TWONTHCOMPDROP_
;

About the algorithm I used: it's based on a brute-force approach, but it's skipping parts of the search space with early elimination of candidates. I'm keeping a list of candidates and attempting to append a not-yet-used digit to the candidate number, such that it also satisfies the divisibility condition. This generates a list of longer candidates, which get subjected to the same processing step, until all 9 digits are appended.
Some optimization notes:
- The trait of n leading digits being divisible by n can be expanded down to just the first digit as well, since any number is divisible by 1. Therefore it's possible to use 0 as starting point for building the number, with all 9 non-zero digits available for taking, instead of starting with the numbers 1 to 9 and only applying the expansion procedure from the second digit onwards. This keeps the program a bit smaller.
- In the expansion step I could've kept a list of not-yet-taken digits for each candidate (or calculated them from scratch each time, but screw that, it's too slow), then checked each for divisibility. The divisibility test struck me as a potential performance hazard though, so I opted for the reverse: cycle through the digits satisfying the divisibility condition (evenly spaced by the divisor, and for the first one the expanded candidate can be calculated with just a single modulo operation as \((shorter\_candidate \cdot 10) - ((shorter\_candidate \cdot 10) \mod divisor) + divisor\)), then check using a bitset if the digit is still unused in the candidate.

Edit: the UserRPL listings were swapped. Transcription error only, fixed now.
Find all posts by this user
Quote this message in a reply
Post Reply 


Messages In This Thread
Puzzle - RPL and others - Gene - 04-22-2021, 06:55 PM
RE: Puzzle - RPL and others - rprosperi - 04-23-2021, 04:21 PM
RE: Puzzle - RPL and others - EdS2 - 04-23-2021, 07:30 AM
RE: Puzzle - RPL and others - Dave Britten - 04-23-2021, 12:06 PM
RE: Puzzle - RPL and others - 3298 - 04-23-2021, 09:17 AM
RE: Puzzle - RPL and others - ijabbott - 04-23-2021, 03:57 PM
RE: Puzzle - RPL and others - Albert Chan - 04-23-2021, 04:08 PM
RE: Puzzle - RPL and others - Albert Chan - 04-27-2021, 12:14 PM
RE: Puzzle - RPL and others - 3298 - 04-23-2021 09:05 PM
RE: Puzzle - RPL and others - C.Ret - 04-24-2021, 04:40 PM
RE: Puzzle - RPL and others - C.Ret - 04-25-2021, 09:25 AM
RE: Puzzle - RPL and others - Claudio L. - 04-26-2021, 04:56 PM
RE: Puzzle - RPL and others - 3298 - 04-27-2021, 08:16 PM
RE: Puzzle - RPL and others - Albert Chan - 04-28-2021, 02:33 AM
RE: Puzzle - RPL and others - Albert Chan - 04-28-2021, 03:30 AM
RE: Puzzle - RPL and others - 3298 - 04-28-2021, 10:14 PM
RE: Puzzle - RPL and others - Albert Chan - 04-29-2021, 03:25 AM
RE: Puzzle - RPL and others - Allen - 04-28-2021, 08:45 PM
RE: Puzzle - RPL and others - Albert Chan - 04-29-2021, 05:16 PM
RE: Puzzle - RPL and others - Allen - 04-29-2021, 07:03 PM
RE: Puzzle - RPL and others - C.Ret - 05-02-2021, 06:40 AM
RE: Puzzle - RPL and others - 3298 - 05-03-2021, 03:43 PM
RE: Puzzle - RPL and others - Albert Chan - 05-04-2021, 03:29 AM
RE: Puzzle - RPL and others - 3298 - 05-04-2021, 06:48 AM
RE: Puzzle - RPL and others - Albert Chan - 05-05-2021, 06:29 PM
RE: Puzzle - RPL and others - 3298 - 05-06-2021, 04:24 PM
RE: Puzzle - RPL and others - Albert Chan - 05-06-2021, 09:09 PM
RE: Puzzle - RPL and others - Albert Chan - 05-07-2021, 10:35 AM
RE: Puzzle - RPL and others - 3298 - 05-07-2021, 04:17 PM
RE: Puzzle - RPL and others - Albert Chan - 05-09-2021, 01:21 AM
RE: Puzzle - RPL and others - 3298 - 05-09-2021, 01:39 PM
RE: Puzzle - RPL and others - Albert Chan - 05-10-2021, 03:57 AM
RE: Puzzle - RPL and others - Albert Chan - 05-07-2021, 02:56 AM
RE: Puzzle - RPL and others - Albert Chan - 05-10-2021, 05:13 PM
RE: Puzzle - RPL and others - 3298 - 05-10-2021, 08:23 PM
RE: Puzzle - RPL and others - Albert Chan - 05-11-2021, 11:58 AM
RE: Puzzle - RPL and others - 3298 - 05-11-2021, 02:14 PM
RE: Puzzle - RPL and others - John Keith - 05-11-2021, 03:55 PM
RE: Puzzle - RPL and others - ijabbott - 05-11-2021, 10:37 PM
RE: Puzzle - RPL and others - Albert Chan - 05-13-2021, 11:38 PM



User(s) browsing this thread: 2 Guest(s)