Puzzle - RPL and others

[Gene]

For the RPL (Let's make it an HP-50G oriented contest), judge by bytes x execution time.

Problem: Social Security Numbers in the USA always have 9 digits. My friend has a very unusual social security number. The first two digits on the left are evenly divisible by 2, the first three digits are evenly divisible by three... and yes, it continues up that way all the way to the last digit... The first 8 digits on the left are evenly divisible by 8 and the full 9 digit number is evenly divisible by 9.

What is my friend's social security number?

Note: This number is 9 digits long, it does not contain any zeroes and no digits are repeated in the number. Also, putting the number on the stack inside the << and >> will not be considered a solution to this problem.



For the other machines, post your solution and let's see what can be done.

PLEASE DO NOT POST the actual number until about 18 hours after this post ? (6am EASTERN USA TIME 4/23/21). :-)

As always have fun.

[Valentin Albillo]

(04-22-2021 06:55 PM)Gene Wrote:  For the other machines, post your solution and let's see what can be done.

Ok,this 6-liner, 195-byte recursive HP-71B program will do:

      1   DESTROY ALL @ STD @ FOR I=1 TO 9 @ CALL TST((I),2,9) @ NEXT I

      2   SUB TST(N,D,M) @ N=10*N @ FOR I=1 TO 9 @ X=N+I @ IF MOD(X,D) THEN 6
      3   A$=STR$(X) @ FOR J=1 TO LEN(A$) @ IF POS(A$[J+1],A$[J,J]) THEN 6
      4   NEXT J @ IF LEN(A$)=9 THEN DISP X @ END ALL
      5   IF D#M THEN CALL TST(X,D+1,M)
      6   NEXT I

Quote:PLEASE DO NOT POST the actual number until about 18 hours after this post ? (6am EASTERN USA TIME 4/23/21). :-)

Ok, I won't post the result of running my program but rest assured that it's the correct number. By the way, if you add to it a final 0 it will cease to be a Social Security number but it will be a 10-digit number which meets all other requirements.

Best regards
V.

[EdS2]

I'll be interested to see the execution times: this puzzle can be solved using a determined brain and only a few case-by-case analyses. By brute force there are quite a few combinations, so I wonder if there are ways to short cut the search and make big improvements.

[3298]

Ahh, an RPL puzzle! *cracks fingers, furious key clicking ensues*

This time, I went for UserRPL first (somewhat unusual for me, but SysRPL might come soon too). Claiming a solution at 203.5 bytes, checksum #A034h, TEVAL results vary between 15.2 ... 15.25 seconds on my physical 50g. There's some list processing, so it's likely a somewhat memory-heavy solution, leading to possible garbage collection influence - I currently have 222KiB free in IRAM.

Also have a modification of said program with a cache for a recurring slow computation. (2. n ^ R\->B for n in 1...9, if you're interested. The replacement is b n GET, where b is a local variable holding a 9-element list generated once at startup.) 248 bytes, checksum #3FD8h, TEVAL clocks in at about 13.62 ... 13.66 seconds.

Code postponed till after the deadline. Now to see what shortcuts SysRPL enables...

[Dave Britten]

(04-23-2021 07:30 AM)EdS2 Wrote:  I'll be interested to see the execution times: this puzzle can be solved using a determined brain and only a few case-by-case analyses. By brute force there are quite a few combinations, so I wonder if there are ways to short cut the search and make big improvements.

I put together a not-particularly-elegant 71B version that finds a solution in about 55 seconds, so that should set the bar for execution time.

EDIT: Got it down to 219 bytes and about 36 seconds. There's still room to shave off a few bytes here and there.

Code:

0010 OPTION BASE 1 @ DESTROY D @ DIM D(9),R
0020 CALL NX(1,0,D(),R) @ DISP R
0030 SUB NX(N,S,D(),R)
0040 I=N-MOD(S,N) @ S=S+I
0050 IF I>9 THEN STOP 
0060 IF D(I) THEN GOTO 110
0070 D(I)=1
0080 IF N<9 THEN CALL NX(N+1,S*10,D(),R) ELSE R=S
0090 IF R THEN STOP 
0100 D(I)=0
0110 I=I+N @ S=S+N
0120 GOTO 50
0130 END SUB

[ijabbott]

I think I worked out a solution by hand far quicker (about 5 minutes) than it would take me to write a program!

EDIT: Oops! I missed the requirement about no digits repeating. I thought it seemed a bit too easy!

[Albert Chan]

Let most significant digit = first digit (digit 1)
Even digits must be even
Odd digits must be odd
5th digit = 5.

4th digit + 8th digit must be 2 or 6
(Divisible by 4 only if last 2 digits divisible by 4. Example, 14 won't do it)

This filled all even numbers

Code:

1  2  3  4  5  6  7  8  9
=========================
   4     2  5  8     6
   8     6  5  4     2

This is perhaps optimized enough to start coding ...
Brute force for 4! = 24 cases, done in Emu71/DOS

Code:

10 DIM O(4),D(8) @ D(5)=5 @ O(1)=1 @ O(2)=3 @ O(3)=7 @ O(4)=9
20 FOR I1=1 TO 4 @ D(1)=O(I1)
30 FOR I2=1 TO 2 @ D(2)=4*I2 @ D(6)=12-D(2)
40 FOR I3=1 TO 4 @ D(3)=O(I3)
50 IF I3=I1 OR MOD(D(1)+D(2)+D(3),3) THEN 140
60 D(4)=2+4*(D(2)=8) @ D(8)=8-D(4)
70 FOR I4=1 TO 4 @ D(7)=O(I4)
80 IF I4=I1 OR I4=I3 THEN 130
90 X=0 @ FOR J=1 TO 7 @ X=10*X+D(J) @ NEXT J
100 IF MOD(X,7) OR MOD(10*X+D(8),8) THEN 130
110 X=100*X+10*D(8)+9 @ X=X-MOD(X,9) @ DISP X
130 NEXT I4
140 NEXT I3
150 NEXT I2
160 NEXT I1

>RUN
381654729

---

We can solve the puzzle, all by hand (without calculator !)

Digits(123) divisible by 3.
If 2nd digit is 4, top digits must have 1 somewhere (because 4%3=1)
Digits(678) divisisble by 8 → 7th digit cannot be 1.

Code:

1  2  3  4  5  6  7  8  9
=========================
   4     2  5  8  9  6
   8     6  5  4  3  2
   8     6  5  4  7  2

If Digits(1 to 3) divisible by 3, Digits(1 to 7) divisible by 7, we are done.
Note: 9th digit does not matter. If top 8 is correct, we found the solution.

Modulo 7, we have 10≡3, 100≡3*3≡2, 1000≡3*2≡-1

We "remove" 7th digit, and do 2 groups of 3-digits, to test mod 7:
1/10 ≡ 100/1000 ≡ 2/-1 ≡ -2 (mod 7)

258-2*9 ≡ 254 ≡ 2, top 3 digits must be 2 (mod 7)
147 ≡ 0, 741 ≡ 6, all failed

654-2*3 ≡ 654+1 ≡ 4, top 3 digits must be 4 (mod 7)
789 ≡ 5, 987 ≡ 0, 189 ≡ 0, 981 ≡ 1, all failed

654-2*7 ≡ 654 ≡ 3, top 3 digits must be 3 (mod 7)
183 ≡ 1, 381 ≡ 3, 189 ≡ 0, 981 ≡ 1, 1 solution.

Answer (proven unique): soc sec# 381-65-4729

[rprosperi]

(04-22-2021 11:52 PM)Valentin Albillo Wrote:  Ok,this 6-liner, 195-byte recursive HP-71B program will do:

      1   DESTROY ALL @ STD @ FOR I=1 TO 9 @ CALL TST((I),2,9) @ NEXT I

      2   SUB TST(N,D,M) @ N=10*N @ FOR I=1 TO 9 @ X=N+I @ IF MOD(X,D) THEN 6
      3   A$=STR$(X) @ FOR J=1 TO LEN(A$) @ IF POS(A$[J+1],A$[J,J]) THEN 6
      4   NEXT J @ IF LEN(A$)=9 THEN DISP X @ END ALL
      5   IF D#M THEN CALL TST(X,D+1,M)
      6   NEXT I

Nice program Valentin!!

This short, elegant program well illustrates the power and flexibility of the 71B's BASIC, clearly showing how its flexible string functions, recursion, call-by-value, etc. can be used to create unexpectedly powerful (if still somewhat slow by today's standards) and compact programs.

I rarely read these contests closely, and even more rarely comment on solutions, but this one really made me smile. Thanks for that!

[Didier Lachieze]

A recursive brute force program on the Prime, runs in ~.4s on my Prime G1, the .hpprgm file size is 1856 bytes:

Code:

next(n,l)
BEGIN
 LOCAL a:=SIZE(l),b,c;
 IF a==0 THEN RETURN END;
 FOR b FROM 1 to a DO
  c:=n*10+l(b);
  IF (c MOD (10-a))==0 THEN
   IFTE(a==1,PRINT(c),next(c,SUPPRESS(l,b)));
  END; 
 END; 
END;

EXPORT puzzle()
BEGIN
 next(0,{1,2,3,4,5,6,7,8,9});
END;

[3298]

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.

[C.Ret]

Here a version for HP-28C/S RPL Advanced Scientific Calculator;
As previous proposed code, it is based on a recursive approach, using the stack to store intermediate data.

Code:

NTST:
« IF DUP SIZE 9 < THEN 49 57 FOR c DUP c CHR
                               IF DUP2 POS THEN DROP2
                                           ELSE IF + DUP STR→ OVER SIZE MOD THEN DROP
                                                                            ELSE NTST END END
                             NEXT
                  ELSE DUP DEPTH ROLLD END
  DROP  »

Usage:
Initiate the research by entering an empty string :
"" NTST
will return the solution in level 1: of the stack. Meanwhile, this code also verify that no other solution exists.

One may spare running time by indicating a starting sequence such as "381" NST and the code will search for solution only starting with 381... eventually a solution may be found or the program ends leaving the stack unchanged.

EDIT: On my HP-28S founding the solution starting with the empty string "" and scanning over all possibilities takes about 2'54". A shorter time may be reach (aka 1'22") by KILLing the process as soon as the unique solution is found. (by replacing DUP DEPTH ROLLD sequence by a KILL)

EDIT #2:
translating this RPL code into HP-71B's BASIC, I get a five liner of 158 octets:

Code:

10 DESTROY ALL @ CALL NTST("") @ END

20 SUB NTST(N$) @ IF LEN(N$)=9 THEN BEEP @ DISP(N$) @ END ALL
22 FOR C=49 TO 57 @ X$=CHR$(C) @ IF POS(N$,X$) THEN 26 ELSE X$=N$&X$
24 IF MOD(VAL(X$),LEN(X$)) THEN 26 ELSE CALL NTST(X$)
26 NEXT C @ END SUB

On my HP-71B, the solution is found in 1'12"

[C.Ret]

Coding this puzzle on RPL's and powerful BASIC's pocket systems that natively support recurrence was an easy task !

A much more challenging is to adapt this algorithm on a pocket that have no support at all for recurrencies nor any serious structure for array !

Here is the same algorithm for SHARP PC-1211 (or other Tandy and SHARP equivalent), all you need is 129 steps and following variables:

A to I: (respectively A(1) to A(9) ) for memorizing scanned values of increasing number of digits,
J to R: (respectively A(10) to A(18) ) for noting at which level & position a digit is already used at,
U & V: Pointers indicating the actual size of the scan value and at which digit is currently probe.
T : Actual value to be probe, result at end of the whole seeking process,
Z : Use for division testing of the scan figure.


1:CLEAR :FOR U=1TO 9:A(U)=T:FOR V=1TO 9
2:IF A(9+V)=0LET T=10A(U)+V,Z=T/U:IF Z=INT ZLET A(9+V)=U,V=99 :REM PAUSE A(U),T
3:IF V=9LET U=U-1,V=A(U+1)-10A(U),A(9+V)=0:GOTO 3
4:NEXT V:NEXT U:BEEP 1:PRINT T:END
129STEPS
MEM
1295STEPS 161MEMORIES



As for previous code post here, the trick is to memorize only correct partial figure in the stack (since there is no way here to use recurrence) A to I in the same time, the J to R stack memorize used digit and record at which position in the value which also correspond to the level of seek.
A zero value in the J-R stack indicate a free digit.

Note the affectation V=99 which is equivalent for an BREAK (or LEAVE) instruction missing on these venerable old fashion canonic BASIC.


Without any intermediate message (the PAUSE at end of line 2: was heavily used for debugging the process), the solution is found in about 16'24"

here the complet trace of the seek up to the solution:

Code:

Seek levels:                                               Target
A: B:  C:   D:    E:     F:      G:       H:        I:     T: 
0. 1. 12. 123. 1236. 12365. 123654.
      12. 126. 1264. 12645.
               1268. 12685.
          129. 1296. 12965. 129654. 1296547.
               1298. 12984. 
      14. 147. 1472. 14725. 147258. 1472583.
               1476. 14765.
      16. 162. 1624. 16245.
               1628. 16285.
          165. 1652.
          168. 1684. 16845.
      18. 183. 1832. 18325.
               1836. 18365. 183654.
          186. 1864. 18645.
          189. 1892. 18925.
               1896. 18965. 189654.
   2. 24. 243. 2436. 24365.
          246. 2468. 24685.
          249. 2496. 24965. 
      26. 261. 
          264. 2648. 26485.
          267.
      28. 285. 2856.
   3. 32. 321. 3216. 32165. 321654. 3216549.
          324. 3248. 32485.
          327. 3276. 32765. 327654.
      34. 342. 3428. 32485. 
          345. 3452.
               3456.
          348.
      36. 369. 3692. 36925. 369258. 3692584.
      38. 381. 3812. 38125.
               3816. 38165. 381654. 3816547.38164572.       381654729.

[attachment=9414]

[Claudio L.]

I'm very late to the party, sorry.
Here's a version that doesn't use lists, or strings, all digits are stored in a number. It uses the DIGITS command from newRPL to isolate digits but it could easily be replaced using divisions, MOD 10, and IP to become plain userRPL. Also uses some local variable syntax from newRPL, but is could be turned into plain userRPL as well without too much trouble.

Code is below, must be stored as 'DONXT' (or adjust the name in the code, it's recursive). It takes 2 arguments: initial number and number of digits in the initial guess. Use 0 0 to scan the entire scope, or for example provide 381 3 to start with 3 known digits.
It returns nothing if no solution with 9 digits found. If the solution is found, it returns it in the same format: the number and the number of digits it contains.

It's 392 bytes, won't win any contests there, could be reduced to 376 bytes if I had used variable names with less than 4 letters, but whatever. The speed is quite good:
0.133 seconds on 50g hardware
0.303 seconds on Prime G1 hardware (still a mystery why it's slower, my guess is SRAM vs DRAM timings, plus the LCD driver accessing the DRAM all the time to achieve 60 Hz refresh).

The timings were measured using 0 0 as initial guess (no known digits at all).

For comparison, C.Ret code (extremely clever) clocks at 172 bytes and 4.12 seconds on 50g hardware.

Code:


«
  1 + → 
    SS N « IF N 9 ≤ THEN
      SS 10 * N MOD NEG N + 9 FOR 'K' 0 'FOUND' LSTO 0 N 2 - FOR
          'J' IF SS J J DIGITS K == THEN
            1 'FOUND' STO EXIT 
          END
        NEXT
        IF FOUND NOT THEN
          SS 10 * K + N DONXT IF DUP 9 ≠ THEN
            DROP2 
          END
        END
        N 
      STEP
    END
    IF N 1 > THEN
      SS N 1 - 
    END
  »
»

The algorithm is quite simple:
Given the initial digits and the number of digits, try to add one digit trying all possible combinations. Actually not all, the loop doesn't go from 1 to 9, it starts with the first digit that will meet the MOD n requirement, and it steps n digits each time. Each candidate digit is therefore known to meet the MOD requirement, it just needs to be checked for the repeated digit condition. If it's not repeated, recurse with that digit added to the number until we have 9 digits.

[Albert Chan]

(04-23-2021 04:08 PM)Albert Chan Wrote:  This filled all even numbers

Code:

1  2  3  4  5  6  7  8  9
=========================
   4     2  5  8     6
   8     6  5  4     2

I noticed odd digits [1,3,7,9], mod7 is [1,3,0,2], or simply 0 to 3.
This may simplify mod7 calculations (without calculator)

For example, lets try to solve missing digits of last pattern.
Let a = 1st digit, b = 3rd digit, c = 7th digit

10^6*a + 10^4*b + c + 806540 ≡ a - 3*b + c ≡ 0 (mod 7)

a+c ≡ 3*b (mod 7)

a+c ≡ 3*0 ≡ 0, no solution
a+c ≡ 3*1 ≡ 3, [a,c] ≡ [0,3] or [3,0]
a+c ≡ 3*2 ≡ 6, no solution
a+c ≡ 3*3 ≡ 2, [a,c] ≡ [0,2] or [2,0]

Passes mod7 test: [a,b,c] = [7,1,3], [3,1,7], [9,3,7], [7,3,9]

Digit(6,7,8) for divisible by 8: 492 (mod 8) ≠ 0, last case rejected.
Digit(1,2,3) for divisible by 3: 781, 381, 983, only 381 passes.

-> soc-sec# = 381 654 729

[3298]

I tinkered with my programs a bit more. Traversing the search space depth-first (i.e. with recursion) instead of the breadth-first (iterative) approach I employed didn't do me any favors in UserRPL. The program just grew bigger and slower. In SysRPL on the other hand it worked out pretty well. I also found an improvement for what was the inner loop (now the only loop), which is now a DO...+LOOP like I wanted it to be (BINT range concerns previously prevented it).

Code:

::
  #ZERO#ONE %0
  ' ::
    %10* BINT10 3PICK 3PICKOVER
    UNCOERCE %MOD COERCE #-
    DO
      INDEX@ GETLAM
      4PICKOVER #AND #0<>
      ITE_DROP
      ::
        4PICK#+ 3PICK#1+_
        BINT10 #=casedrop
        ::
          DROPDUP INDEX@ UNCOERCE
          %+ BINT28 UNROLL
        ;
        3PICK INDEX@ UNCOERCE %+
        10GETLAM EVAL
      ;
    OVER +LOOP
    3DROP
  ;
  DUPONE
  BINT9 ONE_DO
    DUP #2*
  LOOP
  ' NULLLAM BINT10 NDUPN DOBIND
  EVAL ABND
;

This is significantly faster (2.05 ... 2.06 seconds) than my previous SysRPL efforts, and tied for size with my previous smallest one too (145 bytes, #6AB8h). For further acceleration I tried exiting early when the single solution is found - by throwing an error with the result as message (insert BINT27 NDROP a%>$ DO$EXIT after the BINT28 UNROLL). Unfortunately that error propagates through TEVAL too, preventing it from finishing a measurement. No big problem though, just surround the EVAL with ERRSET ... ERRTRAP SysErrorTrap to catch the error, display it, and carry on into TEVAL. (If there's an edit line active, it would wait for confirmation on the error box and mess up the timing, but what sane person runs TEVAL in the editor?) All that together brings the size up to 162.5 bytes (and the checksum is #0F42, if there's anybody typing along), but the time goes down to 1.01 ... 1.05 seconds. Note that the SysErrorTrap seems to take up a good portion of this measured time, as a TEVAL on this ...

Code:

::
  "381654729." ERRSET DO$EXIT ERRTRAP SysErrorTrap
;

... shows: 0.29 ... 0.34 seconds for that part alone, just so TEVAL doesn't get aborted. That means without the error trap, the time would be closer to 0.7 seconds.

---

Small note on the theory side: I identified another reason for checking divisibility first, like Claudio and I did: it has a higher rejection rate than the duplicate digits check - and as you probably know it's usually prudent to run the more strict check first, giving you a higher chance to skip the other one altogether for a quicker rejection. (Unless the check with the higher rejection rate is significantly slower, that is. But in this case it's definitely not.)
On the first digit, neither check rejects anything because divisibility by 1 is always true and there are no digits already taken ... but on the second only 1 out of 9 is a duplicate, whereas 5 out of 9 are odd. This continues through all recursion levels:
- 2/9 vs. 6/9 on the third digit,
- 3/9 vs. 7/9 on the fourth,
- 4/9 vs. 8/9 on the fifth,
- 5/9 vs. either 7/9 or 8/9 on the sixth (allowed digits are {2 8} or {4} or {6}, depending on the prior digits),
- 6/9 vs. again either 7/9 or 8/9 on the seventh, and
- 7/9 vs. 8/9 on the eighth digit.
Only on the last digit they agree again on rejecting all but one digit.

---

Now for something different: what if we expand the puzzle to arbitrary base-N, i.e. build a (N-1)-digit number in base-N where no digits are 0 or a duplicate, and the leading-digits requirement is satisfied too?

Code:

::
  CK1NoBlame CKREAL
  #ZERO#ONE %0
  4PICK COERCEDUP #2-
  BINT19 #> caseSIZEERR
  BINT1
  OVER ONE_DO
    SWAPOVER #2*
  LOOP
  SWAP
  ' ::
    1GETLAM %* 3GETLAM 3PICK
    3PICKOVER
    UNCOERCE %MOD COERCE #-
    DO
      INDEX@ #3+ GETLAM
      4PICKOVER #AND #0<>
      ITE_DROP
      ::
        4PICK#+ 3PICK#1+_
        3GETLAM OVER#=case
        ::
          SWAPDROP OVERINDEX@
          UNCOERCE %+SWAP
          BINT3 #* #2- UNROLL
        ;
        3PICK INDEX@ UNCOERCE %+
        2GETEVAL
      ;
    OVER +LOOP
    3DROP
  ;
  OVER #6+ ROLL
  ' NULLLAM 4PICK #3+ NDUPN
  DOBIND 2GETEVAL ABND
;

This program (185 bytes, #CF4Eh) expects a real number designating the base on the stack. Supported are bases 2 to 21 (larger bases are not compatible with the use of BINTs as bitset to remember already used digits, but real number precision probably breaks things before that in the bigger bases). Interesting to note: odd bases never have solutions, and some even ones have more than one (e.g. base 4: \(123_4 = 27_{10}\) and \(321_4 = 57_{10}\)). I'm sure Albert Chan will analyse these observations in detail, he seems to enjoy doing that. Ideas for him: the divisibility test for the final digit is a division by N-1, which in base-N has a sum-of-digits shortcut regardless of base (we know the N=10 case well: divisibility by 9 has this shortcut); for that final digit we are testing divisibility on the entire number, which has all non-zero digits of that base exactly once, i.e. the sum of digits has to be \(\sum_{i=1}^{N-1}{i} = \frac{N \cdot (N-1)}{2}\). If we know this check cannot succeed, there cannot be a solution either. Albert, your turn, fill in the blanks.
This program tries to find all solutions, and therefore does not use an early abort mechanism like throwing a custom error.

[Albert Chan]

(04-27-2021 08:16 PM)3298 Wrote:  Interesting to note: odd bases never have solutions...
Albert, your turn, fill in the blanks.

We can let the number be x, with digits 1 to n, all distinct, in base n, integer n > 1:

x = Σ(d_k * n^k, k = 0 to n-1)
x (mod n-1) ≡ Σ(d_k * 1^k, k = 0 to n-1) ≡ Σ(d_k, k = 0 to n-1)

This explained the shortcut for mod 9 by adding digits, in decimal.

With all digits distinct: x (mod n-1) ≡ n*(n-1)/2

q*(n-1) + r = n*(n-1)/2

We restrict q as integer, such that 0 ≤ r < n-1
With this setup, x divisible by (n-1) is same as test for r = 0.

If n is even, q*(n-1) + r = (n/2) * (n-1) + 0           ⇒ r = 0
If n is odd, q*(n-1) + r = (n-1)/2 * (n-1) + (n-1)/2 ⇒ r = (n-1)/2 ≠ 0

[Albert Chan]

(04-27-2021 08:16 PM)3298 Wrote:  Small note on the theory side: I identified another reason for checking divisibility first, like Claudio and I did: it has a higher rejection rate than the duplicate digits check - and as you probably know it's usually prudent to run the more strict check first, giving you a higher chance to skip the other one altogether for a quicker rejection. (Unless the check with the higher rejection rate is significantly slower, that is. But in this case it's definitely not.)

There is another side to this.
If we did check divisibility first, then we need to check for duplicates, an O(n) operation.

However, if we have O(1) array access, we could "check" duplicates in O(1)
I tried this in Python. For n=10, this simple version is 60% faster.

At the end of the day, both ways generate same test cases (albeit not same order)

Code:

def recurse(lst, n, k=1, x=0):
    if k==n: print x; return
    x, d0 = n*x, lst[k]
    for i in xrange(k, n, 2):
        d = lst[i]
        if (x+d) % k: continue
        lst[i] = d0
        recurse(lst, n, k+1, x+d)
        lst[i] = d      # restore

>>> recurse(range(10), 10)
381654729

>>> recurse(range(14), 14) # = 9c3a5476b812d₁₄
559922224824157

Update: restricting odd digits odd, even digits even, speed up a lot !
Not bad for a 3 bytes ", 2" patch. See the numbers:

For n=10, mod calculations reduced from 1580 to 424, factor of 3.73
For n=14, mod calculations reduced from 29045 to 4422, factor of 6.57

Reduced search space is not quite as much.
For n=10, recursive calls reduced from 311 to 156, factor of 1.99
For n=14, recursive calls reduced from 3928 to 1085, factor of 3.62

Overall, speed factor = 2.42X for n=10, 4.25X for n=14.

[Allen]

I was traveling this past week and had no internet most of the time, so I am submitting a little late..

I propose a 63 Byte solution for 41c/42s with a slight rube-goldberg look to the code to minimize size, but maintains divisibility throughout.

Registers Used: 5
Program Constants: 19, 3
Initial Entry: None
Returns: X-register 381654729

( possible I made some mistakes)

Code:


00 { 63-Byte Prgm }
01 19               initialize coefficients for polynomial  a=19
02 STO 02
03 3
04 STO 00      first divisor is 3
05 STO 03
06 X^2
07 +/-
08 STO 04          b=-9
09 STO 01          running total starts with -9 for various reasons 
10 STO× 03         c=-27 
11>LBL 01
12 RCL 01           \  
13 RCL× 04             multiply reg. 01 by 10
14 STO- 01         /
15 RCL 02         \
16 RCL× 00          set up horner-form polynomial of a*x^3+b*x^2+c*x - total %x   
17 RCL+ 04          add   x (x (19 x - 9) - 27) - total %x
18 RCL× 00
19 RCL+ 03
20 RCL× 00       /
21 RCL 01
22 RCL 00
23 MOD      
24 -              subtract constant term to ensure divisibility
25 STO+ 01      update running total
26 ISG 00       increment the central number to check for divisibility
27 X<>Y         NOP
28 RCL 01       \
29 RCL× 00
30 LOG             loop if running total is too small
31 RCL+ 04
32 X<0?         /
33 GTO 01
34 RCL 01       recall answer (divisible by 9 but not pandigital)
35 RCL+ 02      
36 DSE ST X     add (a-1)
37 .END.

[3298]

Thank you, Albert Chan, for expanding my observation and ideas into a proper proof, because that's not quite my area of expertise. I hope you didn't feel pressured into it.

(04-28-2021 03:30 AM)Albert Chan Wrote:  restricting odd digits odd, even digits even, speed up a lot !

I was going to say that this doesn't work for odd bases, but as we just found out, we can reject those before we get here, since they can't have solutions anyway...

But thinking about why it wouldn't apply to odd bases pushed me into another idea building on this: the shortcut works for any number that divides the base. You already applied this with the number 5 in base 10 ... the fifth position has to be 5, as it is the only base-10 digit divisible by 5.
To take another example, in base 12 we would be looking at divisibility by 2, by 3, by 4, and by 6 (these are the numbers that divide 12 without remainder). Then we can sort all digits into buckets where all digits in the same bucket have the same divisibility results, and when we get to check if a digit is allowed in position <i>, add a third check into the mix: only digits in the bucket containing <i> are allowed.

Not sure if all that complexity is worth it, but at least on bases with a high number of divisors it might eliminate another handful of checks. And the whole business of sorting digits into buckets only needs to be performed once per base, not at each recursion level. For an implementation of the check if a given digit is in the same bucket as another, I'm imagining a lookup table holding references to the buckets that correspond to the lookup table index (O(1)), and the buckets themselves are sets which can be implemented as an array of booleans, a.k.a. another bitset (also O(1)). That means an O(1) check overall.

Maybe generating the buckets could even be optimized by cutting the list of factors down to prime factors with multiplicities, i.e. if we look at the base-12 example again (prime factors are 2 with a multiplicity of 2 and 3 with a multiplicity of 1), digit divisibility by 2 is separated into not divisible (=2^0), divisible by 2^1, and divisible 2^2, while 3 is sorted into not divisible (=3^0) and divisible (=3^1), for a total of three options times two options = six buckets. The last one will always stay empty, because if you multiply all prime factors in full multiplicities back together (2^2 * 3^1 = 12), you get the base, which isn't a valid digit (and neither are its multiples, for obvious reasons). The others are { 1 5 7 11 } { 2 10 } { 4 8 } { 3 9 } { 6 }.

I don't have an implementation to run performance tests on, this is just an idea still. Maybe later.

[Albert Chan]

(04-28-2021 10:14 PM)3298 Wrote:  

(04-28-2021 03:30 AM)Albert Chan Wrote:  restricting odd digits odd, even digits even, speed up a lot !

I was going to say that this doesn't work for odd bases, but as we just found out, we can reject those before we get here, since they can't have solutions anyway...

This optimization actually force code to quit early, for odd base.
For odd base, even digits must have same parity as the digit before it.

odd * odd = odd
even * odd = even

Quote:But thinking about why it wouldn't apply to odd bases pushed me into another idea building on this: the shortcut works for any number that divides the base. You already applied this with the number 5 in base 10 ... the fifth position has to be 5, as it is the only base-10 digit divisible by 5.

Yes, bucket idea work, but code would get complicated ... fast.

Also, gain may not be what you expected.

Example, with even base, we already have 2 factors.
Odd digits odd, even digits even use the factor 2.
At the cost of slight complexity, we can add the other factor: base/2

Code:

def recurse2(lst, n, k=1, x=0):
    if k+k==n: return recurse2(lst, n, k+1, n*x+k)
    if k==n: print x; return
    x, d0 = n*x, lst[k]
    for i in xrange(k, n, 2):
        d = lst[i]
        if d+d==n or (x+d)%k: continue
        lst[i] = d0
        recurse2(lst, n, k+1, x+d)
        lst[i] = d      # restore

Code work the same way, just faster

>>> recurse2(range(10), 10)
381654729

Compare against recurse(), recurse2() was expected to cut down search time.
But, numbers are not impressive (factor also closely matched speed-up ratio)

For n=10, recursive calls reduced from 156 to 131, factor of 1.19
For n=14, recursive calls reduced from 1085 to 790, factor of 1.37