aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

63
Task/Digital-root-Multiplicative-digital-root/XPL0/digital-root-multiplicative-digital-root.xpl0 Normal file
View file

@ -0,0 +1,63 @@
\Calculate the Multiplicative Digital Root (MDR) and
\ Multiplicative Persistence (MP) of N
procedure GetMDR ( N, MDR, MP );
integer N, MDR, MP, V;
begin
MP(0) := 0;
MDR(0) := abs( N );
while MDR(0) > 9 do begin
V := MDR(0);
MDR(0) := 1;
repeat
MDR(0) := MDR(0) * rem( V / 10 );
V := V / 10;
until V = 0;
MP(0) := MP(0) + 1;
end; \while_mdr_gt_9
end; \GetMDR
define RequiredMDRs = 5;
integer FirstFew ( 9+1, 1+RequiredMDRs );
integer MDRFound ( 9+1 );
integer TotalFound, FoundPos, RequiredTotal, N, I, V, L;
integer MDR, MP;
begin
\task test cases
Text(0, " N MDR MP^m^j" );
L := [ 123321, 7739, 893, 899998 ];
for N := 0 to 3 do begin
GetMDR( L(N), @MDR, @MP );
Format(8, 0); RlOut(0, float(L(N)));
Format(4, 0); RlOut(0, float(MDR));
Format(3, 0); RlOut(0, float(MP));
CrLf(0)
end; \for_N
\find the first 5 numbers with each possible MDR
begin
for I := 0 to 9 do MDRFound( I ) := 0;
TotalFound := 0;
RequiredTotal := 10 * RequiredMDRs;
N := -1;
while TotalFound < RequiredTotal do begin
N := N + 1;
GetMDR( N, @MDR, @MP );
if MDRFound( MDR ) < RequiredMDRs then begin
\Found another number with this MDR and haven't found enough
TotalFound := TotalFound + 1;
MDRFound( MDR ) := MDRFound( MDR ) + 1;
FirstFew( MDR, MDRFound( MDR ) ) := N
end \if_Found_another_MDR
end; \while_TotalFound_lt_RequiredTotal
\print the table of MDRs and numbers
Text(0, "MDR: [N0..N4]^m^j" );
Text(0, "=== ========^m^j" );
for V := 0 to 9 do begin
ChOut(0, ^ ); IntOut(0, V); Text(0, ": [");
for FoundPos := 1 to RequiredMDRs do begin
if FoundPos > 1 then Text( 0, ", " );
IntOut( 0, FirstFew( V, FoundPos ) )
end; \for_FoundPos
Text(0, "]^m^j")
end \for_v
end
end