Smallest numbers: Difference between revisions
m (→{{header|Julia}}: string version) |
|||
Line 66: | Line 66: | ||
=={{header|Julia}}== |
=={{header|Julia}}== |
||
<lang julia> |
<lang julia>hasinktok(n) = for k in 1:100000 contains("$(BigInt(k)^k)", "$n") && return k end |
||
nlen = ndigits(n) |
|||
for k in 1:limit |
|||
d = digits(BigInt(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))) |
foreach(p -> print(rpad(p[2], 4), p[1] % 17 == 0 ? "\n" : ""), enumerate(map(hasinktok, 0:50))) |
||
Line 84: | Line 75: | ||
18 7 17 15 9 18 16 17 9 7 12 28 6 23 9 24 23 |
18 7 17 15 9 18 16 17 9 7 12 28 6 23 9 24 23 |
||
</pre> |
</pre> |
||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
{{works with|Free Pascal}} |
{{works with|Free Pascal}} |
Revision as of 05:21, 13 April 2021
- Task
Smallest number k > 0 such that the decimal expansion of k^k contains n, where n < 51
ALGOL 68
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
<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
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 6^n {$IFDEF FPC}
{$MODE DELPHI} {$Optimization ON,ALL}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils;
const
LongWordDec = 1000*1000*1000;
POT_LIMIT = 10; Digits = 7;
type
tMulElem = Uint32; tMul = array of tMulElem; tpMul = pUint32; tPotArrN = array[0..1] of tMul;
tFound = Uint32;
var
PotArrN : tPotArrN; Pot_N_str : AnsiString; Str_Found : array of tFound; FirstMissing :NativeInt; T0 : INt64;
procedure Init_Mul(number:NativeInt); var
MaxMulIdx : NativeInt;
Begin
MaxMulIdx := trunc(POT_LIMIT*ln(POT_LIMIT)/ln(10)/9+2); setlength(PotArrN[0],MaxMulIdx); setlength(PotArrN[1],MaxMulIdx); PotArrN[0,0] := 1; writeln(MaxMulIdx);
end;
procedure SquareMul(var Mul1,Mul2:tMul); //Mul2 = MUl1*Mul1 var
prod,carry: Uint64; i,j,lmt,n : NativeInt;
Begin
lmt := length(Mul1); setlength(Mul2,2*lmt+1); FillDword(Mul2[0],2*lmt+1,0); lmt -= 1; For i := 0 to lmt do Begin carry := 0; n := Mul1[i]; For j := 0 to Lmt do Begin prod := n*Mul1[j]+Mul2[i+j]+carry; carry := prod DIV LongWordDec; Mul2[i+j]:=prod-carry*LongWordDec; end;
// If carry<>0 then
Mul2[i+lmt+1] := carry; end; i := High(Mul2); while (i>=1) AND (Mul2[i]=0) do dec(i); setlength(Mul2,i+1);
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;
function Commatize(const s: AnsiString):AnsiString; var
fromIdx,toIdx :Int32;
Begin
result := ; fromIdx := length(s); toIdx := fromIdx-1; if toIdx < 3 then Begin result := s; exit; end; toIdx := 4*(toIdx DIV 3)+toIdx MOD 3; inc(toIdx); setlength(result,toIdx); repeat result[toIdx] := s[FromIdx]; result[toIdx-1] := s[FromIdx-1]; result[toIdx-2] := s[FromIdx-2]; result[toIdx-3] := ','; dec(toIdx,4); dec(FromIdx,3); until FromIdx<=3; while fromIdx>=1 do Begin result[toIdx] := s[FromIdx]; dec(toIdx); dec(fromIdx); end;
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 :tMUl; i,j,number,toggle,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(PotArrN[0],1); setlength(PotArrN[1],1); PotArrN[0,0]:= number; PotArrN[1,0]:= 1; toggle := 0;
If number AND 1 <> 0 then MulErg:= PotArrN[toggle]; j := 2; while j <= number do Begin SquareMul(PotArrN[toggle],PotArrN[1-toggle]); toggle := 1-toggle; If number AND J <> 0 then Mul_12(PotArrN[toggle],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;
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(0:10); j := 1; For i := 0 to 99 do//decLimit-1 do begin number := Str_Found[i]-1; if number > 0 then write(number:5); if (i+1) MOD 10 = 0 then Begin writeln; write(((i+1) DIV 10)*10:10); end; end; writeln;
end.</lang>
- Output:
TIO.RUN 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.785 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 100 ... at home 9216 with 36533 digits.Found 9999997 Found: 10000000 at 9604 with 38244 digits in Time used 52.662 secs
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
<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