Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
|
|
@ -0,0 +1,33 @@
|
|||
/*REXX program finds the persistence and multiplicative digital root of some numbers.*/
|
||||
numeric digits 100 /*increase the number of decimal digits*/
|
||||
parse arg x /*obtain optional arguments from the CL*/
|
||||
if x='' | x="," then x=123321 7739 893 899998 /*Not specified? Then use the default.*/
|
||||
say center('number', 8) ' persistence multiplicative digital root'
|
||||
say copies('─' , 8) ' ─────────── ───────────────────────────'
|
||||
/* [↑] the title and separator. */
|
||||
do j=1 for words(x); n=word(x, j) /*process each number in the X list.*/
|
||||
parse value MDR(n) with mp mdr /*obtain the persistence and the MDR. */
|
||||
say right(n,8) center(mp,13) center(mdr,30) /*display a number, persistence, MDR.*/
|
||||
end /*j*/ /* [↑] show MP & MDR for each number. */
|
||||
say copies('─' , 8) ' ─────────── ───────────────────────────'
|
||||
say; say; target=5
|
||||
say 'MDR first ' target " numbers that have a matching MDR"
|
||||
say '═══ ═══════════════════════════════════════════════════'
|
||||
|
||||
do k=0 for 10; hits=0; _= /*show numbers that have an MDR of K. */
|
||||
do m=k until hits==target /*find target numbers with an MDR of K.*/
|
||||
if word( MDR(m), 2)\==k then iterate /*is this the MDR that's wanted? */
|
||||
hits=hits + 1; _=space(_ m',') /*yes, we got a hit, add to the list. */
|
||||
end /*m*/ /* [↑] built a list of MDRs that = K. */
|
||||
say " "k': ['strip(_, , ',')"]" /*display the K (MDR) and the list. */
|
||||
end /*k*/ /* [↑] done with the K MDR list. */
|
||||
say '═══ ═══════════════════════════════════════════════════'
|
||||
exit 0 /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
MDR: procedure; parse arg y; y=abs(y) /*get the number and determine the MDR.*/
|
||||
do p=1 until y<10; parse var y r 2
|
||||
do k=2 to length(y); r=r * substr(y, k, 1)
|
||||
end /*k*/
|
||||
y=r
|
||||
end /*p*/ /* [↑] wash, rinse, and repeat ··· */
|
||||
return p r /*return the persistence and the MDR. */
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
/*REXX program finds the persistence and multiplicative digital root of some numbers.*/
|
||||
numeric digits 2000 /*increase the number of decimal digits*/
|
||||
parse arg target x /*obtain optional arguments from the CL*/
|
||||
if \datatype(target, 'W') then target=25 /*Not specified? Then use the default.*/
|
||||
if x='' | x="," then x=123321 7739 893 899998 /* " " " " " " */
|
||||
say center('number',8) ' persistence multiplicative digital root'
|
||||
say copies('─' ,8) ' ─────────── ───────────────────────────'
|
||||
/* [↑] the title and the separator. */
|
||||
do j=1 for words(x); n= abs( word(x, j) ) /*process each number in the list. */
|
||||
parse value MDR(n) with mp mdr /*obtain the persistence and the MDR. */
|
||||
say right(n,8) center(mp,13) center(mdr,30) /*display the number, persistence, MDR.*/
|
||||
end /*j*/ /* [↑] show MP and MDR for each number.*/
|
||||
say copies('─' ,8) ' ─────────── ───────────────────────────'
|
||||
say; say /* [↓] show a blank and the title line.*/
|
||||
say 'MDR first ' target " numbers that have a matching MDR"
|
||||
say '═══ ' copies("═",(target+(target+1)**2)%2) /*display a separator line (for title).*/
|
||||
|
||||
do k=0 for 9; hits= 0 /*show numbers that have an MDR of K. */
|
||||
_=
|
||||
if k==7 then _= @7 /*handle the special case of seven. */
|
||||
else do m=k until hits==target /*find target numbers with an MDR of K.*/
|
||||
parse var m '' -1 ? /*obtain the right─most digit of M. */
|
||||
if k\==0 then if ?==0 then iterate
|
||||
if k==5 then if ?//2==0 then iterate
|
||||
if k==1 then m= copies(1, hits+1)
|
||||
else if MDR(m, 1)\==k then iterate
|
||||
hits= hits + 1 /*got a hit, add to the list*/
|
||||
_= space(_ m) /*elide superfluous blanks. */
|
||||
if k==3 then do; o=strip(m, 'T', 1) /*strip trailing ones from M*/
|
||||
if o==3 then m= copies(1, length(m))3 /*make a new M.*/
|
||||
else do; t= pos(3, m) - 1 /*position of 3 */
|
||||
m= overlay(3, translate(m, 1, 3), t)
|
||||
end /* [↑] shift the "3" 1 place left.*/
|
||||
m= m - 1 /*adjust for DO index increment.*/
|
||||
end /* [↑] a shortcut to adj DO index*/
|
||||
end /*m*/ /* [↑] built a list of MDRs = K */
|
||||
|
||||
say " "k': ['_"]" /*display the K (MDR) and the list. */
|
||||
if k==3 then @7= translate(_, 7, k) /*save for later, a special "7" case.*/
|
||||
end /*k*/ /* [↑] done with the K MDR list. */
|
||||
|
||||
@.= /* [↓] handle MDR of "9" special. */
|
||||
_= translate(@7, 9, 7) /*translate string for MDR of nine. */
|
||||
@9= translate(_, , ',') /*remove trailing commas from numbers. */
|
||||
@3= /*assign null string before building. */
|
||||
|
||||
do j=1 for words(@9) /*process each number for MDR 9 case.*/
|
||||
_= space( translate( word(@9, j), , 9), 0) /*elide all "9"s using SPACE(x,0).*/
|
||||
L= length(_) + 1 /*use a "fudged" length of the number. */
|
||||
new= /*these are the new numbers (so far). */
|
||||
|
||||
do k=0 for L; q= insert(3, _, k) /*insert the 1st "3" into the number*/
|
||||
do i=k to L; z= insert(3, q, i) /* " " 2nd "3" " " " */
|
||||
if @.z\=='' then iterate /*if already define, ignore the number.*/
|
||||
@.z= z; new= z new /*define it, and then add to the list.*/
|
||||
end /*i*/ /* [↑] end of 2nd insertion of "3".*/
|
||||
end /*k*/ /* [↑] " " 1st " " " */
|
||||
|
||||
@3= space(@3 new) /*remove blanks, then add to the list.*/
|
||||
end /*j*/ /* [↑] end of insertion of the "3"s. */
|
||||
@= /* [↓] merge two lists, 3s and 9s. */
|
||||
a1= @9; a2= @3 /*define some strings for the merge. */
|
||||
do while a1\=='' & a2\=='' /*process while the lists aren't empty.*/
|
||||
x= word(a1, 1); y= word(a2, 1) /*obtain the 1st word in A1 & A2 lists.*/
|
||||
if x=='' | y=='' then leave /*are X or Y empty? */
|
||||
if x<y then do; @= @ x; a1= delword(a1, 1, 1); end /*add X to the @ list*/
|
||||
else do; @= @ y; a2= delword(a2, 1, 1); end /* " Y " " " " */
|
||||
end /*while*/ /* [↑] only process just enough nums. */
|
||||
|
||||
@= subword(@, 1, target) /*elide the last trailing comma in list*/
|
||||
say " "9': ['@"]" /*display the "9" (MDR) and the list.*/
|
||||
say '═══ ' copies("═",(target+(target+1)**2)%2) /*display a separator line (for title).*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
MDR: procedure; parse arg y,s; y= abs(y) /*get the number and determine the MDR.*/
|
||||
do p=1 until y<10; parse var y r 2
|
||||
do k=2 to length(y); r= r * substr(y, k, 1)
|
||||
end /*k*/
|
||||
y= r
|
||||
end /*p*/ /* [↑] wash, rinse, and repeat ··· */
|
||||
if s==1 then return r /*return multiplicative digital root. */
|
||||
return p r /*return the persistence and the MDR. */
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
/*REXX pgm finds positive integers when shown in hex that can't be written with dec digs*/
|
||||
parse arg n cols . /*obtain optional argument from the CL.*/
|
||||
if n=='' | n=="," then n = 100 /*Not specified? Then use the default.*/
|
||||
if cols=='' | cols=="," then cols= 10 /* " " " " " " */
|
||||
w= 10 /*width of a number in any column. */
|
||||
title= ' the product of the decimal digits of N, where N < ' n
|
||||
say ' index │'center(title, 1 + cols*(w+1) ) /*display the title for the output. */
|
||||
say '───────┼'center("" , 1 + cols*(w+1), '─') /* " a sep " " " */
|
||||
$=; idx= 1 /*list of products (so far); IDX=index.*/
|
||||
do #=1 for n; L= length(#) /*find products of the dec. digs of J. */
|
||||
p= left(#, 1) /*use first digit as the product so far*/
|
||||
do j=2 for L-1 until p==0 /*add an optimization when product is 0*/
|
||||
p= p * substr(#, j, 1) /*multiply the product by the next dig.*/
|
||||
end /*j*/
|
||||
$= $ right(p, w) /*add the product ───► the $ list. */
|
||||
if #//cols \== 0 then iterate /*have we populated a line of output? */
|
||||
say center(idx, 7)'│' substr($, 2); $= /*display what we have so far (cols). */
|
||||
idx= idx + cols /*bump the index count for the output*/
|
||||
end /*#*/ /*stick a fork in it, we're all done. */
|
||||
|
||||
if $\=='' then say center(idx, 7)"│" substr($, 2) /*possible display residual output.*/
|
||||
say '───────┴'center("" , 1 + cols*(w+1), '─') /*display the foot sep for output. */
|
||||
Loading…
Add table
Add a link
Reference in a new issue