Smallest numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|Phix}}: added 14^14 and 17^17 note)
(Add Factor)
Line 4: Line 4:
Smallest number k > 0 such that the decimal expansion of k^k contains n, where '''n < 51'''
Smallest number k > 0 such that the decimal expansion of k^k contains n, where '''n < 51'''
<br><br>
<br><br>

=={{header|Factor}}==
{{works with|Factor|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>
{{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 28 6 23 9 24
23
</pre>

=={{header|Phix}}==
=={{header|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.
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.

Revision as of 08:38, 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

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

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