Self numbers

From Rosetta Code
Revision as of 18:24, 6 October 2020 by rosettacode>Horst.h (added Pascal)
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