Self numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
No edit summary
(added Pascal)
Line 23: Line 23:
1022727208
1022727208
</pre>
</pre>
=={{header|Pascal}}==
{{works with|Free Pascal}}<BR>
Just "sieving" with followers of the selfnumbers up to the limit.
<lang pascal>
program selfnumbers;
{$IFDEF FPC}
{$MODE Delphi}
{$Optimization ON,ALL}
{$IFEND}
{$IFDEF DELPHI} {$APPTYPE CONSOLE} {$IFEND}
const
BASE = 10;
type
tNumber = record
digits : array[0..23] of byte;
value,
dgtCount,
sumDigit :NativeUint;
end;
tpNumber = ^tNumber;
var
Sieve : array[0..(1022727208 DIV 32 +1)*32] of byte;//1022727208
DgtSumNumbers: array[0..19*9] of tNumber;

procedure NewNumber(n: NativeUint;var number:tNumber);
//convert Number into digits and sum of digits
var
i,r,d : NativeUint;
Begin
i := 0;
number.sumDigit := 0;
number.value := n;
repeat
r := n DIV BASE;
d := n-BASE*r;
number.digits[i] := d;
inc(number.sumDigit,d);
n:= r;
inc(i);
until n = 0;
number.dgtCount := i;
end;

procedure NextNumber(var number:tNumber);
//add sumofdigits to number -> number
var
pDigitSum : tpNumber;
i,c,d,sum : NativeUint;
Begin
with number do
Begin
pDigitSum := @DgtSumNumbers[sumDigit];
value:= value+sumDigit;
end;

i := 0;
sum := 0;
c := 0;
repeat
d := number.digits[i]+pDigitSum^.digits[i]+c;
c := 0;
if d >= base then
Begin
d -= BASE;
c := 1;
end;
number.digits[i] := d;
sum += d;
inc(i);
until i = number.dgtCount;

If c > 0 then
Begin
number.digits[i] := 1;
inc(sum);
inc(number.dgtCount)
end;
number.sumDigit := sum;
end;

var
number: tNumber;
StartNum,actNum,cnt: NativeUint;
begin
for actNum := 1 to High(DgtSumNumbers) do
NewNumber(actNum,DgtSumNumbers[actNum]);

StartNum := 0;
cnt := 0;
repeat
//search next selfnumber
While Startnum<High(Sieve) do
begin
inc(Startnum);
if Sieve[Startnum] = 0 then
Break;
end;
inc(cnt);

If Startnum >=High(Sieve) then
Halt(-253);

If cnt <51 then
write(Startnum,' ');

IF cnt = 100*1000*1000 then
Begin
writeln;
writeln(cnt:10,Startnum:15);
BREAK;
end;

NewNumber(StartNum,number);
NextNumber(number);
actNum := number.value;
// mark not selfnumbers
while actNum <= High(Sieve) do
Begin
IF Sieve[actNum] = 0 then
Sieve[actNum]:= 1
else
BREAK;
NextNumber(number);
actNum := number.value;
end;

until false;
writeln('finished');
end.</lang>
{{out}}
<pre>
1 3 5 7 9 20 31 42 53 64 75 86 97 108 110 121 132 143 154 165 176 187 198 209 211 222 233 244 255 266 277 288 299 310 312 323 334 345 356 367 378 389 400 411 413 424 435 446 457 468
100000000 1022727208
finished</pre>

real 0m18,764s

Revision as of 18:24, 6 October 2020

Self numbers 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 number n is a self number if there is no number g such that g + the sum of g's digits = n. So 18 is not a self number because 9+9=18, 43 is not a self number because 35+5+3=43.
The task is:

 Display the first 50 self numbers;
 I believe that the 100000000th self number is 1022727208. You should either confirm or dispute my conjecture.

224036583-1 is a Mersenne prime, claimed to also be a self number. Extra credit to anyone proving it.

F#

<lang fsharp> // Self numbers. Nigel Galloway: October 6th., 2020 let fN g=let rec fG n g=match n/10 with 0->n+g |i->fG i (g+(n%10)) in fG g g let Self=let rec Self n i g=seq{let g=g@([n..i]|>List.map fN) in yield! List.except g [n..i]; yield! Self (n+100) (i+100) (List.filter(fun n->n>i) g)} in Self 0 99 []

Self |> Seq.take 50 |> Seq.iter(printf "%d "); printfn "" printfn "\n%d" (Seq.item 99999999 Self) </lang>

Output:
1 3 5 7 9 20 31 42 53 64 75 86 97 108 110 121 132 143 154 165 176 187 198 209 211 222 233 244 255 266 277 288 299 310 312 323 334 345 356 367 378 389 400 411 413 424 435 446 457 468

1022727208

Pascal

Works with: Free Pascal


Just "sieving" with followers of the selfnumbers up to the limit. <lang pascal> program selfnumbers; {$IFDEF FPC}

 {$MODE Delphi}
 {$Optimization ON,ALL}

{$IFEND} {$IFDEF DELPHI} {$APPTYPE CONSOLE} {$IFEND} const

 BASE = 10;

type

 tNumber = record
             digits : array[0..23] of byte;
             value,
             dgtCount,
             sumDigit :NativeUint;
           end;
 tpNumber = ^tNumber;

var

 Sieve : array[0..(1022727208 DIV 32 +1)*32] of byte;//1022727208
 DgtSumNumbers: array[0..19*9] of tNumber;

procedure NewNumber(n: NativeUint;var number:tNumber); //convert Number into digits and sum of digits var

 i,r,d : NativeUint;

Begin

 i := 0;
 number.sumDigit := 0;
 number.value := n;
 repeat
   r := n DIV BASE;
   d := n-BASE*r;
   number.digits[i] := d;
   inc(number.sumDigit,d);
   n:= r;
   inc(i);
 until n = 0;
 number.dgtCount := i;

end;

procedure NextNumber(var number:tNumber); //add sumofdigits to number -> number var

 pDigitSum : tpNumber;
 i,c,d,sum : NativeUint;

Begin

 with number do
 Begin
   pDigitSum := @DgtSumNumbers[sumDigit];
   value:= value+sumDigit;
 end;
 i := 0;
 sum := 0;
 c := 0;
 repeat
   d := number.digits[i]+pDigitSum^.digits[i]+c;
   c := 0;
   if d >= base then
   Begin
     d -= BASE;
     c := 1;
   end;
   number.digits[i] := d;
   sum += d;
   inc(i);
 until i = number.dgtCount;
 If c > 0 then
 Begin
   number.digits[i] := 1;
   inc(sum);
   inc(number.dgtCount)
 end;
 number.sumDigit := sum;

end;

var

 number: tNumber;
 StartNum,actNum,cnt: NativeUint;

begin

 for actNum := 1 to High(DgtSumNumbers) do
   NewNumber(actNum,DgtSumNumbers[actNum]);
 StartNum := 0;
 cnt := 0;
 repeat
   //search next selfnumber
   While Startnum<High(Sieve) do
   begin
     inc(Startnum);
     if Sieve[Startnum] = 0 then
       Break;
   end;
   inc(cnt);
   If Startnum >=High(Sieve) then
     Halt(-253);
   If cnt <51 then
     write(Startnum,' ');
   IF cnt = 100*1000*1000 then
   Begin
     writeln;
     writeln(cnt:10,Startnum:15);
     BREAK;
   end;
   NewNumber(StartNum,number);
   NextNumber(number);
   actNum := number.value;

// mark not selfnumbers

   while actNum <= High(Sieve) do
   Begin
     IF Sieve[actNum] = 0 then
       Sieve[actNum]:= 1
     else
       BREAK;
     NextNumber(number);
     actNum := number.value;
   end;
 until false;
 writeln('finished');

end.</lang>

Output:
1 3 5 7 9 20 31 42 53 64 75 86 97 108 110 121 132 143 154 165 176 187 198 209 211 222 233 244 255 266 277 288 299 310 312 323 334 345 356 367 378 389 400 411 413 424 435 446 457 468
 100000000     1022727208
finished

real 0m18,764s