Jump to content

Digital root/Multiplicative digital root: Difference between revisions

Digital root/Multiplicative digital root (view source)

Revision as of 14:04, 15 September 2017

1,362 bytes added ,  6 years ago
m
→‎ultra-fast version: added/changed comments, whitespace, and indentations, optimized a function, used a template for output.
m (→‎idomatic version: added/changed comments and whitespace, optimized a function, used a template for the output.)
m (→‎ultra-fast version: added/changed comments, whitespace, and indentations, optimized a function, used a template for output.)
Line 2,217:
===ultra-fast version===
This fast version can handle a target of five hundred numbers with ease for the 2<sup>nd</sup> part of the task's requirement.
<lang rexx>/*REXX pgmprogram finds the persistence and multiplicative digital root of some #'snumbers.*/
numeric digits 2000 /*increase the number of digits.decimal digits*/
parse arg target x; if \datatype(target,'W') then target=25 /*default?obtain optional arguments from the CL*/
if x=\datatype(target, 'W') then xtarget=12332125 7739 893 899998 /*use the defaults for X/*Not specified? Then use the default.*/
if x='' | x="," then endx=123321 7739 893 899998 /*k*/ " " " /* [↑]" " " 1st " " "*/▼
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 MDR(n) with mp mdr /*obtain the persistence and the MDR. */
say right(n,8) center(mp,13) center(mdr,30) /*display #the number, mppersistence, mdrMDR.*/
end /*j*/ /* [↑] show MP and MDR for each #number.*/
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 sepseparator line (for title).*/
 
do k=0 for 9; hits=0; _= /*show #'snumbers that have an MDR of K. */
_=
if k==7 then _=@7; else /*handle the special seven case. of seven. */
else do m=k until hits==target /*find target numbers with an MDR of K.*/
new= parse var m '' -1 ? /*this isobtain the newright─most numbersdigit soof far M. */▼
if k\==50 then if ?//2==0 then iterate▼
else if mdr(m,1)\k==k5 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; _=space(_ m) /*yes, we /*got a hit, add to the list.*/▼
@3= _=space(_ m) /*assine nullelide stringsuperfluous beforeblanks. build*/▼
if k==3 then do; o=strip(m, 'T', 1) /*strip trailing ones from M*/
end if o==3 then /*m=copies(1, [↑]length(m))3 a shortcut/*make toa donew DO indexM.*/▼
end /* [↑] shift the " else do; t=pos(3", m) - 1 place left /*position of 3 */▼
exit /*stick a fork in it m=overlay(3, we'retranslate(m, 1, 3), done.*/t)▼
end /*j*/ end /* [↑] shift end of insertion ofthe "3"s 1 place left.*/▼
m=m - 1 /*adjust for DO index advancementincrement.*/▼
end /*m*/ end /* [↑] built a list ofshortcut MDRsto =adj kDO index*/▼
end /*im*/ /* [↑] endbuilt a list of 2ndMDRs insertion= K of 3*/▼
 
say " "k': ['_"]" do m=k until hits==target /*finddisplay targetthe #s withK an (MDR) of Kand the list. */
if k==3 then ?@7=righttranslate(m_,1) 7, k) /*save for later, a special "7" /*obtain right-most digit of Mcase. */
end if /*k\==0*/ then if ?==0/* [↑] done with the K MDR list. 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; _=space(_ m) /*yes, we got a hit, add to list.*/
 
@.= if k==3 then do; o=strip(m,'T',1) /*strip trailing[↓] handle MDR of "9" special. ones*/
_=translate(@7, 9, 7) if o==3 then m=copies(1,length(m))3 /*maketranslate newstring for MMDR of nine. */
@9=translate(_, , ',') else/*remove do;trailing commas from t=pos(3,m)-1 /*position ofnumbers. 3*/
@3= m=overlay(3,translate(m,1,3),t) /*assign null string before building. */
▲ end /* [↑] shift the "3" 1 place left*/
▲ m=m-1 /*adjust for DO index advancement*/
▲ end /* [↑] a shortcut to do DO index*/
▲ end /*m*/ /* [↑] built a list of MDRs = k */
 
do j=1 for words(@9) say " "k': ['_"]" /*displayprocess theeach number Kfor (mdr)MDR 9 and listcase.*/
if k_==3 space( then @7=translate(_ word(@9,7 j),k , 9), 0) /*saveelide forall later, special"9"s 7 case using SPACE(x,0).*/
L=length(_) + 1 end /*k*/ /*use [↑]a "fudged" donelength withof the Knumber. mdr list.*/
@. new= /*these [↓]are the handlenew MDRnumbers of 9(so specialfar). */
_=translate(@7,9,7) /*translate a string for MDR 9. */
@9=translate(_,,',') /*remove trailing commas from #'s*/▼
▲@3= /*assine null string before build*/
do j=1 for words(@9) /*process each number for MDR 9. */
_=space(translate(word(@9,j),,9),0) /*remove "9"s using SPACE(x,0)*/
L=length(_)+1 /*use a "fudged" length of the #.*/▼
▲ new= /*this is the new numbers so far.*/
do k=0 for L; q=insert(3,_,k) /*insert the 1st "3" into the #*/
do i=k to L; z=insert(3,q,i) /* " " 2nd "3" " " "*/
if @.z\=='' then iterate /*if already define, ignore the #*/
@.z=z; new=z new /*define it, and then add to list*/▼
▲ end /*i*/ /* [↑] end of 2nd insertion of 3*/
▲ end /*k*/ /* [↑] " " 1st " " "*/
@3=space(@3 new) /*remove blanks, then add to list*/
▲ end /*j*/ /* [↑] end of insertion of "3"s.*/
 
a1=@9; a2=@3; @= do k=0 for L; q=insert(3, _, k) /*defineinsert threethe strings for1st "3" into the merge.number*/
do i=k to L; z=insert(3, q, i) /* " " 2nd "3" /* [↓] " " merge two lists, 3s" & 9s.*/
do while a1if @.z\=='' & a2\==''then iterate /*processif whilealready thedefine, listsignore the ¬emptynumber.*/
▲ @.z=z; new=z new /*define it, and then add to the list.*/
x=word(a1,1); y=word(a2,1); if x=='' | y=='' then leave /*empty?*/▼
if x<y then do;end /*i*/ @=@ x; a1=delword(a1,1,1); end /*add X[↑] end of 2nd insertion of "3".*/
end /*k*/ else do; @=@ y; a2=delword(a2,1,1); end /*add Y.[↑] " " 1st " " " */
 
end /*while ···*/ /* [+] only process just 'nuff. */▼
@3=subwordspace(@,1,target3 new) /*elideremove theblanks, last trailingthen comma.add to the list.*/
say " "9': end /*j*/ ['@"]" /*display the[↑] 9end of (mdr)insertion andof listthe "3"s. */
 
▲exit /*stick a fork in it, we're done.*/
▲a1=@9; La2=length(_)+1@3 /*usedefine asome "fudged"strings length offor the #merge. */
/*──────────────────────────────────MDR subroutine──────────────────────*/
mdr:@= procedure; parse arg y,s /*get the[↓] merge two lists, 3s number and find the9s. MDR*/
do p=1 untildo y<10while a1\=='' & a2\=='' /*findprocess while the multiplicativelists digRootaren't (Y)empty.*/
▲ x=word(a1, 1); y=word(a2, 1); if x=='' | y=='' then leave /*empty?obtain the 1st word in A1 & A2 lists.*/
parse var y 1 r 2; do k=2 to length(y); r=r*substr(y,k,1); end; y=r▼
end /*p*/if x=='' | y=='' then leave /*are X or Y empty? /*wash, rinse, repeat ··· */
if s==1 then return r if x<y then do; @=@ x; a1=delword(a1, 1, 1); end /*returnadd X to multiplicativethe dig@ rootlist.*/
returnelse p rdo; @=@ y; a2=delword(a2, 1, 1); end /*return the" persistence and MDR.Y " " " " */</lang>
▲ end /*while ···*/ /* [+↑] only process just 'nuffenough nums. */
;;;output''' &nbsp' when the using the input of: &nbsp; <tt> 34 </tt>▼
 
▲@9=translatesubword(_@, 1,',' target) /*removeelide the last trailing commascomma fromin #'slist*/
say " "9': ['@"]" /*display the "9" (MDR) and the list.*/
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
▲ parse var y 1 r 2; do k=2 to length(y); r=r * substr(y, k, 1); end; y=r
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. */</lang>
▲;;;{{out|output''' |text=&nbsp'; when the using the input of: &nbsp; <tt> 34 </tt>}}
<pre>
number persistence multiplicative digital root
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/246079"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information