Smallest numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Algol 68)
Line 63: Line 63:
16 17 9 7 12 28 6 23 9 24
16 17 9 7 12 28 6 23 9 24
23
23
</pre>

=={{header|Julia}}==
<lang julia>function hasinktok(n, limit=1000)
nlen = ndigits(n)
for k in 1:limit
d = digits(Int128(k)^k)
for j in 1:length(d)-nlen+1
evalpoly(10, d[j:j+nlen-1]) == n && return k
end
end
error("Could not find a valid k where k <= $limit and k^k contains $n")
end

foreach(p -> print(rpad(p[2], 4), p[1] % 17 == 0 ? "\n" : ""), enumerate(map(hasinktok, 0:50)))
</lang>{{out}}
<pre>
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 35 6 23 9 24 23
</pre>
</pre>



Revision as of 18:36, 11 April 2021

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>function hasinktok(n, limit=1000)

   nlen = ndigits(n)
   for k in 1:limit
       d = digits(Int128(k)^k)
       for j in 1:length(d)-nlen+1
           evalpoly(10, d[j:j+nlen-1]) == n && return k
       end
   end
   error("Could not find a valid k where k <= $limit and k^k contains $n")

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

This example is incomplete.

The output doesn't show the 50th number,

it stops at the 49th number.

Please ensure that it meets all task requirements and remove this message.
This example is incorrect. Please fix the code and remove this message.

Details:

Also, results for 14,15,17,32,39,41,45 and 49 are wrong.

<lang ring> load "stdlib.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 = 49 limit2 = 30

for n = 0 to limit1

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

next

see "done..." + nl </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 21 18 8 25 16 19 
9 8 13 7 17 4 17 3 11 18 
13 5 19 17 18 7 17 15 9 15 
16 18 9 7 12 25 6 23 9 23 
done...