Largest number divisible by its digits: Difference between revisions
Largest number divisible by its digits (view source)
Revision as of 20:27, 10 May 2020
, 4 years ago→{{header|360 Assembly}}: Section added
PatGarrett (talk | contribs) (→{{header|VBScript}}: Section added) |
PatGarrett (talk | contribs) (→{{header|360 Assembly}}: Section added) |
||
Line 29:
:* The OEIS sequence: [http://oeis.org/A115569 A115569: Lynch-Bell numbers].
<br><br>
=={{header|360 Assembly}}==
For maximum compatibility, this program uses only the basic instruction set.
The program uses also HLASM structured macros (DO,ENDDO,IF,ELSE,ENDIF) for readability and one ASSIST/360 macros XPRNT) to keep the code as short as possible.
===Base 10===
<lang 360asm>* Largest number divisible by its digits - base10 - 05/05/2020
LANUDIDO CSECT
USING LANUDIDO,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
L R6,KM i=km
DO WHILE=(C,R6,GE,=F'1') do i=km to 1 by -ks
CVD R6,DBLI binary to packed decimal
MVC CI,MAK load mask for edit
EDMK CI,DBLI+2 ci=cstr(i)
S R1,=A(CI) number of blanks
LA R2,L'CI length(ci)
SR R2,R1 length of the number
ST R2,LCI lci=length(ci)
MVC CIL,=CL12' ' cil=' '
LA R4,CI @ci
AR R4,R1 @ci[k]
LA R3,CIL @cil
LR R5,R2 length(ci)
BCTR R5,0 ~
EX R5,MVCR3R4 cil=ltrim(ci)
LA R8,CIL @ci
LA R7,1 j=1
DO WHILE=(C,R7,LE,LCI) do j=1 to length(ci)
CLI 0(R8),C'5' if ci[j]='5'
BE ITERI then cycle i ! 5 impossible
CLI 0(R8),C'0' if ci[j]='0'
BE ITERI then cycle i ! 0 impossible
LA R8,1(R8) @ci++
LA R7,1(R7) j++
ENDDO , enddo j
L R2,LCI length(ci)
BCTR R2,0 length(ci)-1
LA R7,1 j=1
DO WHILE=(CR,R7,LE,R2) do j=1 to length(ci)-1
LA R3,CIL-1 @cil
AR R3,R7 @cil[j]
IC R1,0(R3) cil[j]
STC R1,CK ck=substr(cil,j,1)
SR R0,R0 index=0
LR R8,R7 j
LA R8,1(R8) k=j+1
LA R9,CIL @ci
AR R9,R8 +i
BCTR R9,0 -1
DO WHILE=(C,R8,LE,LCI) do k=j+1 to length(ci)
IF CLC,0(0,R9),EQ,CK THEN if substr(ci,k,1)=ck then
LR R0,R8 index=k
B EXITK exit do k
ENDIF , endif
LA R9,1(R9) @ci++
LA R8,1(R8) k++
ENDDO , enddo k
EXITK LTR R0,R0 if index(ci,ck,j+1)<>0
BNZ ITERI then cycle i ! no dup digit
LA R7,1(R7) j++
ENDDO , enddo j
LA R7,1 j=1
DO WHILE=(C,R7,LE,LCI) do j=1 to length(ci)
LA R3,CIL-1 @cil
AR R3,R7 @cil[j]
IC R1,0(R3) cil[j]
SLL R1,28 ~
SRL R1,28 kk=int(substr(ci,j,1))
XR R4,R4 ~
LR R5,R6 i
DR R4,R1 r5=i/kk r4=mod(i,kk)
LTR R4,R4 if mod(i,kk)<>0
BNZ ITERI then cycle i ! div by all digit
LA R7,1(R7) j++
ENDDO , enddo j
B EXITI exit do i ! found
ITERI S R6,KS i-=ks
ENDDO , enddo i
EXITI XPRNT CIL,L'CIL print cil
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling save
MVCR3R4 MVC 0(0,R3),0(R4) move: %R3 <- %R4
KS DC F'504' ks=504=7*8*9 magic number
KM DC F'9876384' km=9876384 mod(km,ks)=0
DBLI DS PL8 double word 15num
MAK DC X'402020202020202020202020' mask CL12 11num
CI DS CL12 12num - i right justify
CIL DS CL12 12num - i left justify
LCI DS F length(i)
CK DS C ck
REGEQU
END LANUDIDO </lang>
{{out}}
<pre>
9867312
</pre>
=={{header|AWK}}==
| |||