Inconsummate numbers in base 10: Difference between revisions

</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 %