Smallest numbers

Smallest 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.

Task

Smallest number k > 0 such that the decimal expansion of k^k contains n, where n < 51

ALGOL 68

Works with: ALGOL 68G version Any - tested with release 2.8.3.win32

Uses ALGOL 68G's LOMG LONG INT which provides large integers (the default precision is sufficient for the task). Also uses the ALGOL 68G string in string procedure. <lang algol68>BEGIN # find the smallest k such that the decimal representation of k^k contains n for 0 <= n <= 50 #

   # start with powers up to 20^20, if this proves insufficient, the kk array will be extended #
   FLEX[ 1 : 20 ]STRING kk;
   FOR k TO UPB kk DO kk[ k ] := whole( LONG LONG INT( k ) ^ k, 0 ) OD;
   # find the numbers #
   FOR i FROM 0 TO 50 DO
       STRING n      = whole( i, 0 );
       BOOL try again := TRUE;
       WHILE try again DO
           try again := FALSE;
           BOOL   found := FALSE;
           FOR k FROM LWB kk TO UPB kk WHILE NOT found DO
               IF string in string( n, NIL, kk[ k ] ) THEN
                   found := TRUE;
                   print( ( " ", whole( k, -3 ) ) )
               FI
           OD;
           IF NOT found THEN
               # haven't got enough k^k values - get some more #
               kk := HEAP[ 1 : UPB kk * 2 ]STRING;
               FOR k TO UPB kk DO kk[ k ] := whole( LONG LONG INT( k ) ^ k, 0 ) OD;
               try again := TRUE
           FI
       OD;
       IF i MOD 10 = 9 THEN print( ( newline ) ) FI
   OD

END</lang>

Output:

   9   1   3   5   2   4   4   3   7   9
  10  11   5  19  22  26   8  17  16  19
   9   8  13   7  17   4  17   3  11  18
  13   5  23  17  18   7  17  15   9  18
  16  17   9   7  12  28   6  23   9  24
  23

Factor

Works with: Factor version 0.99 2021-02-05

<lang factor>USING: formatting grouping io kernel lists lists.lazy math.functions present sequences ;

smallest ( m -- n )

   present 1 lfrom [ dup ^ present subseq? ] with lfilter car ;

51 <iota> [ smallest ] map 10 group [ [ "%3d" printf ] each nl ] each</lang>

Output:

  9  1  3  5  2  4  4  3  7  9
 10 11  5 19 22 26  8 17 16 19
  9  8 13  7 17  4 17  3 11 18
 13  5 23 17 18  7 17 15  9 18
 16 17  9  7 12 28  6 23  9 24
 23

Julia

<lang julia>hasinktok(n) = for k in 1:100000 contains("$(BigInt(k)^k)", "$n") && return k end

foreach(p -> print(rpad(p[2], 4), p[1] % 17 == 0 ? "\n" : ""), enumerate(map(hasinktok, 0:50)))

</lang>

Output:

9   1   3   5   2   4   4   3   7   9   10  11  5   19  22  26  8   
17  16  19  9   8   13  7   17  4   17  3   11  18  13  5   23  17  
18  7   17  15  9   18  16  17  9   7   12  28  6   23  9   24  23

Pascal

Works with: Free Pascal

made like Phix but own multiplikation to BASE 1E9 here <lang pascal>program K_pow_K; //First occurence of a numberstring with max DIGTIS digits in k^k {$IFDEF FPC}

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

{$ELSE}

  {$APPTYPE CONSOLE}

{$ENDIF}

uses

 sysutils;

const

LongWordDec = 1000*1000*1000;
Digits = 6;

type

 tMulElem = Uint32;
 tMul = array of tMulElem;
 tpMul = pUint32;
 tFound =  Uint32;

var

 Pot_N_str : AnsiString;
 Str_Found : array of tFound;
 FirstMissing :NativeInt;
 T0 : INt64;

procedure Out_Results(number,found:NativeInt); var

 i : NativeInt;

Begin

 writeln;
 writeln(#10,'Found: ',found,' at ',number,' with ',length(Pot_N_str),
    ' digits in Time used ',(GetTickCount64-T0)/1000:8:3,' secs');
 writeln ;
 writeln('               0    1    2    3    4    5    6    7    8    9');
 write('          |__________________________________________________');
 For i := 0 to 99 do//decLimit-1 do
 begin
   if i MOD 10 = 0 then
   Begin
     writeln;
     write((i DIV 10)*10:10,'|');
   end;
   number := Str_Found[i]-1;
   if number > 0 then
       write(number:5);
 end;
 writeln;

end;

procedure Mul_12(var Mul1,Mul2:tMul); //Mul2 = Mul1*Mul2; var

 TmpMul : tMul;
 carry,
 n,prod: Uint64;
 lmt1,lmt2,i,j : NativeInt;

begin

 lmt1 := High(MUl1);
 lmt2 := High(Mul2);
 setlength(TmpMul,lmt1+lmt2+3);
 For i := 0 to lmt1 do
 Begin
   carry := 0;
   n := Mul1[i];
   For j := 0 to lmt2 do
   Begin
     prod := n*Mul2[j]+TmpMul[i+j]+carry;
     carry := prod DIV LongWordDec;
     TmpMul[i+j]:=prod-carry*LongWordDec;
   end;
   TmpMul[i+lmt2+1] += carry;
 end;
 Mul2 := TmpMul;
 setlength(TmpMul,0);
 i := High(Mul2);
 while (i>=1) AND (Mul2[i]=0) do
   dec(i);
 setlength(Mul2,i+1);

end;

procedure ConvToStr(var s:Ansistring;const Mul:tMul;i:NativeInt); var

 s9: string[9];
 pS : pChar;
 j,k : NativeInt;

begin // i := High(MUL);

 j := (i+1)*9;
 setlength(s,j+1);
 pS := pChar(s);
 // fill complete with '0'
 fillchar(pS[0],j,'0');
 str(Mul[i],S9);
 j := length(s9);
 move(s9[1],pS[0],j);
 k := j;
 dec(i);
 If i >= 0 then
   repeat
     str(Mul[i],S9);// no leading '0'
     j := length(s9);
     inc(k,9);
     //move to the right place, leading '0' is already there
     move(s9[1],pS[k-j],j);
     dec(i);
   until i<0;
 setlength(s,k);

end;

function CheckOneString(const s:Ansistring;pow:NativeInt):NativeInt; //check every possible number from one to DIGITS digits var

 i,k,lmt,num : NativeInt;

begin

 result := 0;

 lmt := length(s);
 For i := 1 to lmt do
 Begin
   k := i;
   num := 0;
   repeat
     num := num*10+ Ord(s[k])-Ord('0');
     IF (num >= FirstMissing) AND (str_Found[num] = 0) then
     begin
       str_Found[num]:= pow+1;
       // commatize only once. reference counted string
       inc(result);
       if num =FirstMissing then
       Begin
         while str_Found[FirstMissing] <> 0 do
           inc(FirstMissing);
       end;
     end;
     inc(k)
   until (k>lmt) or (k-i >DIGITS-1);
 end;

end;

var

 MulErg,Square :tMUl;
 number,i,j,found,decLimit: Int32;

Begin

 T0 := GetTickCount64;
 decLimit := 1;
 For i := 1 to digits do
   decLimit *= 10;
 setlength(Str_Found,decLimit);

 found := 0;
 FirstMissing := 0;
 number := 1;
 repeat
   setlength(MulErg,1);
   MulErg[0] := 1;
   setlength(Square,1);
   Square[0]:= number;

   If number AND 1 <> 0 then
     MulErg[0] := number;
   j := 2;
   while j <= number do
   Begin
     Mul_12(Square,Square);
     If number AND J <> 0 then
       Mul_12(Square,MulErg);
     j:= j*2;
   end;
   ConvToStr(Pot_N_str,MulErg,High(MulErg));
   inc(found,CheckOneString(Pot_N_str,number));
   inc(number);
   if number AND 511 = 0 then
     write(#13,number:7,' with ',length(Pot_N_str), ' digits.Found ',found);
 until found >=decLimit;
 Out_Results(number,found);

end. </lang>

Output:

TIO.RUN for 6 Digits

    512 with 1385 digits.Found 334811
   1024 with 3080 digits.Found 777542
   1536 with 4891 digits.Found 968756
   2048 with 6778 digits.Found 998285
   2560 with 8722 digits.Found 999959
   3072 with 10710 digits.Found 999999

Found: 1000000 at 3173 with 11107 digits in Time used    2.719 secs

               0    1    2    3    4    5    6    7    8    9
          |__________________________________________________
         0|    9    1    3    5    2    4    4    3    7    9
        10|   10   11    5   19   22   26    8   17   16   19
        20|    9    8   13    7   17    4   17    3   11   18
        30|   13    5   23   17   18    7   17   15    9   18
        40|   16   17    9    7   12   28    6   23    9   24
        50|   23   13   18   11    7   14    4   18   14   13
        60|   19   11   25   17   17    6    6    8   14   27
        70|   11   26    8   16    9   13   17    8   15   19
        80|   14   21    7   21   16   11   17    9   17    9
        90|   15   12   13   15   27   16   18   19   21   23

Found: 1000000 at 3173 with 11107 digits in Time used    2.785 secs

...  at home for 7 Digits
only calc k^k for 1..9604
Found: 0 at 9604 with 0 digits in Time used   45.700 secs
with ConvToStr
Found: 0 at 9604 with 38244 digits in Time used   46.406 secs
with ConvToStr and CheckOneString
Found: 10000000 at 9604 with 38244 digits in Time used   52.222 secs
   9216 with 36533 digits.Found 9999997

gmp-version

<lang pascal>program K_pow_K_gmp; //First occurence of a numberstring with max DIGTIS digits in k^k {$IFDEF FPC}

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

{$ELSE}

  {$APPTYPE CONSOLE}

{$ENDIF}

uses

 sysutils,gmp;

const

LongWordDec = 1000*1000*1000;

Digits = 7;

var

 Pot_N_str : AnsiString;
 Str_Found : array of Uint32;
 FirstMissing :NativeInt;
 T0 : INt64;

procedure Out_Results(number,found:NativeInt); var

 i : NativeInt;

Begin

 writeln;
 writeln(#10,'Found: ',found,' at ',number,' with ',length(pChar(Pot_N_str)),
    ' digits in Time used ',(GetTickCount64-T0)/1000:8:3,' secs');
 writeln ;
 writeln('               0    1    2    3    4    5    6    7    8    9');
 write('          |__________________________________________________');
 For i := 0 to 99 do//decLimit-1 do
 begin
   if i MOD 10 = 0 then
   Begin
     writeln;
     write((i DIV 10)*10:10,'|');
   end;
   number := Str_Found[i]-1;
   if number > 0 then
       write(number:5);
 end;
 writeln;

end;

function CheckOneString(const s:Ansistring;lmt,pow:NativeInt):NativeInt; //check every possible number from one to DIGITS digits var

 i,k,num : NativeInt;

begin

 result := 0;

 For i := 1 to lmt do
 Begin
   k := i;
   num := 0;
   repeat
     num := num*10+ Ord(s[k])-Ord('0');
     IF (num >= FirstMissing) AND (str_Found[num] = 0) then
     begin
       str_Found[num]:= pow+1;
       inc(result);
       if num =FirstMissing then
       Begin
         while str_Found[FirstMissing] <> 0 do
           inc(FirstMissing);
       end;
     end;
     inc(k)
   until (k>lmt) or (k-i >DIGITS-1);
 end;

end;

var

 zkk: mpz_t;
 number,i,found,lenS,decLimit: Int32;

Begin

 T0 := GetTickCount64;
 mpz_init(zkk);

 decLimit := 1;
 For i := 1 to digits do
   decLimit *= 10;
 setlength(Str_Found,decLimit);

 //calc digits for max number := 10000
 number:= 10000;
 i := trunc(number*ln(number)/ln(10))+5;
 setlength(Pot_N_str,i);

 found := 0;
 FirstMissing := 0;
 number := 1;
 lenS :=1;
 repeat
   mpz_ui_pow_ui(zkk,number,number);
   mpz_get_str(pChar(Pot_N_str),10,zkk);
   while Pot_N_str[lenS] <> #0 do inc(lenS);

// lenS := length(pChar(Pot_N_str));

   inc(found,CheckOneString(Pot_N_str,lenS,number));
   inc(number);
   if number AND 511 = 0 then
     write(#13,number:7,' with ',lenS, ' digits.Found ',found);
 until number>9604;// found >=decLimit;
 Out_Results(number,found);

end.</lang>

Output:

TIO.RUN for 7 digits  same as above
    512 with 1386 digits.Found 608645
   1024 with 3081 digits.Found 1952296
...
Found: 10000000 at 9604 with 38244 digits in Time used   13.538 secs
//only mpz_ui_pow_ui(zkk,number,number); takes <0.5s up to 9604 with string conversion 3.3s

Perl

<lang perl>use strict; use warnings; use feature 'say'; use List::Util 'first'; use Math::AnyNum 'ipow';

sub smallest { first { ipow($_,$_) =~ /$_[0]/ } 1..1e4 } say join ' ', map { smallest($_) } 0..50;</lang>

Output:

9 1 3 5 2 4 4 3 7 9 10 11 5 19 22 26 8 17 16 19 9 8 13 7 17 4 17 3 11 18 13 5 23 17 18 7 17 15 9 18 16 17 9 7 12 28 6 23 9 24 23

Phix

Native numbers won't cope (14^14 exceeds a 64-bit float, 17^17 an 80-bit one), so instead of gmp I've gone with string math again. (Related recent tasks: here and here)

constant lim = 51       -- (tested to 1,000,000)
atom t0 = time(), t1 = t0+1
sequence res = repeat(0,lim)
integer found = 0, k = 1
while found<lim do
    string kk = "1"
    for i=1 to k do
        integer carry = 0
        for j=length(kk) to 1 by -1 do
            integer digit = (kk[j]-'0')*k+carry
            kk[j] = remainder(digit,10)+'0'
            carry = floor(digit/10)
        end for
        while carry do
            kk = remainder(carry,10)+'0' & kk
            carry = floor(carry/10)
        end while
    end for
    for i=1 to length(kk) do
        integer digit = 0, j = i
        while j<=length(kk) and digit<=lim do
            digit = digit*10+kk[j]-'0'
            if digit<lim and res[digit+1]=0 then
                res[digit+1] = sprintf("%2d",k)
                found += 1
            end if
            j += 1
        end while
    end for
    if platform()!=JS and time()>t1 then
        progress("found %,d/%,d, at %d^%d which has %,d digits (%s)",
                 {found,lim,k,k,length(kk),elapsed(time()-t0)})
        t1 = time()+1
    end if
    k += 1
end while
puts(1,join_by(shorten(res,"",30),1,10))

Output:

 9    1    3    5    2    4    4    3    7    9
10   11    5   19   22   26    8   17   16   19
 9    8   13    7   17    4   17    3   11   18
13    5   23   17   18    7   17   15    9   18
16   17    9    7   12   28    6   23    9   24
23

Testing to 1,000,000 took 12mins 35s.

gmp version

constant lim = 51       -- (tested to 1,000,000)
include mpfr.e
mpz zkk = mpz_init()
atom t0 = time(), t1 = t0+1
sequence res = repeat(0,lim)
integer found = 0, k = 1
while found<lim do
    mpz_ui_pow_ui(zkk,k,k)
    string kk = mpz_get_str(zkk)
    for i=1 to length(kk) do
        integer digit = 0, j = i
        while j<=length(kk) and digit<=lim do
            digit = digit*10+kk[j]-'0'
            if digit<lim and res[digit+1]=0 then
                res[digit+1] = sprintf("%2d",k)
                found += 1
            end if
            j += 1
        end while
    end for
    if platform()!=JS and time()>t1 then
        progress("found %,d/%,d, at %d^%d which has %,d digits (%s)",
                 {found,lim,k,k,length(kk),elapsed(time()-t0)})
        t1 = time()+1
    end if
    k += 1
end while
puts(1,join_by(shorten(res,"",30),1,10))

Same results, but nearly 30 times faster, finishing the 1,000,000 test in just 26.6s

Raku

<lang perl6>sub smallest ( $n ) {

   state  @powers = , |map { $_ ** $_ }, 1 .. *;

   return @powers.first: :k, *.contains($n);

}

.say for (^51).map(&smallest).batch(10)».fmt('%2d');</lang>

Output:

( 9  1  3  5  2  4  4  3  7  9)
(10 11  5 19 22 26  8 17 16 19)
( 9  8 13  7 17  4 17  3 11 18)
(13  5 23 17 18  7 17 15  9 18)
(16 17  9  7 12 28  6 23  9 24)
(23)

REXX

<lang rexx>/*REXX pgm finds the smallest positive integer K where K**K contains N, N < 51 */ numeric digits 200 /*ensure enough decimal digs for k**k */ parse arg hi cols . /*obtain optional argument from the CL.*/ if hi== | hi=="," then hi= 51 /*Not specified? Then use the default.*/ if cols== | cols=="," then cols= 10 /* " " " " " " */ w= 6 /*width of a number in any column. */ @spiKK=' smallest positive integer K where K**K contains N, 0 ≤ N < ' commas(hi) say ' N │'center(@spiKK, 5 + cols*(w+1) ) /*display the title of the output. */ say '─────┼'center("" , 5 + cols*(w+1), '─') /* " " separator " " " */ $=; idx= 0 /*define $ output list; index to 0.*/

    do j=0  for hi;            n= j + 1         /*look for a power of 6 that contains N*/
                   do k=1  until pos(j, k**k)>0 /*calculate a bunch of powers  (K**K). */
                   end   /*k*/
    c= commas(k)                                /*maybe add commas to the powe of six. */
    $= $ right(c, max(w, length(c) ) )          /*add a  K (power) ──► list, allow big#*/
    if n//cols\==0  then iterate                /*have we populated a line of output?  */
    say center(idx, 5)'│'substr($, 2);     $=   /*display what we have so far  (cols). */
    idx= idx + cols                             /*bump the  index  count for the output*/
    end   /*j*/

if $\== then say center(idx, 5)"│"substr($,2) /*possible display any residual output.*/ say '─────┴'center("" , 5 + cols*(w+1), '─') /* " " separator " " " */ exit 0 /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ commas: parse arg ?; do jc=length(?)-3 to 1 by -3; ?=insert(',', ?, jc); end; return ?</lang>

output   when using the default inputs:

  N  │  smallest positive integer  K  where  K**K  contains  N,   0  ≤  N  <  51
─────┼───────────────────────────────────────────────────────────────────────────
  0  │     9      1      3      5      2      4      4      3      7      9
 10  │    10     11      5     19     22     26      8     17     16     19
 20  │     9      8     13      7     17      4     17      3     11     18
 30  │    13      5     23     17     18      7     17     15      9     18
 40  │    16     17      9      7     12     28      6     23      9     24
 50  │    23
─────┴───────────────────────────────────────────────────────────────────────────

Ring

<lang ring> load "bignumber.ring"

decimals(0) see "working..." + nl see "Smallest number k > 0 such that the decimal expansion of k^k contains n are:" + nl

row = 0 limit1 = 50 limit2 = 30

for n = 0 to limit1

   strn = string(n)
   for m = 1 to limit2
       powm = pow(m,m)
       ind = substr(powm,strn)
       if ind > 0
          exit
       ok
   next
   row = row + 1
   see "" + m + " "
   if row%10 = 0
      see nl
   ok

next

see nl + "done..." + nl

func pow(num1,num2)

    num1 = string(num1)
    num2 = string(num2)
    return FuncPower(num1,num2)

</lang>

Output:

working...
Smallest number k > 0 such that the decimal expansion of k^k contains n are:
9 1 3 5 2 4 4 3 7 9 
10 11 5 19 22 26 8 17 16 19 
9 8 13 7 17 4 17 3 11 18 
13 5 23 17 18 7 17 15 9 18 
16 17 9 7 12 28 6 23 9 24 
23 
done...

Wren

Library: Wren-big

Library: Wren-seq

Library: Wren-fmt

<lang ecmascript>import "/big" for BigInt import "/seq" for Lst import "/fmt" for Fmt

var res = [] for (n in 0..50) {

   var k = 1
   while (true) {
       var s = BigInt.new(k).pow(k).toString
       if (s.contains(n.toString)) {
           res.add(k)
           break
       }
       k = k + 1
   }

} System.print("The smallest positive integers K where K ^ K contains N (0..50) are:") for (chunk in Lst.chunks(res, 17)) Fmt.print("$2d", chunk)</lang>

Output:

The smallest positive integers K where K ^ K contains N (0..50) are:
 9  1  3  5  2  4  4  3  7  9 10 11  5 19 22 26  8
17 16 19  9  8 13  7 17  4 17  3 11 18 13  5 23 17
18  7 17 15  9 18 16 17  9  7 12 28  6 23  9 24 23