Inconsummate numbers in base 10: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Algol 68)
(→‎{{header|Python}}: prepend Pascal. no divisor of a niven number)
Line 103: Line 103:
491 492 493 494 497 498 516 521 522 527
491 492 493 494 497 498 516 521 522 527
Inconsummate number 1000: 6996
Inconsummate number 1000: 6996
</pre>

=={{header|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>
program Inconsummate;

{$IFDEF FPC}
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=8,loop=1}
{$ENDIF}

uses
SysUtils;

const
base = 10;

type
// tNum = 0..250 * 1000;// 6996
// tNum = 0..260 * 10000;// 59837
// tNum = 0..290 * 100000;//536081
tNum = 0..319 * 1000000;//5073249

const
cntbasedigits = 16;//trunc(ln(High(tNum)) / ln(base)) + 1;

type
tSumDigit = record
sdDigits: array[0..cntbasedigits - 1] of byte;
sdSumDig: uint32;
sdNumber: tNum;
sdDiv: tNum;
sdIsNiven: boolean;
end;
var
isN: array[0..High(tNUm) div 1 + 1] of boolean;

function InitSumDigit(n: tNum): tSumDigit;
var
sd: tSumDigit;
qt: tNum;
i: integer;
begin
with sd do
begin
sdNumber := n;
fillchar(sdDigits, SizeOf(sdDigits), #0);

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;

var
MySumDig: tSumDigit;
lnn: tNum;
Limit, cnt: integer;

begin
{$IFNDEF FPC}
cntbasedigits := trunc(ln(High(tNum)) / ln(base)) + 1;
{$ENDIF}
MySumDig := InitSumDigit(0);
cnt := 0;
with MySumDig do
repeat
IncSumDigit(MySumDig);
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
Inc(cnt);
Write(lnn: 5);
if (cnt = limit) then
begin
writeln;
Inc(limit, 10);
end;
if cnt >= 50 then
BREAK;
end;
writeln;

limit := 100;
for lnn := lnn + 1 to High(isN) - 1 do
if not (isN[lnn]) then
begin
Inc(cnt);
if cnt = limit then
begin
Writeln(limit: 10, lnn: 10);
limit *= 10;
if limit > 1000 * 1000 then
EXIT;
end;
end;
writeln;
writeln(cnt);
end.
</syntaxhighlight>
{{out|@TIO.RUN}}
<pre> 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

100 936
1000 6996
10000 59853
100000 536081
1000000 5073249

Real time: 3.342 s CPU share: 99.16 %
</pre>
</pre>



Revision as of 12:35, 28 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

ALGOL 68

Constructs a table of digit sums and from that a table of consummate numbers. The table of consummate numbers will be inaccurate for numbers > 9999.

BEGIN # find some incomsummate numbers: integers that cannot be expressed as #
      #      an integer divided by the sum of its digits                     #
    INT max number = 499 999; # maximum number we will consider              #
                              # chosen because if we assume the 1000th       #
                              # inconsummate number is <= 9 999, then the    #
                              # maximum possible digit sum is 45 and so the  #
                              # maximum number to test would be 45 x 9 999   #
                              # i.e.: 449 955                                #
    # construct the digit sums of the numbers up to max number               #
    [ 0 : max number ]INT dsum;
    INT tn := 0, hn := 0, th := 0, tt := 0, ht := 0, dpos := -1;
    WHILE ht /= 5 DO
        INT sumd = ht + tt + th + hn + tn;
        dsum[ dpos +:= 1 ] := sumd;
        dsum[ dpos +:= 1 ] := sumd + 1;
        dsum[ dpos +:= 1 ] := sumd + 2;
        dsum[ dpos +:= 1 ] := sumd + 3;
        dsum[ dpos +:= 1 ] := sumd + 4;
        dsum[ dpos +:= 1 ] := sumd + 5;
        dsum[ dpos +:= 1 ] := sumd + 6;
        dsum[ dpos +:= 1 ] := sumd + 7;
        dsum[ dpos +:= 1 ] := sumd + 8;
        dsum[ dpos +:= 1 ] := sumd + 9;
        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;
                        ht +:= 1
                    FI
                FI
            FI
        FI
    OD;
    # table of numbers that can be formed by n / dsum[ n ]                   #
    [ 0 : max number ]BOOL consummate;
    FOR i FROM LWB consummate TO UPB consummate DO
        consummate[ i ] := FALSE
    OD;
    FOR i TO UPB d sum DO
        IF i MOD dsum[ i ] = 0 THEN
            consummate[ i OVER dsum[ i ] ] := TRUE
        FI
    OD;
    INT count := 0;
    print( ( "The first 50 inconsummate numbers:", newline ) );
    FOR i TO UPB consummate WHILE count < 1000 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 THEN
               print( ( "Inconsummate number ", whole( count, 0 ), ": ", whole( i, 0 ), 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

Pascal

Free Pascal

Inconsummate numbers are not a divisor of a niven number.
Therefore I tried a solution niven number.
There is only a small increase in the needed factor in count of Inconsummate numbers

program Inconsummate;

{$IFDEF FPC}
  {$MODE DELPHI}{$OPTIMIZATION ON,ALL}{$CODEALIGN proc=8,loop=1}
{$ENDIF}

uses
  SysUtils;

const
  base = 10;

type
  //  tNum = 0..250 * 1000;//    6996
  //  tNum = 0..260 * 10000;//  59837
  //  tNum = 0..290 * 100000;//536081
  tNum = 0..319 * 1000000;//5073249

const
  cntbasedigits = 16;//trunc(ln(High(tNum)) / ln(base)) + 1;

type
  tSumDigit = record
    sdDigits: array[0..cntbasedigits - 1] of byte;
    sdSumDig: uint32;
    sdNumber: tNum;
    sdDiv: tNum;
    sdIsNiven: boolean;
  end;
var
  isN: array[0..High(tNUm) div 1 + 1] of boolean;

  function InitSumDigit(n: tNum): tSumDigit;
  var
    sd: tSumDigit;
    qt: tNum;
    i: integer;
  begin
    with sd do
    begin
      sdNumber := n;
      fillchar(sdDigits, SizeOf(sdDigits), #0);

      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;

var
  MySumDig: tSumDigit;
  lnn: tNum;
  Limit, cnt: integer;

begin
{$IFNDEF FPC}
  cntbasedigits := trunc(ln(High(tNum)) / ln(base)) + 1;
{$ENDIF}
  MySumDig := InitSumDigit(0);
  cnt := 0;
  with MySumDig do
    repeat
      IncSumDigit(MySumDig);
      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
      Inc(cnt);
      Write(lnn: 5);
      if (cnt = limit) then
      begin
        writeln;
        Inc(limit, 10);
      end;
      if cnt >= 50 then
        BREAK;
    end;
  writeln;

  limit := 100;
  for lnn := lnn + 1 to High(isN) - 1 do
    if not (isN[lnn]) then
    begin
      Inc(cnt);
      if cnt = limit then
      begin
        Writeln(limit: 10, lnn: 10);
        limit *= 10;
        if limit > 1000 * 1000 then
          EXIT;
      end;
    end;
  writeln;
  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

       100       936
      1000      6996
     10000     59853
    100000    536081
   1000000   5073249

Real time: 3.342 s CPU share: 99.16 %

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 = 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: 375410

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

Library: Wren-math
Library: Wren-fmt

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.

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:

Translation of: Python

Though I think the Python version is in fact wrong for the 100,000th number since if you enumerate up to 10,000 you get the 10,000th inconsummate number to be 42,171 rather than 59,853.

The problem seems to be that the minimum divisor for (say) 6 digit numbers is not 999999/54 = 18518 but 109999/37 = 2972. I've corrected for that in the following translation.

import "./math" for Int, Nums
import "./fmt" for Fmt

var generateInconsummate = Fn.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 gi = Fiber.new(generateInconsummate)
var incons = List.filled(50, 0)
var incons1k
var incons10k
var incons100k
System.print("First 50 inconsummate numbers in base 10:")

for (i in 1..100000) {
    var j = gi.call(100000)
    if (i <= 50) {
        incons[i-1] = j
    } else if (i == 1000) {
        incons1k = j
    } else if (i == 10000) {
        incons10k = j
    } else if (i == 100000) {
        incons100k = j
    }
}
Fmt.tprint("$3d", incons, 10)
Fmt.print("\nOne thousandth $,d", incons1k)
Fmt.print("Ten thousandth $,d", incons10k)
Fmt.print("100 thousandth $,d", incons100k)
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