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 positive integer   k   such that the decimal expansion of   k^k   contains   n,   where   n  <  51

11l

Translation of: Python

V numLimit = 51

[Int = Int] resultSet

V base = 1

L resultSet.len != numLimit
   V result = String(BigInt(base) ^ base)

   L(i) 0 .< numLimit
      I String(i) C result & i !C resultSet
         resultSet[i] = base

   base++

L(i) sorted(resultSet.keys())
   print(resultSet[i], end' ‘ ’)

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 

ALGOL 68

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

Uses ALGOL 68G's LONG LONG INT which provides large integers (the default precision is sufficient for the task). Also uses the ALGOL 68G string in string procedure.

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

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

F#

// Smallest number: Nigel Galloway. April 13th., 2021
let rec fG n g=match bigint.DivRem(n,if g<10 then 10I else 100I) with (_,n) when (int n)=g->true |(n,_) when n=0I->false |(n,_)->fG n g 
{0..50}|>Seq.iter(fun g->printf "%d " (1+({1..0x0FFFFFFF}|>Seq.map(fun n->(bigint n)**n)|>Seq.findIndex(fun n->fG n g)))); printfn ""

Output:

9 1 3 5 2 4 4 3 7 9 26 11 14 21 22 26 8 25 16 19 23 21 13 25 17 5 25 3 11 18 27 5 23 24 22 7 17 16 21 19 18 17 9 7 12 28 18 23 27 24 23
Real: 00:00:00.005

Factor

Works with: Factor version 0.99 2021-02-05

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

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

FreeBASIC

Reuses some code from Arbitrary-precision_integers_(included)#FreeBASIC.

#Include once "gmp.bi"
Dim Shared As Zstring * 100000000 outtext
 
Function  Power(number As String,n As Uinteger) As String'automate precision
    #define dp 3321921
    Dim As __mpf_struct _number,FloatAnswer
    Dim As Ulongint ln=Len(number)*(n)*4
    If ln>dp Then ln=dp
    mpf_init2(@FloatAnswer,ln)
    mpf_init2(@_number,ln)
    mpf_set_str(@_number,number,10)
    mpf_pow_ui(@Floatanswer,@_number,n)
    gmp_sprintf( @outtext,"%." & Str(n) & "Ff",@FloatAnswer )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt)
End Function

function is_substring( s as string, j as string ) as boolean
    dim as integer nj = len(j), ns = len(s)
    for i as integer = 1 to ns - nj + 1
        if mid(s,i,nj) = j then return true
    next i
    return false
end function

dim as integer k

for i as uinteger = 0 to 50
    k = 0
    do
        k = k + 1
    loop until is_substring( Power(str(k), k), str(i) )
    print k;" ";
next i

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

Go

Translation of: Wren

package main

import (
    "fmt"
    "math/big"
    "strconv"
    "strings"
)

func main() {
    var res []int64
    for n := 0; n <= 50; n++ {
        ns := strconv.Itoa(n)
        k := int64(1)
        for {
            bk := big.NewInt(k)
            s := bk.Exp(bk, bk, nil).String()
            if strings.Contains(s, ns) {
                res = append(res, k)
                break
            }
            k++
        }
    }
    fmt.Println("The smallest positive integers K where K ^ K contains N (0..50) are:")
    for i, n := range res {
        fmt.Printf("%2d ", n)
        if (i+1)%17 == 0 {
            fmt.Println()
        }
    }
}

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 

J

N,K:

   (,.1>.{.@I.@(+./@E.&":"0/ ^~))i.51x
 0  9
 1  1
 2  3
 3  5
 4  2
 5  4
 6  4
 7  3
 8  7
 9  9
10 10
11 11
12  5
13 19
14 22
15 26
16  8
17 17
18 16
19 19
20  9
21  8
22 13
23  7
24 17
25  4
26 17
27  3
28 11
29 18
30 13
31  5
32 23
33 17
34 18
35  7
36 17
37 15
38  9
39 18
40 16
41 17
42  9
43  7
44 12
45 28
46  6
47 23
48  9
49 24
50 23

jq

Works with gojq, the Go implementation of jq

The integer precision of stedolan jq is insufficient for this task.

# if the input and $b are integers, then gojq will preserve precision
def power($b): . as $a | reduce range(0; $b) as $i (1; . * $a);

def smallest_k:
  tostring as $n
  | first( range(1; infinite) | select( power(.) | tostring | contains($n))) ;

# Formatting

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

def nwise($n):
  def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end;
  n;

The task:

def task($n):
  [range(0; $n) | smallest_k | lpad(3) ]
  | nwise(10)
  | join(" ");

task(51)

Output:

As for Factor, for example.

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)))

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

Mathematica/Wolfram Language

ClearAll[FindSmallestk]
FindSmallestk[n_Integer] := Module[{digs, id, out},
  id = IntegerDigits[n];
  Do[
   digs = IntegerDigits[k^k];
   If[Length[SequenceCases[digs, id, 1]] > 0, out = k; Break[]]
   ,
   {k, 1, \[Infinity]}
   ];
  out
  ]
Multicolumn[FindSmallestk /@ Range[0, 50], Appearance -> "Horizontal"]

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					

Nim

Library: bignum

import strformat, strutils
import bignum

var k = 1u
var toFind = {0..50}
var results: array[0..50, uint]
while toFind.card > 0:
  let str = $(pow(newInt(k), k))
  for n in toFind:
    if str.find($n) >= 0:
      results[n] = k
      toFind.excl(n)
  inc k

echo "Smallest values of k such that k^k contains n:"
for n, k in results:
  stdout.write &"{n:2} → {k:<2}   ", if (n + 1) mod 9 == 0: '\n' else: ' '
echo()

Output:

Smallest values of k such that k^k contains n:
 0 → 9      1 → 1      2 → 3      3 → 5      4 → 2      5 → 4      6 → 4      7 → 3      8 → 7    
 9 → 9     10 → 10    11 → 11    12 → 5     13 → 19    14 → 22    15 → 26    16 → 8     17 → 17   
18 → 16    19 → 19    20 → 9     21 → 8     22 → 13    23 → 7     24 → 17    25 → 4     26 → 17   
27 → 3     28 → 11    29 → 18    30 → 13    31 → 5     32 → 23    33 → 17    34 → 18    35 → 7    
36 → 17    37 → 15    38 → 9     39 → 18    40 → 16    41 → 17    42 → 9     43 → 7     44 → 12   
45 → 28    46 → 6     47 → 23    48 → 9     49 → 24    50 → 23   

Pascal

Works with: Free Pascal

made like Phix but own multiplikation to BASE 1E9 here

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.

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

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

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.

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

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;

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)

with javascript_semantics
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

with javascript_semantics
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

Python

Interactive script which takes the upper bound as input :

#Aamrun, 4th October 2021

import sys

if len(sys.argv)!=2:
    print("Usage : python " + sys.argv[0] + " <whole number>")
    exit()

numLimit = int(sys.argv[1])

resultSet = {}

base = 1

while len(resultSet)!=numLimit:
    result = base**base

    for i in range(0,numLimit):
        if str(i) in str(result) and i not in resultSet:
            resultSet[i] = base

    base+=1

[print(resultSet[i], end=' ') for i in sorted(resultSet)]

Output:

C:\My Projects\BGI>python rosetta9.py 51
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

Quackery

  [ stack ]                    is candidates (   --> s )
  [ stack ]                    is results    (   --> s )

  [ [] swap times
     [ i^ number$
       nested join ]
    candidates put
    [] results put
    0
    [ 1+ dup
      dup ** number$
      candidates share
      reverse witheach
        [ over 2dup findseq
          swap found iff
            [ dip over
              $->n drop
              join nested
              results take
              join
              results put
              candidates take
              i pluck drop
              candidates put ]
          else drop ]
      drop
      candidates share
      [] = until ]
    drop
    candidates release
    results take
    sortwith
      [ 1 peek swap 1 peek < ]
    [] swap
    witheach [ 0 peek join ] ] is task       ( n --> [ )

  51 task echo

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 ]

Raku

sub smallest ( $n ) {
    state  @powers = '', |map { $_ ** $_ }, 1 .. *;

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

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

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

Code was added to display the count of unique numbers found.

/*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.     */
title=' smallest positive integer  K  where  K**K  contains  N,   0  ≤  N  < '  commas(hi)
say '  N  │'center(title, 5 + cols*(w+1)     )   /*display the   title   of the output. */
say '─────┼'center(""   , 5 + cols*(w+1), '─')   /*   "     "  separator  "  "     "    */
u= 0;                                    !.= .   /*number of unique #'s found; semaphore*/
$=;                                      idx= 0  /*define  $  output list;  index to  0.*/
     do j=0  for hi                              /*look for a power of K that contains N*/
                    do k=1  until pos(j, k**k)>0 /*calculate a bunch of powers  (K**K). */
                    end   /*k*/
     if !.k==.  then do; u= u+1;  !.k=;  end     /*Is unique?  Then bump unique counter.*/
     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 (j+1)//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  "  "     "    */
say
say commas(u)  ' unique numbers found.'
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 ?

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
─────┴───────────────────────────────────────────────────────────────────────────

23  unique numbers found.

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)

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

RPL

Works with: HP version 49

« { } 
   0 50 FOR n 
      1
      WHILE DUP DUP ^ →STR n →STR POS NOT 
      REPEAT 1 + END 
      +
   NEXT
» 'TASK' STO

Output:

1: {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}

Ruby

Using a hash as memo:

memo = Hash.new{|h, k| h[k] = (k**k).to_s }
res = (0..50).map{|n| (1..).detect{|m| memo[m].include? n.to_s} }
res.each_slice(10){|slice| puts "%4d"*slice.size % slice }

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

Sidef

0..50 -> map {|n| 1..Inf -> first {|k| Str(k**k).contains(n) } }.say

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]

Wren

Library: Wren-big

Library: Wren-fmt

import "./big" for BigInt
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:")
Fmt.tprint("$2d", res, 17)

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