(33s) OEIS A4186: Digits in Descending Order

[Gerald H]

Takes a natural number from the stack & returns A4186(N) to stack.
Digits of index decreasing.

eg Input

10477

returns

77410.

I use [i] to represent the built in sign for use of i in indirect addressing to avoid confusion in say

IP(LOG((i)))

or

5*(i).

Suggestions for improvements most welcome.

https://oeis.org/A004186

Preserves stack.

Code:

1.    LBL D
2.    CLVARS
3.    STO K
1.    LBL F
2.    x=0?
3.    GTO G
4.    CLx
5.    RMDR(K:10)+1
6.    STO i
7.    SGN
8.    STO+ [i]
9.    CLx
10.    IDIV(K:10)
11.    STO K
12.    GTO F
1.    LBL G
2.    CLx
3.    10
4.    STO i
5.    CLx
6.    STO T
1.    LBL H
2.    CLx
3.    RCL [i]
4.    x=0?
5.    GTO J
1.    LBL I
2.    CLx
3.    10* T+i-1
4.    STO T
5.    DSE [i]
6.    GTO I
1.    LBL J
2.    DSE i
3.    GTO H
4.    CLx
5.    RCL T
6.    RTN

D: LN = 9        H: LN = 15
F: LN = 58        I: LN = 26
G: LN = 30        J: LN = 18

[C.Ret]

Hello,

Since I still have no HP-35S, here is a version for an HP-41C without any extra RAM or ROM module:

Code:

001 LBL "4186                                               // real integer input N  in register X:
002   CLRG                                    
003   LBL 01                                                // LOOP1: strip integer N digit by digit    
004     RCL X  10  ST/ Z  MOD  X<>Y  ISG 00
010     LBL 02                                              // LOOP2: sort digits from register R10 to R01   
011       X<> IND L  X<=Y?  X<>Y  X<> IND L  DSE L  GTO 02  //   R10:highest digit  R01:smallest digits (or zero)
017   INT  X>0?  GTO 01                                     // loop until no more digit in N
020   10  X<>Y
022   LBL 03                                                // LOOP3: build-up result from digits in R10 down to R0#
023     10  *  RCl IND Y  +  DSE Y  DEG  DSE 00  GTO 03
031 END                                                     // Result in X:  N'= jih...dcba

[ ][RTN]
1234 [R/S] ... goose ... goose ... goose ... 4321.
10477 [R/S] ... goose ... goose ... goose ... 77410.

This is a simplified version from a code published as one of the numerous solutions of the code challenge Re: Misez p'tit, Optimisez - N°85 (L'Algorithme de Kaprekar) on the French Forum Silicium (20 août 2018).

A close related code may produce both decreasing and increasing digits sorted integers from the input:

Code:

X: N=hdebcijadf
001 LBL "4186B             011       X<> IND L        021   SIGN                 031     X<> IND L
002   CLRG                 012       X<=Y?            022   X<> Z                032     ST+ Y
003   LBL 01               013       X<>Y             023   LBL 03               033     RDN
004     RCL X              014       X<> IND L        024     10                 034     DSE L
005     10                 015     DSE L              025     ST* Z              035     DEG
006     ST/ Z              016     GTO 02             026     X<> T              036   DSE 00
007     MOD                017     INT                027     ST* T              037   GTO 03
008     X<>Y               018   X>0?                 028     X<> IND L          038 END
009     ISG 00             019   GTO 01               029     ST+ Z         
010     LBL 02             020   10                   030     ST* IND L       X: abcdefghij   Y: jihgfedcba

[ ][RTN]
1342 [R/S] ... goose ... goose ... goose ... 1234. [X<>Y] 4321.
10477 [R/S] ... goose ... goose ... goose ... 1477. [X<>Y] 77410.

[Gerald H]

Interesting stuff, Ret, thank you.

The last programme you mention works nicely on a 42S - but I don't see the point of line 35?

[Gerald H]

OK, I've now replaced DEG with RAD & it works fine - usage clarified.

[C.Ret]

Yes, everyone can put whatever they want in step 035 as long as it can be used as a NOP.
Maybe I should have left the original LBL 04 which more clearly indicates a non-operation.

This also applies to step 028 of the first program.

[C.Ret]

Hello,

This weekend, I found a way to rent a friend's HP-35S along with its owner's manual. What a funny machine!

It is with great difficulty that I managed to adapt my second algorithm to it, the one that gives the integers with the numbers sorted in ascending and descending order.

Be indulgent, this is my first program on HP-35S; it is it is intended to be used in RPN mode and with the ALL display option.

Code:

O001 ►LBL O       O011  x<>y        O021  1           O031  ×           O041  1           O051▫ STO I     
O002  CLVARS      O012▪ x<>(i)      O022  STO+ J      O032  RCL+(i)     O042  STO- I      O052▫ 2         
O003  STO N       O013  FS? 1       O023  10¨x        O033  x<>y        O043  10¨x        O053▫ -         
O004  13          O014  CLx         O024  INT÷        O034  STO×(i)     O044  ×           O054▫ RTN       
O005  STO I       O015  x<y?        O025  x>0?        O035  R↑          O045  DSE J     
O006  STO(I)      O016  x<>y        O026  GTO O009    O036  RCL+(i)     O046  GTO O029  
O007  SF 1        O017  x<>(i)      O027▫ XEQ O049    O037  x<>y        O047  R↓        
O008  RCL N       O018  DSE I       O028  SGN         O038  R↓          O048  RTN    ■    
O009▫ XEQ O049    O019  GTO O012    O029▪ x<>y        O039  x<>y        O049▪ REGX      
O010  RMDR        O020  CF 1        O030  10          O040  R↑          O050▫ 12        

LBL O
CK=A4D8
LN=175

It's a bit long code but it has the advantage of using only one label (LBL O). Unlike the HP-41C version, it handles integers up to 12 digits which it temporarily stores in twelve anonymous registers using indirect addressing via the I register.

It also uses flag #1 because I couldn't find a simple instruction to reset or reserve the anonymous register range. The flag is used to reset the anonymous registers on the first pass. At the beginning of the code, I put 13 in the anonymous register (13) in order to 'reserve' without surprise the range (1) to (12).

It's a bit of a hassle on this machine, isn't it?
The keyboard is far too overloaded, I prefer, by far, to use my more sober HP-41C and with better organized registers.


3142 XEQ O ENTER
run a few seconds and display
1234
4321

The initial value 3142 is kept in the register N
This version clears all the registers. To preserve memory contents, please alter the code with the starter sequence:

Code:

O001 LBL O
O002 STO N
O003 13
O004 STO I
O005 STO(I)
O006 CLx
O007 STO J
O008 SF 1
...