Inconsummate numbers in base 10: Difference between revisions
Content added Content deleted
m (→{{header|Wren}}: Changes to preamble and made second version more compact.) |
(→{{header|Free Pascal}}: Faster version checking Digitalsum, testing for max used factor.) |
||
| Line 220: | Line 220: | ||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
==={{header|Free Pascal}}=== |
==={{header|Free Pascal}}=== |
||
Inconsummate numbers are not a divisor of a niven number.<br> |
|||
Therefore I tried a solution [[Harshad_or_Niven_series | niven number]].<br> |
|||
There is only a small increase in the needed factor in count of Inconsummate numbers |
|||
<syntaxhighlight lang=pascal> |
<syntaxhighlight lang=pascal> |
||
program Inconsummate; |
program Inconsummate; |
||
{$IFDEF FPC} |
{$IFDEF FPC} |
||
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=8,loop=1} |
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=8,loop=1} |
||
{$ENDIF} |
{$ENDIF} |
||
uses |
uses |
||
sysutils; |
|||
const |
const |
||
base = 10; |
base = 10; |
||
DgtSumLmt = base*base*base*base*base; |
|||
type |
type |
||
tDgtSum = array[0..DgtSumLmt-1] of byte; |
|||
var |
|||
// tNum = 0..260 * 10000;// 59837 |
|||
DgtSUm : tDgtSum; |
|||
// tNum = 0..290 * 100000;//536081 |
|||
max: Uint64; |
|||
tNum = 0..319 * 1000000;//5073249 |
|||
procedure Init(var ds:tDgtSum); |
|||
var |
|||
i,l,k0,k1: NativeUint; |
|||
Begin |
|||
For i := 0 to base-1 do |
|||
ds[i] := i; |
|||
k0 := base; |
|||
repeat |
|||
k1 := k0-1; |
|||
For i := 1 to base-1 do |
|||
For l := 0 to k1 do |
|||
begin |
|||
ds[k0] := ds[l]+i; |
|||
inc(k0); |
|||
end; |
|||
until k0 >= High(ds); |
|||
end; |
|||
const |
|||
cntbasedigits = 16;//trunc(ln(High(tNum)) / ln(base)) + 1; |
|||
function GetSumOfDecDigits(n:Uint64):NativeUint; |
|||
type |
|||
tSumDigit = record |
|||
sdDigits: array[0..cntbasedigits - 1] of byte; |
|||
sdSumDig: uint32; |
|||
sdNumber: tNum; |
|||
sdDiv: tNum; |
|||
sdIsNiven: boolean; |
|||
end; |
|||
var |
var |
||
r,d: NativeUint; |
|||
isN: array[0..High(tNUm) div 1 + 1] of boolean; |
|||
begin |
|||
result := 0; |
|||
repeat |
|||
r := n DIv DgtSumLmt; |
|||
d := n-r* DgtSumLmt; |
|||
result +=DgtSUm[d]; |
|||
n := r; |
|||
until r = 0; |
|||
end; |
|||
function OneTest(n:Nativeint):Boolean; |
|||
var |
|||
i,d : NativeInt; |
|||
begin |
|||
qt: tNum; |
|||
result := true; |
|||
d := n; |
|||
For i := 1 TO 121 DO |
|||
begin |
begin |
||
IF GetSumOfDecDigits(n)= i then |
|||
with sd do |
|||
Begin |
|||
if i > max then |
|||
max := i; |
|||
fillchar(sdDigits, SizeOf(sdDigits), #0); |
|||
Exit(false); |
|||
sdSumDig := 0; |
|||
sdIsNiven := False; |
|||
i := 0; |
|||
// calculate Digits und sum them up |
|||
while n > 0 do |
|||
begin |
|||
qt := n div base; |
|||
{n mod base} |
|||
sdDigits[i] := n - qt * base; |
|||
Inc(sdSumDig, sdDigits[i]); |
|||
n := qt; |
|||
Inc(i); |
|||
end; |
|||
if sdSumDig > 0 then |
|||
sdIsNiven := (sdNumber mod sdSumDig = 0); |
|||
end; |
|||
InitSumDigit := sd; |
|||
end; |
|||
procedure IncSumDigit(var sd: tSumDigit); |
|||
var |
|||
pD: pbyte; |
|||
i, d, s: uint32; |
|||
begin |
|||
i := 0; |
|||
pD := @sd.sdDigits[0]; |
|||
with sd do |
|||
begin |
|||
s := sdSumDig; |
|||
Inc(sdNumber); |
|||
repeat |
|||
d := pD[i]; |
|||
Inc(d); |
|||
Inc(s); |
|||
//base-1 times the repeat is left here |
|||
if d < base then |
|||
begin |
|||
pD[i] := d; |
|||
BREAK; |
|||
end |
|||
else |
|||
begin |
|||
pD[i] := 0; |
|||
Dec(s, base); |
|||
Inc(i); |
|||
end; |
|||
until i > high(sdDigits); |
|||
sdSumDig := s; |
|||
i := sdNumber div s; |
|||
sdDiv := i; |
|||
sdIsNiven := (sdNUmber - i * s) = 0; |
|||
end; |
end; |
||
n +=d; |
|||
end; |
end; |
||
end; |
|||
var |
var |
||
d, |
|||
MySumDig: tSumDigit; |
|||
cnt,lmt: Uint64; |
|||
Limit, cnt: integer; |
|||
begin |
begin |
||
Init(DgtSUm); |
|||
{$IFNDEF FPC} |
|||
cntbasedigits := trunc(ln(High(tNum)) / ln(base)) + 1; |
|||
{$ENDIF} |
|||
MySumDig := InitSumDigit(0); |
|||
cnt := 0; |
cnt := 0; |
||
For d := 1 to 527 do//5375540350 do |
|||
with MySumDig do |
|||
begin |
|||
repeat |
|||
if OneTest(d) then |
|||
if sdIsNiven then |
|||
isN[sdDiv] := True; |
|||
until sdnumber > High(tNum) - 1; |
|||
limit := 10; |
|||
for lnn := 1 to High(isN) - 1 do |
|||
if not (isN[lnn]) then |
|||
begin |
begin |
||
inc(cnt); |
|||
write(d:5); |
|||
if |
if cnt mod 10 = 0 then writeln; |
||
begin |
|||
writeln; |
|||
Inc(limit, 10); |
|||
end; |
|||
if cnt >= 50 then |
|||
BREAK; |
|||
end; |
end; |
||
end; |
|||
writeln; |
writeln; |
||
writeln('Count Number(count) Maxfactor needed'); |
|||
cnt := 0; |
|||
max := 0; |
|||
for lnn := lnn + 1 to High(isN) - 1 do |
|||
lmt := 10; |
|||
if not (isN[lnn]) then |
|||
For d := 1 to 50332353 do // 5260629551 do |
|||
begin |
|||
if OneTest(d) then |
|||
begin |
begin |
||
inc(cnt); |
|||
if cnt = |
if cnt = lmt then |
||
begin |
begin |
||
writeln(cnt:10,d:12,max:5); |
|||
lmt *=10; |
|||
if limit > 1000 * 1000 then |
|||
EXIT; |
|||
end; |
end; |
||
end; |
end; |
||
end; |
|||
writeln(cnt); |
writeln(cnt); |
||
end. |
end. |
||
</syntaxhighlight> |
</syntaxhighlight> |
||
{{out|@TIO.RUN}} |
{{out|@TIO.RUN}} |
||
<pre> |
|||
<pre> 62 63 65 75 84 95 161 173 195 216 |
|||
62 63 65 75 84 95 161 173 195 216 |
|||
261 266 272 276 326 371 372 377 381 383 |
261 266 272 276 326 371 372 377 381 383 |
||
386 387 395 411 416 422 426 431 432 438 |
386 387 395 411 416 422 426 431 432 438 |
||
| Line 379: | Line 328: | ||
491 492 493 494 497 498 516 521 522 527 |
491 492 493 494 497 498 516 521 522 527 |
||
Count Number(count) Maxfactor needed |
|||
100 936 |
|||
10 216 27 |
|||
100 936 36 |
|||
1000 6996 36 |
|||
10000 59853 54 |
|||
1000000 5073249 |
|||
100000 536081 63 |
|||
1000000 5073249 69 |
|||
10000000 50332353 81 |
|||
10000000 |
|||
Real time: 23.898 s |
|||
@Home AMD 5600G 4.4 Ghz: |
|||
Count Number(count) Maxfactor needed |
|||
10 216 27 |
|||
100 936 36 |
|||
1000 6996 36 |
|||
10000 59853 54 |
|||
100000 536081 63 |
|||
1000000 5073249 69 |
|||
10000000 50332353 81 //real 0m6,395s |
|||
100000000 517554035 87 |
|||
1000000000 5260629551 96 |
|||
1000000000 |
|||
real 15m54,915s |
|||
Real time: 3.342 s CPU share: 99.16 % |
|||
</pre> |
</pre> |
||
Revision as of 07:12, 30 September 2022
Inconsummate numbers in base 10 is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
A consummate number is a non-negative integer that can be formed by some integer N divided by the the digital sum of N.
- For instance
47 is a consummate number.
846 / (8 + 4 + 6) = 47
On the other hand, there are integers that can not be formed by a ratio of any integer over its digital sum. These numbers are known as inconsummate numbers.
62 is an inconsummate number. There is no integer ratio of an integer to its digital sum that will result in 62.
The base that a number is expressed in will affect whether it is inconsummate or not. This task will be restricted to base 10.
- Task
- Write a routine to find inconsummate numbers in base 10;
- Use that routine to find and display the first fifty inconsummate numbers.
- Stretch
- Use that routine to find and display the one thousandth inconsummate number.
- See also
Action!
and based on the Algol 68 sample. As with the PL/M sample, the limit of 16 bit arithmetic means only the basic task can be handled.
;;; find some incomsummate numbers: integers that cannot be expressed as
;;; an integer divided by the sum of its digits
PROC Main()
CARD i, tn, hn, th, tt, sumD, d, n, dRatio, count, maxSum, v, maxNumber
; table of numbers that can be formed by n / digit sum n
DEFINE MAX_C = "999"
BYTE ARRAY consummate(MAX_C+1)
FOR i = 0 TO MAX_C DO
consummate( i ) = 0
OD
; calculate the maximum number we must consider
v = MAX_C / 10;
maxSum = 9;
WHILE v > 0 DO
maxSum ==+ 9
v ==/ 10
OD
maxNumber = maxSum * MAX_C
; construct the digit sums of the numbers up to maxNumber
; and find the consumate numbers, we start the loop from 10 to avoid
; having to deal with 0-9
consummate( 1 ) = 1
tn = 1 hn = 0 th = 0 tt = 0
FOR n = 10 TO maxNumber STEP 10 DO
sumD = tt + th + hn + tn
FOR d = n TO n + 9 DO
IF d MOD sumD = 0 THEN
; d is comsummate
dRatio = d / sumD
IF dRatio <= MAX_C THEN
consummate( dRatio ) = 1
FI
FI
sumD ==+ 1
OD
tn ==+ 1
IF tn > 9 THEN
tn = 0
hn ==+ 1
IF hn > 9 THEN
hn = 0
th ==+ 1
IF th > 9 THEN
th = 0
tt ==+ 1
FI
FI
FI
OD
count = 0
PrintE( "The first 50 inconsummate numbers:" )
i = 0
WHILE i < MAX_C AND count < 50 DO
i ==+ 1
IF consummate( i ) = 0 THEN
count ==+ 1
Put(' )
IF i < 10 THEN Put(' ) FI
IF i < 100 THEN Put(' ) FI
IF i < 1000 THEN Put(' ) FI
PrintC( i )
IF count MOD 10 = 0 THEN PutE() FI
FI
OD
RETURN- Output:
The first 50 inconsummate numbers: 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527
ALGOL 68
BEGIN # find some incomsummate numbers: integers that cannot be expressed as #
# an integer divided by the sum of its digits #
# table of numbers that can be formed by n / digit sum n #
[ 0 : 999 999 ]BOOL consummate;
FOR i FROM LWB consummate TO UPB consummate DO
consummate[ i ] := FALSE
OD;
# calculate the maximum number we must consider to find consummate #
# numbers up to UPB consummate - which is 9 * the number of digits in #
# UPB consummate #
INT max sum := 9;
INT v := UPB consummate;
WHILE ( v OVERAB 10 ) > 0 DO max sum +:= 9 OD;
INT max number = UPB consummate * max sum;
# construct the digit sums of the numbers up to max number #
# and find the consumate numbers, we start the loop from 10 to avoid #
# having to deal with 0-9 #
consummate[ 1 ] := TRUE;
INT tn := 1, hn := 0, th := 0, tt := 0, ht := 0, mi := 0, tm := 0;
FOR n FROM 10 BY 10 TO max number DO
INT sumd := tm + mi + ht + tt + th + hn + tn;
FOR d FROM n TO n + 9 DO
IF d MOD sumd = 0 THEN
# d is comsummate #
IF INT d ratio = d OVER sumd;
d ratio <= UPB consummate
THEN
consummate[ d ratio ] := TRUE
FI
FI;
sumd +:= 1
OD;
IF ( tn +:= 1 ) > 9 THEN
tn := 0;
IF ( hn +:= 1 ) > 9 THEN
hn := 0;
IF ( th +:= 1 ) > 9 THEN
th := 0;
IF ( tt +:= 1 ) > 9 THEN
tt := 0;
IF ( ht +:= 1 ) > 9 THEN
ht := 0;
IF ( mi +:= 1 ) > 9 THEN
mi := 0;
tm +:= 1
FI
FI
FI
FI
FI
FI
OD;
INT count := 0;
print( ( "The first 50 inconsummate numbers:", newline ) );
FOR i TO UPB consummate WHILE count < 100 000 DO
IF NOT consummate[ i ] THEN
IF ( count +:= 1 ) < 51 THEN
print( ( whole( i, -6 ) ) );
IF count MOD 10 = 0 THEN print( ( newline ) ) FI
ELIF count = 1 000 OR count = 10 000 OR count = 100 000 THEN
print( ( "Inconsummate number ", whole( count, -6 )
, ": ", whole( i, -8 ), newline
)
)
FI
FI
OD
END- Output:
The first 50 inconsummate numbers:
62 63 65 75 84 95 161 173 195 216
261 266 272 276 326 371 372 377 381 383
386 387 395 411 416 422 426 431 432 438
441 443 461 466 471 476 482 483 486 488
491 492 493 494 497 498 516 521 522 527
Inconsummate number 1000: 6996
Inconsummate number 10000: 59853
Inconsummate number 100000: 536081
J
With:
dsum=: [: +/"(1) 10&#.inv NB. digital sum
incons=: (-. (% dsum))&(1+i.) (90* 10 >.&.^. ]) NB. exclude many digital sum ratios
We get:
5 10$incons 1000
62 63 65 75 84 95 161 173 195 216
261 266 272 276 326 371 372 377 381 383
386 387 395 411 416 422 426 431 432 438
441 443 461 466 471 476 482 483 486 488
491 492 493 494 497 498 516 521 522 527
999 { incons 10000
6996
9999 { incons 100000
59853
99999 { incons 1000000
536081
Pascal
Free Pascal
program Inconsummate;
{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=8,loop=1}
{$ENDIF}
uses
sysutils;
const
base = 10;
DgtSumLmt = base*base*base*base*base;
type
tDgtSum = array[0..DgtSumLmt-1] of byte;
var
DgtSUm : tDgtSum;
max: Uint64;
procedure Init(var ds:tDgtSum);
var
i,l,k0,k1: NativeUint;
Begin
For i := 0 to base-1 do
ds[i] := i;
k0 := base;
repeat
k1 := k0-1;
For i := 1 to base-1 do
For l := 0 to k1 do
begin
ds[k0] := ds[l]+i;
inc(k0);
end;
until k0 >= High(ds);
end;
function GetSumOfDecDigits(n:Uint64):NativeUint;
var
r,d: NativeUint;
begin
result := 0;
repeat
r := n DIv DgtSumLmt;
d := n-r* DgtSumLmt;
result +=DgtSUm[d];
n := r;
until r = 0;
end;
function OneTest(n:Nativeint):Boolean;
var
i,d : NativeInt;
begin
result := true;
d := n;
For i := 1 TO 121 DO
begin
IF GetSumOfDecDigits(n)= i then
Begin
if i > max then
max := i;
Exit(false);
end;
n +=d;
end;
end;
var
d,
cnt,lmt: Uint64;
begin
Init(DgtSUm);
cnt := 0;
For d := 1 to 527 do//5375540350 do
begin
if OneTest(d) then
begin
inc(cnt);
write(d:5);
if cnt mod 10 = 0 then writeln;
end;
end;
writeln;
writeln('Count Number(count) Maxfactor needed');
cnt := 0;
max := 0;
lmt := 10;
For d := 1 to 50332353 do // 5260629551 do
begin
if OneTest(d) then
begin
inc(cnt);
if cnt = lmt then
begin
writeln(cnt:10,d:12,max:5);
lmt *=10;
end;
end;
end;
writeln(cnt);
end.
- @TIO.RUN:
62 63 65 75 84 95 161 173 195 216
261 266 272 276 326 371 372 377 381 383
386 387 395 411 416 422 426 431 432 438
441 443 461 466 471 476 482 483 486 488
491 492 493 494 497 498 516 521 522 527
Count Number(count) Maxfactor needed
10 216 27
100 936 36
1000 6996 36
10000 59853 54
100000 536081 63
1000000 5073249 69
10000000 50332353 81
10000000
Real time: 23.898 s
@Home AMD 5600G 4.4 Ghz:
Count Number(count) Maxfactor needed
10 216 27
100 936 36
1000 6996 36
10000 59853 54
100000 536081 63
1000000 5073249 69
10000000 50332353 81 //real 0m6,395s
100000000 517554035 87
1000000000 5260629551 96
1000000000
real 15m54,915s
Perl
use v5.36;
use List::Util <sum max>;
sub table ($c, @V) { my $t = $c * (my $w = 2 + length max @V); ( sprintf( ('%'.$w.'d')x@V, @V) ) =~ s/.{1,$t}\K/\n/gr }
my $upto = 1e6;
my @cons = (0) x $upto;
for my $i (1..$upto) {
my $r = $i / sum split '', $i;
$cons[$r] = 1 if $r eq int $r;
}
my @incons = grep { $cons[$_]==0 } 1..$#cons;
say 'First fifty inconsummate numbers (in base 10):';
say table 10, @incons[0..49];
say "One thousandth: " . $incons[999];
- Output:
First fifty inconsummate numbers (in base 10): 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527 One thousandth: 6996
Phix
with javascript_semantics --constant limit = 1_000*250 -- NB: 250 magic'd out of thin air --constant limit = 10_000*269 -- NB: 269 magic'd out of thin air constant limit = 100_000*290 -- NB: 290 magic'd out of thin air sequence consummate = repeat(false,limit), inconsummate = {} function digital_sum(integer i) integer res = 0 while i do res += remainder(i,10) i = floor(i/10) end while return res end function for d=1 to limit do integer ds = digital_sum(d) if rmdr(d,ds)=0 then integer q = floor(d/ds) if q<=limit then consummate[q] = true end if end if end for for d=1 to limit do if not consummate[d] then inconsummate &= d end if end for printf(1,"First 50 inconsummate numbers in base 10:\n%s\n", join_by(inconsummate[1..50],1,10," ",fmt:="%3d")) printf(1,"One thousandth %,d\n", inconsummate[1_000]) printf(1,"Ten thousandth %,d\n", inconsummate[10_000]) printf(1,"100 thousandth %,d\n", inconsummate[100_000])
- Output:
First 50 inconsummate numbers in base 10: 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527 One thousandth 6,996 Ten thousandth 59,853 100 thousandth 536,081
PL/M
Based on the Algol 68 sample but only finds the first 50 Inconsummate numbers as it would require more than 16 bit arithmetic t0 go much further.
Calculating the digit sums as here appears to be faster than using MOD and division.
... under CP/M (or an emulator)
100H: /* FIND SOME INCOMSUMMATE NUMBERS: INTEGERS THAT CANNOT BE EXPRESSED */
/* AS AN INTEGER DIVIDED BY THE SUM OF ITS DIGITS */
DECLARE FALSE LITERALLY '0', TRUE LITERALLY '0FFH';
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* END SYSTEM CALL AND I/O ROUTINES */
DECLARE MAX$C LITERALLY '999', /* MAXIMUM NUMBER WE WILL TEST */
MAX$C$PLUS$1 LITERALLY '1000'; /* MAX$C + 1 FOR ARRAY BOUNDS */
DECLARE ( I, J, MAX$SUM, V, MAX$NUMBER, COUNT ) ADDRESS;
/* TABLE OF NUMBERS THAT CAN BE FORMED BY N / DIGIT SUM N */
DECLARE CONSUMMATE ( MAX$C$PLUS$1 ) ADDRESS;
DO I = 0 TO LAST( CONSUMMATE ); CONSUMMATE( I ) = FALSE; END;
/* CALCULATE THE MAXIMUM NUMBER WE MUST CONSIDER TO FIND CONSUMMATE */
/* NUMBERS UP TO LAST(CONSUMMATE)- WHICH IS 9 * THE NUMBER OF DIGITS IN */
/* LAST(CONSUMMATE) */
MAX$SUM = 9;
V = LAST( CONSUMMATE );
DO WHILE ( V := V / 10 ) > 0; MAX$SUM = MAX$SUM + 9; END;
MAX$NUMBER = LAST( CONSUMMATE ) * MAX$SUM;
/* CONSTRUCT THE DIGIT SUMS OF THE NUMBERS UP TO MAX$NUMBER */
/* AND FIND THE CONSUMATE NUMBERS, WE START THE LOOP FROM 10 TO AVOID */
/* HAVING TO DEAL WITH 0-9 */
DO;
DECLARE ( D, N, TN, HN, TH, TT, SUMD ) ADDRESS;
CONSUMMATE( 1 ) = TRUE;
TT, TH, HN = 0; TN = 1;
DO N = 10 TO MAX$NUMBER BY 10;
SUMD = TT + TH + HN + TN;
DO D = N TO N + 9;
IF D MOD SUMD = 0 THEN DO;
/* D IS COMSUMMATE */
DECLARE D$RATIO ADDRESS;
IF ( D$RATIO := D / SUMD ) <= LAST( CONSUMMATE ) THEN DO;
CONSUMMATE( D$RATIO ) = TRUE;
END;
END;
SUMD = SUMD + 1;
END;
IF ( TN := TN + 1 ) > 9 THEN DO;
TN = 0;
IF ( HN := HN + 1 ) > 9 THEN DO;
HN = 0;
IF ( TH := TH + 1 ) > 9 THEN DO;
TH = 0;
TT = TT + 1;
END;
END;
END;
END;
END;
COUNT = 0;
CALL PR$STRING( .'THE FIRST 50 INCONSUMMATE NUMBERS:$' );CALL PR$NL;
I = 0;
DO WHILE ( I := I + 1 ) <= LAST( CONSUMMATE ) AND COUNT < 50;
IF NOT CONSUMMATE( I ) THEN DO;
IF I < 10 THEN CALL PR$CHAR( ' ' );
IF I < 100 THEN CALL PR$CHAR( ' ' );
IF I < 1000 THEN CALL PR$CHAR( ' ' );
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( I );
IF ( COUNT := COUNT + 1 ) MOD 10 = 0 THEN CALL PR$NL;
END;
END;
EOF- Output:
THE FIRST 50 INCONSUMMATE NUMBERS: 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527
Python
''' Rosetta code rosettacode.org/wiki/Inconsummate_numbers_in_base_10 '''
def digitalsum(num):
''' Return sum of digits of a number in base 10 '''
return sum(int(d) for d in str(num))
def generate_inconsummate(max_wanted):
''' generate the series of inconsummate numbers up to max_wanted '''
minimum_digitsums = [(10**i, int((10**i - 1) / (9 * i)))
for i in range(1, 15)]
limit = 20 * min(p[0] for p in minimum_digitsums if p[1] > max_wanted)
arr = [1] + [0] * (limit - 1)
for dividend in range(1, limit):
quo, rem = divmod(dividend, digitalsum(dividend))
if rem == 0 and quo < limit:
arr[quo] = 1
for j, flag in enumerate(arr):
if flag == 0:
yield j
for i, n in enumerate(generate_inconsummate(100000)):
if i < 50:
print(f'{n:6}', end='\n' if (i + 1) % 10 == 0 else '')
elif i == 999:
print('\nThousandth inconsummate number:', n)
elif i == 9999:
print('\nTen-thousanth inconsummate number:', n)
elif i == 99999:
print('\nHundred-thousanth inconsummate number:', n)
break
- Output:
62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527 Thousandth inconsummate number: 6996 Ten-thousanth inconsummate number: 59853 Hundred-thousanth inconsummate number: 536081
Raku
Not really pleased with this entry. It works, but seems inelegant.
my $upto = 1000;
my @ratios = unique (^∞).race.map({($_ / .comb.sum).narrow})[^($upto²)].grep: Int;
my @incons = (sort keys (1..$upto * 10) (-) @ratios)[^$upto];
put "First fifty inconsummate numbers (in base 10):\n" ~ @incons[^50]».fmt("%3d").batch(10).join: "\n";
put "\nOne thousandth: " ~ @incons[999]
- Output:
First fifty inconsummate numbers (in base 10): 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527 One thousandth: 6996
Wren
It appears to be more than enough to calculate ratios for all numbers up to 999,999 (which only takes about 0.4 seconds on my machine) to be sure of finding the 1,000th inconsummate number.
In fact it still finds the 1,000th number if you limit the search to the first 249,999 (but not 248,999) numbers which may be where the first magic number of '250' comes from in the Pascal/Phix entries.
import "./math" for Int
import "./fmt" for Fmt
// Maximum ratio for 6 digit numbers is 100,000
var cons = List.filled(100001, false)
for (i in 1..999999) {
var ds = Int.digitSum(i)
var ids = i/ds
if (ids.isInteger) cons[ids] = true
}
var incons = []
for (i in 1...cons.count) {
if (!cons[i]) incons.add(i)
}
System.print("First 50 inconsummate numbers in base 10:")
Fmt.tprint("$3d", incons[0..49], 10)
Fmt.print("\nOne thousandth: $,d", incons[999])- Output:
First 50 inconsummate numbers in base 10: 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527 One thousandth: 6,996
Alternatively and more generally:
...though much quicker as I'm using lower figures for the second component of the minDigitSums tuples.
import "./math" for Int, Nums
import "./fmt" for Fmt
var generateInconsummate = Fiber.new { |maxWanted|
var minDigitSums = (2..14).map { |i| [10.pow(i), ((10.pow(i-2) * 11 - 1) / (9 * i - 17)).floor] }
var limit = Nums.min(minDigitSums.where { |p| p[1] > maxWanted }.map { |p| p[0] })
var arr = List.filled(limit, 0)
arr[0] = 1
for (dividend in 1...limit) {
var ds = Int.digitSum(dividend)
var quo = (dividend/ds).floor
var rem = dividend % ds
if (rem == 0 && quo < limit) arr[quo] = 1
}
for (j in 0...arr.count) {
if (arr[j] == 0) Fiber.yield(j)
}
}
var incons = List.filled(50, 0)
System.print("First 50 inconsummate numbers in base 10:")
for (i in 1..100000) {
var j = generateInconsummate.call(100000)
if (i <= 50) {
incons[i-1] = j
if (i == 50) Fmt.tprint("$3d", incons, 10)
} else if (i == 1000) {
Fmt.print("\nOne thousandth $,d", j)
} else if (i == 10000) {
Fmt.print("Ten thousandth $,d", j)
} else if (i == 100000) {
Fmt.print("100 thousandth $,d", j)
}
}- Output:
First 50 inconsummate numbers in base 10: 62 63 65 75 84 95 161 173 195 216 261 266 272 276 326 371 372 377 381 383 386 387 395 411 416 422 426 431 432 438 441 443 461 466 471 476 482 483 486 488 491 492 493 494 497 498 516 521 522 527 One thousandth 6,996 Ten thousandth 59,853 100 thousandth 536,081