First perfect square in base n with n unique digits
Find the first perfect square in a given base N that has at least N digits and exactly N significant unique digits when expressed in base N.
E.G. In base 10, the first perfect square with at least 10 unique digits is 1026753849 (32043²).
You may use analytical methods to reduce the search space, but the code must do a search. Do not use magic numbers or just feed the code the answer to verify it is correct.
- Task
- Find and display here, on this page, the first perfect square in base N, with N significant unique digits when expressed in base N, for each of base 2 through 12. Display each number in the base N for which it was calculated.
- (optional) Do the same for bases 13 through 16.
- (stretch goal) Continue on for bases 17 - ?? (Big Integer math)
- related task
F#
The Task
<lang fsharp> // Nigel Galloway: May 21st., 2019 let fN g=let g=int64(sqrt(float(pown g (int(g-1L)))))+1L in (Seq.unfold(fun(n,g)->Some(n,(n+g,g+2L))))(g*g,g*2L+1L) let fG n g=Array.unfold(fun n->if n=0L then None else let n,g=System.Math.DivRem(n,g) in Some(g,n)) n let fL g=let n=set[0L..g-1L] in Seq.find(fun x->set(fG x g)=n) (fN g) let toS n g=let a=Array.concat [[|'0'..'9'|];[|'a'..'f'|]] in System.String(Array.rev(fG n g)|>Array.map(fun n->a.[(int n)])) [2L..16L]|>List.iter(fun n->let g=fL n in printfn "Base %d: %s² -> %s" n (toS (int64(sqrt(float g))) n) (toS g n)) </lang>
- Output:
Base 2: 10² -> 100 Base 3: 22² -> 2101 Base 4: 33² -> 3201 Base 5: 243² -> 132304 Base 6: 523² -> 452013 Base 7: 1431² -> 2450361 Base 8: 3344² -> 13675420 Base 9: 11642² -> 136802574 Base 10: 32043² -> 1026753849 Base 11: 111453² -> 1240a536789 Base 12: 3966b9² -> 124a7b538609 Base 13: 3828943² -> 10254773ca86b9 Base 14: 3a9db7c² -> 10269b8c57d3a4 Base 15: 1012b857² -> 102597bace836d4 Base 16: 404a9d9b² -> 1025648cfea37bd9
Using Factorial base numbers indexing permutations of a collection
On the discussion page for Factorial base numbers indexing permutations of a collection an anonymous contributor queries the value of Factorial base numbers indexing permutations of a collection. Well let's see him use an inverse Knuth shuffle to partially solve this task. This solution only applies to bases that do not require an extra digit. Still I think it's short and interesting.
Note that the minimal candidate is 1.0....0 as a factorial base number.
<lang fsharp>
// Nigel Galloway: May 30th., 2019
let fN n g=let g=n|>Array.rev|>Array.mapi(fun i n->(int64 n)*(pown g i))|>Array.sum
let n=int64(sqrt (float g)) in g=(n*n)
let fG g=lN([|yield 1; yield! Array.zeroCreate(g-2)|])|>Seq.map(fun n->lN2p n [|0..(g-1)|]) |> Seq.filter(fun n->fN n (int64 g)) printfn "%A" (fG 12|>Seq.head) // -> [|1; 2; 4; 10; 7; 11; 5; 3; 8; 6; 0; 9|] printfn "%A" (fG 14|>Seq.head) // -> [|1; 0; 2; 6; 9; 11; 8; 12; 5; 7; 13; 3; 10; 4|] </lang>
Go
This takes advantage of major optimizations described by Nigel Galloway and Thundergnat (inspired by initial pattern analysis by Hout) in the Discussion page and a minor optimization contributed by myself. <lang go>package main
import (
"fmt" "math/big" "strconv" "time"
)
const maxBase = 27 const minSq36 = "1023456789abcdefghijklmnopqrstuvwxyz" const minSq36x = "10123456789abcdefghijklmnopqrstuvwxyz"
var bigZero = new(big.Int) var bigOne = new(big.Int).SetUint64(1)
func containsAll(sq string, base int) bool {
var found [maxBase]bool for _, r := range sq { if r < 58 { found[r-48] = true } else { found[r-87] = true } } for i := 0; i < base; i++ { if !found[i] { return false } } return true
}
func sumDigits(n, base *big.Int) *big.Int {
q := new(big.Int).Set(n) r := new(big.Int) sum := new(big.Int).Set(bigZero) for q.Cmp(bigZero) == 1 { q.QuoRem(q, base, r) sum.Add(sum, r) } return sum
}
func digitalRoot(n *big.Int, base int) int {
root := new(big.Int) b := big.NewInt(int64(base)) for i := new(big.Int).Set(n); i.Cmp(b) >= 0; i.Set(root) { root.Set(sumDigits(i, b)) } return int(root.Int64())
}
func minStart(base int) (string, uint64, int) {
nn := new(big.Int) ms := minSq36[:base] nn.SetString(ms, base) bdr := digitalRoot(nn, base) var drs []int var ixs []uint64 for n := uint64(1); n < uint64(2*base); n++ { nn.SetUint64(n * n) dr := digitalRoot(nn, base) if dr == 0 { dr = int(n * n) } if dr == bdr { ixs = append(ixs, n) } if n < uint64(base) && dr >= bdr { drs = append(drs, dr) } } inc := uint64(1) if len(ixs) >= 2 && base != 3 { inc = ixs[1] - ixs[0] } if len(drs) == 0 { return ms, inc, bdr } min := drs[0] for _, dr := range drs[1:] { if dr < min { min = dr } } rd := min - bdr if rd == 0 { return ms, inc, bdr } if rd == 1 { return minSq36x[:base+1], 1, bdr } ins := string(minSq36[rd]) return (minSq36[:rd] + ins + minSq36[rd:])[:base+1], inc, bdr
}
func main() {
start := time.Now() var nb, nn big.Int for n, k, base := uint64(2), uint64(1), 2; ; n += k { if base > 2 && n%uint64(base) == 0 { continue } nb.SetUint64(n) sq := nb.Mul(&nb, &nb).Text(base) if !containsAll(sq, base) { continue } ns := strconv.FormatUint(n, base) tt := time.Since(start).Seconds() fmt.Printf("Base %2d:%15s² = %-27s in %8.3fs\n", base, ns, sq, tt) if base == maxBase { break } base++ ms, inc, bdr := minStart(base) k = inc nn.SetString(ms, base) nb.Sqrt(&nn) if nb.Uint64() < n+1 { nb.SetUint64(n + 1) } if k != 1 { for { nn.Mul(&nb, &nb) dr := digitalRoot(&nn, base) if dr == bdr { n = nb.Uint64() - k break } nb.Add(&nb, bigOne) } } else { n = nb.Uint64() - k } }
}</lang>
- Output:
Timings (in seconds) are for my Celeron @ 1.6GHz and should therefore be much faster on a more modern machine.
Base 2: 10² = 100 in 0.000s Base 3: 22² = 2101 in 0.000s Base 4: 33² = 3201 in 0.000s Base 5: 243² = 132304 in 0.000s Base 6: 523² = 452013 in 0.000s Base 7: 1431² = 2450361 in 0.001s Base 8: 3344² = 13675420 in 0.001s Base 9: 11642² = 136802574 in 0.001s Base 10: 32043² = 1026753849 in 0.001s Base 11: 111453² = 1240a536789 in 0.003s Base 12: 3966b9² = 124a7b538609 in 0.011s Base 13: 3828943² = 10254773ca86b9 in 0.025s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.026s Base 15: 1012b857² = 102597bace836d4 in 0.032s Base 16: 404a9d9b² = 1025648cfea37bd9 in 0.045s Base 17: 423f82ga9² = 101246a89cgfb357ed in 0.339s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 0.395s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 0.535s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 17.610s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 18.595s Base 22: 4f94788gj0f² = 102369fbgdej48chi7lka5 in 62.002s Base 23: 1011d3el56mc² = 10234acedkg9hm8fbjil756 in 91.127s Base 24: 4lj0hdgf0hd3² = 102345b87hfeckjnigmdla69 in 98.035s Base 25: 1011e145fhghm² = 102345doeckj6gfb8liam7nh9 in 229.642s Base 26: 52k8n53bdm99k² = 1023458lo6iemkg79fpchnjdba in 935.014s Base 27: 1011f11e37objj² = 1023458elomdhbijfgkp7cq9n6a in 1774.957s
It's possible to go beyond base 27 by using big.Int (rather than uint64) for N as well as N² though this takes about 14% longer to reach base 27 itself.
For example, to reach base 28 (the largest base shown in the OEIS table) we have: <lang go>package main
import (
"fmt" "math/big" "time"
)
const maxBase = 28
// etc
func main() {
start := time.Now() var n, k, b, t, nn big.Int n.SetUint64(2) k.SetUint64(1) b.SetUint64(2) for base := 2; ; n.Add(&n, &k) { if base > 2 && t.Rem(&n, &b).Cmp(bigZero) == 0 { continue } sq := nn.Mul(&n, &n).Text(base) if !containsAll(sq, base) { continue } ns := n.Text(base) tt := time.Since(start).Seconds() fmt.Printf("Base %2d:%15s² = %-28s in %8.3fs\n", base, ns, sq, tt) if base == maxBase { break } base++ b.SetUint64(uint64(base)) ms, inc, bdr := minStart(base) k.SetUint64(inc) nn.SetString(ms, base) n.Sqrt(&nn) t.Add(&n, bigOne) if n.Cmp(&t) == -1 { n.Set(&t) } if inc != 1 { for { nn.Mul(&n, &n) dr := digitalRoot(&nn, base) if dr == bdr { n.Sub(&n, &k) break } n.Add(&n, bigOne) } } else { n.Sub(&n, &k) } }
}</lang>
- Output:
Base 2: 10² = 100 in 0.000s Base 3: 22² = 2101 in 0.000s Base 4: 33² = 3201 in 0.000s Base 5: 243² = 132304 in 0.000s Base 6: 523² = 452013 in 0.000s Base 7: 1431² = 2450361 in 0.000s Base 8: 3344² = 13675420 in 0.001s Base 9: 11642² = 136802574 in 0.001s Base 10: 32043² = 1026753849 in 0.001s Base 11: 111453² = 1240a536789 in 0.003s Base 12: 3966b9² = 124a7b538609 in 0.012s Base 13: 3828943² = 10254773ca86b9 in 0.028s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.031s Base 15: 1012b857² = 102597bace836d4 in 0.039s Base 16: 404a9d9b² = 1025648cfea37bd9 in 0.054s Base 17: 423f82ga9² = 101246a89cgfb357ed in 0.389s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 0.446s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 0.607s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 20.705s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 21.797s Base 22: 4f94788gj0f² = 102369fbgdej48chi7lka5 in 73.152s Base 23: 1011d3el56mc² = 10234acedkg9hm8fbjil756 in 107.040s Base 24: 4lj0hdgf0hd3² = 102345b87hfeckjnigmdla69 in 114.986s Base 25: 1011e145fhghm² = 102345doeckj6gfb8liam7nh9 in 266.218s Base 26: 52k8n53bdm99k² = 1023458lo6iemkg79fpchnjdba in 1073.121s Base 27: 1011f11e37objj² = 1023458elomdhbijfgkp7cq9n6a in 2018.632s Base 28: 58a3ckp3n4cqd7² = 1023456cgjbirqedhp98kmoan7fl in 3812.564s
JavaScript
<lang javascript>(() => {
'use strict';
// allDigitSquare :: Int -> Int const allDigitSquare = base => { const bools = replicate(base, false); return untilSucc( allDigitsUsedAtBase(base, bools), ceil(sqrt(parseInt( '10' + '0123456789abcdef'.slice(2, base), base ))) ); };
// allDigitsUsedAtBase :: Int -> [Bool] -> Int -> Bool const allDigitsUsedAtBase = (base, bools) => n => { // Fusion of representing the square of integer N at a given base // with checking whether all digits of that base contribute to N^2. // Sets the bool at a digit position to True when used. // True if all digit positions have been used. const ds = bools.slice(0); let x = n * n; while (x) { ds[x % base] = true; x = floor(x / base); } return ds.every(x => x) };
// showBaseSquare :: Int -> String const showBaseSquare = b => { const q = allDigitSquare(b); return justifyRight(2, ' ', str(b)) + ' -> ' + justifyRight(8, ' ', showIntAtBase(b, digit, q, )) + ' -> ' + showIntAtBase(b, digit, q * q, ); };
// TEST ----------------------------------------------- const main = () => { // 1-12 only - by 15 the squares are truncated by // JS integer limits.
// Returning values through console.log – // in separate events to avoid asynchronous disorder. print('Smallest perfect squares using all digits in bases 2-12:\n') print('Base Root Square')
print(showBaseSquare(2)); print(showBaseSquare(3)); print(showBaseSquare(4)); print(showBaseSquare(5)); print(showBaseSquare(6)); print(showBaseSquare(7)); print(showBaseSquare(8)); print(showBaseSquare(9)); print(showBaseSquare(10)); print(showBaseSquare(11)); print(showBaseSquare(12)); };
// GENERIC FUNCTIONS ---------------------------------- const ceil = Math.ceil, floor = Math.floor, sqrt = Math.sqrt;
// Tuple (,) :: a -> b -> (a, b) const Tuple = (a, b) => ({ type: 'Tuple', '0': a, '1': b, length: 2 });
// digit :: Int -> Char const digit = n => // Digit character for given integer. '0123456789abcdef' [n];
// enumFromTo :: (Int, Int) -> [Int] const enumFromTo = (m, n) => Array.from({ length: 1 + n - m }, (_, i) => m + i);
// justifyRight :: Int -> Char -> String -> String const justifyRight = (n, cFiller, s) => n > s.length ? ( s.padStart(n, cFiller) ) : s;
// print :: a -> IO () const print = x => console.log(x)
// quotRem :: Int -> Int -> (Int, Int) const quotRem = (m, n) => Tuple(Math.floor(m / n), m % n);
// replicate :: Int -> a -> [a] const replicate = (n, x) => Array.from({ length: n }, () => x);
// showIntAtBase :: Int -> (Int -> Char) -> Int -> String -> String const showIntAtBase = (base, toChr, n, rs) => { const go = ([n, d], r) => { const r_ = toChr(d) + r; return 0 !== n ? ( go(Array.from(quotRem(n, base)), r_) ) : r_; }; return 1 >= base ? ( 'error: showIntAtBase applied to unsupported base' ) : 0 > n ? ( 'error: showIntAtBase applied to negative number' ) : go(Array.from(quotRem(n, base)), rs); };
// Abbreviation for quick testing - any 2nd arg interpreted as indent size
// sj :: a -> String function sj() { const args = Array.from(arguments); return JSON.stringify.apply( null, 1 < args.length && !isNaN(args[0]) ? [ args[1], null, args[0] ] : [args[0], null, 2] ); }
// str :: a -> String const str = x => x.toString();
// untilSucc :: (Int -> Bool) -> Int -> Int const untilSucc = (p, x) => { // The first in a chain of successive integers // for which p(x) returns true. let v = x; while (!p(v)) v = 1 + v; return v; };
// MAIN --- return main();
})();</lang>
- Output:
Smallest perfect squares using all digits in bases 2-12: Base Root Square 2 -> 10 -> 100 3 -> 22 -> 2101 4 -> 33 -> 3201 5 -> 243 -> 132304 6 -> 523 -> 452013 7 -> 1431 -> 2450361 8 -> 3344 -> 13675420 9 -> 11642 -> 136802574 10 -> 32043 -> 1026753849 11 -> 111453 -> 1240a536789 12 -> 3966b9 -> 124a7b538609
Julia
Runs in about 4 seconds with using occursin(). <lang julia>const num = "0123456789abcdef" hasallin(n, nums, b) = (s = string(n, base=b); all(x -> occursin(x, s), nums))
function squaresearch(base)
basenumerals = [c for c in num[1:base]] highest = parse(Int, "10" * num[3:base], base=base) for n in Int(trunc(sqrt(highest))):highest if hasallin(n * n, basenumerals, base) return n end end
end
println("Base Root N") for b in 2:16
n = squaresearch(b) println(lpad(b, 3), lpad(string(n, base=b), 10), " ", string(n * n, base=b))
end
</lang>
- Output:
Base Root N 2 10 100 3 22 2101 4 33 3201 5 243 132304 6 523 452013 7 1431 2450361 8 3344 13675420 9 11642 136802574 10 32043 1026753849 11 111453 1240a536789 12 3966b9 124a7b538609 13 3828943 10254773ca86b9 14 3a9db7c 10269b8c57d3a4 15 1012b857 102597bace836d4 16 404a9d9b 1025648cfea37bd9
Pascal
Using an array of digits to base n, to get rid of base conversions.
Starting value equals squareroot of smallest value containing all digits to base.
Than brute force.
Try it online!
<lang pascal>program project1;
//Find the smallest number n to base b, so that n*n includes all
//digits of base b
{$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
uses
sysutils;
const
charSet : array[0..36] of char ='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
type
tNumtoBase = record ntb_dgt : array[0..31-4] of byte; ntb_cnt, ntb_bas : Word; end;
var
Num, sqr2B, deltaNum : tNumtoBase;
function Minimal_n(base:NativeUint):Uint64; //' 1023456789ABCDEFGHIJ...' var
i : NativeUint;
Begin
result := base; // aka '10' IF base > 2 then For i := 2 to base-1 do result := result*base+i; result := trunc(sqrt(result)+0.99999);
end;
procedure Conv2num(var num:tNumtoBase;n:Uint64;base:NativeUint); var
quot :UInt64; i :NativeUint;
Begin
i := 0; repeat quot := n div base; Num.ntb_dgt[i] := n-quot*base; n := quot; inc(i); until n = 0; Num.ntb_cnt := i; Num.ntb_bas := base; //clear upper digits For i := i to high(tNumtoBase.ntb_dgt) do Num.ntb_dgt[i] := 0;
end;
procedure OutNum(const num:tNumtoBase); var
i : NativeInt;
Begin
with num do Begin For i := 17-ntb_cnt-1 downto 0 do write(' '); For i := ntb_cnt-1 downto 0 do write(charSet[ntb_dgt[i]]); end;
end;
procedure IncNumBig(var add1:tNumtoBase;n:NativeUInt); //prerequisites //bases are the same,delta : NativeUint var
i,s,b,carry : NativeInt;
Begin
b := add1.ntb_bas; i := 0; carry := 0; while n > 0 do Begin s := add1.ntb_dgt[i]+carry+ n MOD b; carry := Ord(s>=b); s := s- (-carry AND b); add1.ntb_dgt[i] := s; n := n div b; inc(i); end; while carry <> 0 do Begin s := add1.ntb_dgt[i]+carry; carry := Ord(s>=b); s := s- (-carry AND b); add1.ntb_dgt[i] := s; inc(i); end;
IF add1.ntb_cnt < i then add1.ntb_cnt := i;
end;
procedure IncNum(var add1:tNumtoBase;carry:NativeInt); //prerequisites: bases are the same, carry==delta < base var
i,s,b : NativeInt;
Begin
b := add1.ntb_bas; i := 0; while carry <> 0 do Begin s := add1.ntb_dgt[i]+carry; carry := Ord(s>=b); s := s- (-carry AND b); add1.ntb_dgt[i] := s; inc(i); end; IF add1.ntb_cnt < i then add1.ntb_cnt := i;
end;
procedure AddNum(var add1,add2:tNumtoBase); //prerequisites //bases are the same,add1>add2, add1 <= add1+add2; var
i,carry,s,b : NativeInt;
Begin
b := add1.ntb_bas; carry := 0; For i := 0 to add2.ntb_cnt-1 do begin s := add1.ntb_dgt[i]+add2.ntb_dgt[i]+carry; carry := Ord(s>=b); s := s- (-carry AND b); add1.ntb_dgt[i] := s; end; i := add2.ntb_cnt; while carry = 1 do Begin s := add1.ntb_dgt[i]+carry; carry := Ord(s>=b); // remove of if s>b then by bit-twiddling s := s- (-carry AND b); add1.ntb_dgt[i] := s; inc(i); end; IF add1.ntb_cnt < i then add1.ntb_cnt := i;
end;
procedure Test(base:NativeInt); var
n : Uint64; i,j,TestSet : NativeInt;
Begin
write(base:5); n := Minimal_n(base); Conv2num(sqr2B,n*n,base); Conv2num(Num,n,base); deltaNum := num; AddNum(deltaNum,deltaNum); IncNum(deltaNum,1); i := 0; repeat //count used digits TestSet := 0; For j := sqr2B.ntb_cnt-1 downto 0 do TestSet := TestSet OR (1 shl sqr2B.ntb_dgt[j]); inc(TestSet); IF (1 shl base)=TestSet then BREAK; //next square number AddNum(sqr2B,deltaNum); IncNum(deltaNum,2); inc(i); until false; IncNumBig(num,i); OutNum(Num); OutNum(sqr2B); Writeln(i:14);
end;
var
T0: TDateTime; base :nativeInt;
begin
T0 := now; writeln('base n square(n) Testcnt'); For base := 2 to 16 do Test(base); writeln((now-T0)*86400:10:3); {$IFDEF WINDOWS}readln;{$ENDIF}
end.</lang>
- Output:
base n square(n) Testcnt 2 10 100 0 3 22 2101 4 4 33 3201 6 5 243 132304 46 6 523 452013 103 7 1431 2450361 209 8 3344 13675420 288 9 11642 136802574 1156 10 32043 1026753849 51 11 111453 1240A536789 14983 12 3966B9 124A7B538609 75713 13 3828943 10254773CA86B9 12668112 14 3A9DB7C 10269B8C57D3A4 17291 15 1012B857 102597BACE836D4 59026 16 404A9D9B 1025648CFEA37BD9 276865 0.401
Inserted nearly all optimizations found by Hout and Nigel Galloway
I use now gmp to calculate the start values.Check Chai Wah Wu list on oeis.org/A260182
Still not correct where I have to insert one digit! 102345... instead of 1012345...
The runtime is on my PC ( AMD 2200G ) about 80 s to complete the task.Try it online!
<lang pascal>program project1;
//Find the smallest number n to base b, so that n*n includes all
//digits of base b aka pandigital
{$IFDEF FPC}
//{$R+,O+}
{$MODE DELPHI} {$Optimization ON}
// {$CODEALIGN proc=4,loop=4} TIO
{$CODEALIGN proc=8,loop=1} // Ryzen
{$ENDIF} //{$DEFINE ShowInterims} uses
SysUtils, gmp;// to calculate start values
const
charSet: array[0..62] of char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
type
tNumtoBase = record ntb_dgt: array[0..63 - 2] of Uint32; ntb_cnt, ntb_bas: Uint32; end;
tDgtRootSqr = record drs_List: array[0..63 - 4] of Uint32; drs_bas: Uint32; drs_Sol: Uint32; drs_SolCnt: Uint32; drs_Insert: Uint32; drs_NeedsOneMoreDigit: boolean; end;
var {$ALIGN 32}
Num, sqr2B, deltaNum, delta: tNumtoBase;
{$ALIGN 32}
DgtRtSqr: tDgtRootSqr;
{$ALIGN 32}
T0, T1: TDateTime;
procedure OutNum(const num: tNumtoBase); var i: NativeInt; begin with num do begin for i := 30 - ntb_cnt - 1 downto 0 do Write(' '); for i := ntb_cnt - 1 downto 0 do Write(charSet[ntb_dgt[i]]); end; Write(' '); end;
procedure OutIndex(i: NativeInt; const Num: tNumtoBase); var p: NativeInt; s: string[127]; begin Write(#13); with Num do begin if i <> 0 then Write(i div 1000000: 10, ' Mio ') else Write(: 15); p := 1; setlength(s, ntb_cnt); for i := ntb_cnt - 1 downto 0 do begin s[p] := charSet[ntb_dgt[i]]; Inc(p); end; end; s[p] := ' '; Inc(p);
with sqr2B do begin setlength(s, length(s) + ntb_cnt + 1); for i := ntb_cnt - 1 downto 0 do begin s[p] := charSet[ntb_dgt[i]]; Inc(p); end; end; s[p] := #13; Write(s); end;
function getDgtRtNum(const num: tNumtoBase): NativeInt; var i: NativeInt; begin with num do begin Result := 0; for i := 0 to num.ntb_cnt - 1 do Inc(Result, ntb_dgt[i]); Result := Result mod (ntb_bas - 1); end; end;
procedure CalcDgtRootSqr(base: NativeUInt); var i: NativeUInt; begin with DgtRtSqr do begin //pandigtal digital root (sum all digits of base) mod (base-1) drs_bas := base; if Odd(base) then drs_Sol := base div 2 else drs_Sol := 0;
base := Base - 1; //calc which dgt root the square of the number will become for i := 0 to base - 1 do drs_List[i] := (i * i) mod base; //searchuing if solution drs_SolCnt := 0; for i := 0 to base - 1 do if drs_List[i] = drs_Sol then Inc(drs_SolCnt); //if not found then NeedsOneMoreDigit drs_NeedsOneMoreDigit := drs_SolCnt = 0; if drs_NeedsOneMoreDigit then for i := 1 to base - 1 do if (drs_Sol + i) mod Base = drs_List[i] then begin drs_Insert := i; BREAK; end; end; end;
procedure conv_ui_num(base: NativeUint; ui: Uint64; var Num: tNumtoBase); var i: NativeUInt; begin for i := 0 to high(tNumtoBase.ntb_dgt) do Num.ntb_dgt[i] := 0; with num do begin ntb_bas := base; ntb_cnt := 0; if ui = 0 then EXIT; i := 0; repeat ntb_dgt[i] := ui mod base; ui := ui div base; Inc(i); until ui = 0; ntb_cnt := i; end; end;
procedure conv2Num(base: NativeUint; var Num: tNumtoBase; s: mpz_t); // ! zero's s var i: NativeUInt; begin for i := 0 to high(tNumtoBase.ntb_dgt) do Num.ntb_dgt[i] := 0; with num do begin ntb_bas := base; i := 0; repeat ntb_dgt[i] := mpz_tdiv_q_ui(s, s, base); Inc(i); until mpz_cmp_ui(s, 0) = 0; ntb_cnt := i; end; end;
procedure StartValueCreate(base: NativeUInt); //create the lowest pandigital number "102345...Base-1 " //calc sqrt +1 and convert n new format. var sv_sqr, sv: mpz_t; k, ins: NativeUint;
begin CalcDgtRootSqr(base);
mpz_init(sv); mpz_init(sv_sqr);
mpz_init_set_si(sv_sqr, base);//"10" if base > 2 then begin if DgtRtSqr.drs_NeedsOneMoreDigit then begin ins := DgtRtSqr.drs_Insert; Write(' insert ', ins: 3); for k := 2 to ins do begin mpz_mul_ui(sv_sqr, sv_sqr, base); mpz_add_ui(sv_sqr, sv_sqr, k); end; for k := ins to Base - 1 do begin mpz_mul_ui(sv_sqr, sv_sqr, base); mpz_add_ui(sv_sqr, sv_sqr, k); end; end else begin k := 2; repeat mpz_mul_ui(sv_sqr, sv_sqr, base); mpz_add_ui(sv_sqr, sv_sqr, k); Inc(k); until k >= base; end; end; mpz_sqrt(sv, sv_sqr); mpz_mul(sv_sqr, sv, sv); conv2Num(base, Num, sv); conv2Num(base, sqr2B, sv_sqr); {$IFDEF ShowInterims} OutIndex(0, Num); writeln; {$ENDIF} mpz_clear(sv_sqr); mpz_clear(sv); end;
procedure IncNumBig(var add1: tNumtoBase; n: Uint64); var i, s, b, carry: NativeUInt; begin b := add1.ntb_bas; i := 0; carry := 0; while n > 0 do begin s := add1.ntb_dgt[i] + carry + n mod b; carry := Ord(s >= b); s := s - (-carry and b); add1.ntb_dgt[i] := s; n := n div b; Inc(i); end;
while carry <> 0 do begin s := add1.ntb_dgt[i] + carry; carry := Ord(s >= b); s := s - (-carry and b); add1.ntb_dgt[i] := s; Inc(i); end;
if add1.ntb_cnt < i then add1.ntb_cnt := i; end;
procedure IncNum(var add1: tNumtoBase; carry: NativeInt); //prerequisites carry < base var i, s, b: NativeUInt; begin b := add1.ntb_bas; i := 0; while carry <> 0 do begin s := add1.ntb_dgt[i] + carry; carry := Ord(s >= b); s := s - (-carry and b); add1.ntb_dgt[i] := s; Inc(i); end; if add1.ntb_cnt < i then add1.ntb_cnt := i; end;
procedure AddNum(var add1, add2: tNumtoBase); //add1 <= add1+add2; //prerequisites bases are the same,add1>=add2( cnt ), var i: NativeInt; carry, s, b: NativeUInt; begin b := add1.ntb_bas; carry := 0; for i := 0 to add2.ntb_cnt - 1 do begin s := add1.ntb_dgt[i] + add2.ntb_dgt[i] + carry; carry := Ord(s >= b); s := s - (-carry and b); add1.ntb_dgt[i] := s; end;
i := add2.ntb_cnt; while carry = 1 do begin s := add1.ntb_dgt[i] + carry; carry := Ord(s >= b); s := s - (-carry and b); add1.ntb_dgt[i] := s; Inc(i); end;
if add1.ntb_cnt < i then add1.ntb_cnt := i; end;
procedure Test(base: NativeInt); var deltaCnt, TestSet, testComplete: Uint64; i, j: NativeInt; begin Write(base: 3); T0 := now; StartValueCreate(base); {$IFDEF ShowInterims} OutIndex(0, Num); writeln; {$ENDIF} deltaNum := num; AddNum(deltaNum, deltaNum); IncNum(deltaNum, 1); deltaCnt := 1; if (Base > 3) and not (DgtRtSqr.drs_NeedsOneMoreDigit) then begin //Find first number which can get the solution with dgtrtsqr do while drs_List[getDgtRtNum(num)] <> drs_sol do begin IncNum(num, 1); AddNum(sqr2B, deltaNum); IncNum(deltaNum, 2); end;
deltaCnt := (Base - 1) div DgtRtSqr.drs_SolCnt; //j*num deltaNum := num; for i := 2 to deltaCnt do AddNum(deltaNum, num); AddNum(deltaNum, deltaNum); IncNumBig(deltaNum, deltaCnt * deltaCnt); end; conv_ui_num(base, 2 * deltaCnt * deltaCnt, delta); writeln(' test every ', deltaCnt); OutIndex(0, Num); writeln; i := 0; testComplete := Uint64(1) shl base - 1; repeat //count used digits TestSet := 0; for j := sqr2B.ntb_cnt - 1 downto 0 do TestSet := TestSet or (Uint64(1) shl sqr2B.ntb_dgt[j]); if testComplete = TestSet then BREAK; //next square number AddNum(sqr2B, deltaNum); AddNum(deltaNum, delta); Inc(i); {$IFDEF ShowInterims} if i and (1 shl 28 - 1) = 0 then OutIndex(i, deltaNum) {$ENDIF} until False; // correct num IncNumBig(num, i * deltaCnt); T1 := now; OutIndex(0, Num); writeln; Writeln((T1 - t0) * 86400: 9: 3, ' s Testcount : ', i); writeln; end;
var
T: TDateTime; base: nativeInt;
begin
writeln('base n square(n) Testcnt'); T := now;
for base := 2 to 30 do Test(base); writeln((now - T) * 86400: 10: 3, ' seconds'); {$IFDEF WINDOWS} readln;
{$ENDIF} end.
</lang>
- Output:
base n square(n) Testcnt 2 test every 1 1 1 10 100 0.000 s Testcount : 1 3 test every 1 10 100 22 2101 0.000 s Testcount : 5 4 test every 3 21 1101 33 3201 0.000 s Testcount : 2 5 insert 2 test every 1 213 101424 243 132304 0.000 s Testcount : 15 6 test every 5 235 105441 523 452013 0.000 s Testcount : 20 7 test every 6 1011 1022121 1431 2450361 0.000 s Testcount : 35 8 test every 7 2705 10244631 3344 13675420 0.000 s Testcount : 41 9 test every 4 10117 102363814 11642 136802574 0.000 s Testcount : 289 10 test every 3 31992 1023488064 32043 1026753849 0.000 s Testcount : 17 11 test every 10 101175 10235267A63 111453 1240A536789 0.000 s Testcount : 1498 12 test every 11 35A924 102345A32554 3966B9 124A7B538609 0.000 s Testcount : 6883 13 insert 3 test every 1 3824C72 10233456419824 3828943 10254773CA86B9 0.000 s Testcount : 8243 14 test every 13 3A9774C 1023457801D984 3A9DB7C 10269B8C57D3A4 0.000 s Testcount : 1330 15 test every 14 10119108 1023456BA5BA144 1012B857 102597BACE836D4 0.000 s Testcount : 4216 16 test every 15 40466424 1023456CEADC2510 404A9D9B 1025648CFEA37BD9 0.000 s Testcount : 18457 17 insert 8 test every 1 426180FCB 1023456783420FEDG2 4261CBG65 102369EB54FD9G7CA8 0.015 s Testcount : 388308 18 test every 17 44B433H7F 102345679E6908HD69 44B482CAD 10236B5F8EG4AD9CH7 0.000 s Testcount : 30440 19 test every 6 1011B10789 102345678I39A8G87F5 1011B55E9A 10234DHBG7CI8F6A9E5 0.000 s Testcount : 93021 20 test every 19 49DDBE2JA0 102345678D5CCEH05000 49DGIH5D3G 1024E7CDI3HB695FJA8G 0.485 s Testcount : 11310604 21 insert 6 test every 1 4C9HE5CC2DA 102345667897G4CG438BCG 4C9HE5FE27F 1023457DG9HI8J6B6KCEAF 0.031 s Testcount : 601844 22 test every 21 4F942523JL0 1023456789HL35DJ1I4100 4F94788GJ0F 102369FBGDEJ48CHI7LKA5 1.266 s Testcount : 27804949 23 test every 22 1011D108L540 1023456789A9D49M46AHG00 1011D3EL56MC 10234ACEDKG9HM8FBJIL756 0.765 s Testcount : 17710218 24 test every 23 4LJ0HD4763F6 1023456789AC9NJIL6HG54DC 4LJ0HDGF0HD3 102345B87HFECKJNIGMDLA69 0.204 s Testcount : 4266555 25 test every 12 1011E109GHMMM 1023456789ABD5AHDHG370GC9 1011E145FHGHM 102345DOECKJ6GFB8LIAM7NH9 3.875 s Testcount : 78092125 26 test every 5 52K8N4MNP7AM9 1023456789ABCCJPGN3JNMK393 52K8N53BDM99K 1023458LO6IEMKG79FPCHNJDBA 18.251 s Testcount : 402922569 27 test every 26 1011F10AB5HL71 1023456789ABD6808CDF1LQ7AE1 1011F11E37OBJJ 1023458ELOMDHBIJFGKP7CQ9N6A 22.299 s Testcount : 457555293 28 test every 9 58A3CKOHN4IK4C 1023456789ABCD83A2GKO3BHLNH4 58A3CKP3N4CQD7 1023456CGJBIRQEDHP98KMOAN7FL 37.690 s Testcount : 749593055 29 insert 7 test every 1 5BAH95I7IEKD9JR 10234567789ABCDEEQ8RFDL7AA1D74 5BAH95I8BCSN21Q 10234567FCQS2OBP8NRLMGJIDAEKH9 674.188 s Testcount : 13050986492 30 test every 29 start values: 5EF7R2P77FFPBN5 1023456789ABCDHNHROTMC0MS6RGKP 5EF7R2POS9MQRN7 1023456DMAPECBQOLSITK9FR87GHNJ 736.579 s Testcount : 13343410738
Now testing 31..35
31 test every 30 1011H10BS64GFL76 1023456789ABCDF03FNNQ29H0ULION5 1011H10CDMAUP44O 10234568ABQUJGCNFP7KEM9RHDLTSOI 810.852 s Testcount : 15152895679 Base 32 test every 31 5L6HID7BVGE2CIEC 102345678VS9CMJDRAIOPLHNFQETBUKG 127.853 s Testcount : 2207946558 Base 33 test every 8 1011I10CLWWNS6SKS 102345678THKFAERNWJGDOSQ9BCIUVMLP 5210.788 s Testcount : 53808573863 Base 34 test every 33 BB6GLLFX5V75RA3RRL 102345679JICE8KP5LXA8L3QUPUWFPE4P 28900.032 s Testcount : 205094427126 base 35 test every 34 1011J10DEFW1QTVBXR 102345678RUEPV9KGQIWFOBAXCNSLDMYJHT 48673.607 s Testcount : 614575698110
Perl
<lang perl>use strict; use warnings; use feature 'say'; use ntheory qw/fromdigits todigitstring/; use utf8; binmode('STDOUT', 'utf8');
sub first_square {
my $n = shift; my $sr = substr('1023456789abcdef',0,$n); my $r = int fromdigits($sr, $n) ** .5; my @digits = reverse split , $sr; TRY: while (1) { my $sq = $r * $r; my $cnt = 0; my $s = todigitstring($sq, $n); my $i = scalar @digits; for (@digits) { $r++ and redo TRY if (-1 == index($s, $_)) || ($i-- + $cnt < $n); last if $cnt++ == $n; } return sprintf "Base %2d: %10s² == %s", $n, todigitstring($r, $n), todigitstring($sq, $n); }
}
say "First perfect square with N unique digits in base N: "; say first_square($_) for 2..16;</lang>
- Output:
First perfect square with N unique digits in base N: Base 2: 10² == 100 Base 3: 22² == 2101 Base 4: 33² == 3201 Base 5: 243² == 132304 Base 6: 523² == 452013 Base 7: 1431² == 2450361 Base 8: 3344² == 13675420 Base 9: 11642² == 136802574 Base 10: 32043² == 1026753849 Base 11: 111453² == 1240a536789 Base 12: 3966b9² == 124a7b538609 Base 13: 3828943² == 10254773ca86b9 Base 14: 3a9db7c² == 10269b8c57d3a4 Base 15: 1012b857² == 102597bace836d4 Base 16: 404a9d9b² == 1025648cfea37bd9
Alternative solution:
<lang perl>use strict; use warnings; use ntheory qw(:all); use List::Util qw(uniq);
sub first_square {
my ($base) = @_;
my $start = sqrtint(fromdigits([1, 0, 2 .. $base-1], $base));
for (my $k = $start ; ; ++$k) { if (uniq(todigits($k * $k, $base)) == $base) { return $k * $k; } }
}
foreach my $n (2 .. 16) {
my $s = first_square($n); printf("Base %2d: %10s² == %s\n", $n, todigitstring(sqrtint($s), $n), todigitstring($s, $n));
}</lang>
Perl 6
As long as you have the patience, this will work for bases 2 through 36.
Bases 2 through 19 finish quickly, (about 10 seconds on my system), 20 takes a while, 21 is pretty fast, 22 is glacial. 23 through 26 takes several hours.
Use analytical start value filtering based on observations by Hout++ and Nigel Galloway++ on the discussion page.
<lang perl6>#`[
Only search square numbers that have at least N digits; smaller could not possibly match.
Only bother to use analytics for large N. Finesse takes longer than brute force for small N.
]
unit sub MAIN ($timer = False);
sub first-square (Int $n) {
my @start = flat '1', '0', (2 ..^ $n)».base: $n;
if $n > 10 { # analytics my $root = digital-root( @start.join, :base($n) ); my @roots = (2..$n).map(*²).map: { digital-root($_.base($n), :base($n) ) }; if $root ∉ @roots { my $offset = min(@roots.grep: * > $root ) - $root; @start[1+$offset] = $offset ~ @start[1+$offset]; } }
my $start = @start.join.parse-base($n).sqrt.ceiling; my @digits = reverse (^$n)».base: $n; my $sq; my $now = now; my $time = 0; my $sr; for $start .. * { $sq = .²; my $s = $sq.base($n); my $f; $f = 1 and last unless $s.contains: $_ for @digits; if $timer && $n > 19 && $_ %% 1_000_000 { $time += now - $now; say "N $n: {$_}² = $sq <$s> : {(now - $now).round(.001)}s" ~ " : {$time.round(.001)} elapsed"; $now = now; } next if $f; $sr = $_; last } sprintf( "Base %2d: %13s² == %-30s", $n, $sr.base($n), $sq.base($n) ) ~ ($timer ?? ($time + now - $now).round(.001) !! );
}
sub digital-root ($root is copy, :$base = 10) {
$root = $root.comb.map({:36($_)}).sum.base($base) while $root.chars > 1; $root.parse-base($base);
}
say "First perfect square with N unique digits in base N: "; say .&first-square for flat
2 .. 12, # required 13 .. 16, # optional 17 .. 19, # stretch 20, # slow 21, # pretty fast 22, # very slow 23, # don't hold your breath 24, # slow but not too terrible 25, # very slow 26, # "
- </lang>
- Output:
First perfect square with N unique digits in base N: Base 2: 10² == 100 Base 3: 22² == 2101 Base 4: 33² == 3201 Base 5: 243² == 132304 Base 6: 523² == 452013 Base 7: 1431² == 2450361 Base 8: 3344² == 13675420 Base 9: 11642² == 136802574 Base 10: 32043² == 1026753849 Base 11: 111453² == 1240A536789 Base 12: 3966B9² == 124A7B538609 Base 13: 3828943² == 10254773CA86B9 Base 14: 3A9DB7C² == 10269B8C57D3A4 Base 15: 1012B857² == 102597BACE836D4 Base 16: 404A9D9B² == 1025648CFEA37BD9 Base 17: 423F82GA9² == 101246A89CGFB357ED Base 18: 44B482CAD² == 10236B5F8EG4AD9CH7 Base 19: 1011B55E9A² == 10234DHBG7CI8F6A9E5 Base 20: 49DGIH5D3G² == 1024E7CDI3HB695FJA8G Base 21: 4C9HE5FE27F² == 1023457DG9HI8J6B6KCEAF Base 22: 4F94788GJ0F² == 102369FBGDEJ48CHI7LKA5 Base 23: 1011D3EL56MC² == 10234ACEDKG9HM8FBJIL756 Base 24: 4LJ0HDGF0HD3² == 102345B87HFECKJNIGMDLA69 Base 25: 1011E145FHGHM² == 102345DOECKJ6GFB8LIAM7NH9 Base 26: 52K8N53BDM99K² == 1023458LO6IEMKG79FPCHNJDBA
Python
<lang python>Perfect squares using every digit in a given base.
from itertools import (count, dropwhile, repeat) from math import (ceil, sqrt) from time import time
- allDigitSquare :: Int -> Int -> Int
def allDigitSquare(base, above):
The lowest perfect square which requires all digits in the given base. bools = list(repeat(True, base)) return next(dropwhile(missingDigitsAtBase(base, bools), count( max(above, ceil(sqrt(int('10' + '0123456789abcdef'[2:base], base)))) )))
- missingDigitsAtBase :: Int -> [Bool] -> Int -> Bool
def missingDigitsAtBase(base, bools):
Fusion of representing the square of integer N at a given base with checking whether all digits of that base contribute to N^2. Clears the bool at a digit position to False when used. True if any positions remain uncleared (unused). def go(x): xs = bools.copy() while x: xs[x % base] = False x //= base return any(xs) return lambda n: go(n * n)
- digit :: Int -> Char
def digit(n):
Digit character for given integer. return '0123456789abcdef'[n]
- TEST ----------------------------------------------------
- main :: IO ()
def main():
Smallest perfect squares using all digits in bases 2-16
start = time()
print(main.__doc__ + ':\n\nBase Root Square') q = 0 for b in enumFromTo(2)(16): q = allDigitSquare(b, q) print( str(b).rjust(2, ' ') + ' -> ' + showIntAtBase(b)(digit)(q)().rjust(8, ' ') + ' -> ' + showIntAtBase(b)(digit)(q * q)() )
print( '\nc. ' + str(ceil(time() - start)) + ' seconds.' )
- GENERIC -------------------------------------------------
- enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
Integer enumeration from m to n. return lambda n: list(range(m, 1 + n))
- showIntAtBase :: Int -> (Int -> String) -> Int -> String -> String
def showIntAtBase(base):
String representation of an integer in a given base, using a supplied function for the string representation of digits. def wrap(toChr, n, rs): def go(nd, r): n, d = nd r_ = toChr(d) + r return go(divmod(n, base), r_) if 0 != n else r_ return 'unsupported base' if 1 >= base else ( 'negative number' if 0 > n else ( go(divmod(n, base), rs)) ) return lambda toChr: lambda n: lambda rs: ( wrap(toChr, n, rs) )
- MAIN ---
if __name__ == '__main__':
main()</lang>
- Output:
Smallest perfect squares using all digits in bases 2-16: Base Root Square 2 -> 10 -> 100 3 -> 22 -> 2101 4 -> 33 -> 3201 5 -> 243 -> 132304 6 -> 523 -> 452013 7 -> 1431 -> 2450361 8 -> 3344 -> 13675420 9 -> 11642 -> 136802574 10 -> 32043 -> 1026753849 11 -> 111453 -> 1240a536789 12 -> 3966b9 -> 124a7b538609 13 -> 3828943 -> 10254773ca86b9 14 -> 3a9db7c -> 10269b8c57d3a4 15 -> 1012b857 -> 102597bace836d4 16 -> 404a9d9b -> 1025648cfea37bd9 c. 30 seconds.
REXX
The REXX language doesn't have
a sqrt function, nor does it have a general purpose
radix (base) convertor,
so RYO versions were included here.
These REXX versions can handle up to base 36.
slightly optimized
<lang rexx>/*REXX program finds/displays the first perfect square with N unique digits in base N.*/ numeric digits 40 /*ensure enough decimal digits for a #.*/ parse arg n . /*obtain optional argument from the CL.*/ if n== | n=="," then n= 16 /*not specified? Then use the default.*/ @start= 1023456789abcdefghijklmnopqrstuvwxyz /*contains the start # (up to base 36).*/
w= length(n) /* [↓] find the smallest square with */ do j=2 to n; beg= left(@start, j) /* N unique digits in base N. */ do k=iSqrt( base(beg,10,j) ) until #==0 /*start each search from smallest sqrt.*/ $= base(k*k, j, 10) /*calculate square, convert to base J. */ $u= $; upper $u /*get an uppercase version fast count. */ #= verify(beg, $u) /*count differences between 2 numbers. */ end /*k*/ say 'base' right(j,w) " root=" right(base(k,j,10),max(5,n)) ' square=' $ end /*j*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ base: procedure; arg x 1 #,toB,inB /*obtain: three arguments. */
@l= '0123456789abcdefghijklmnopqrstuvwxyz' /*lowercase (Latin or English) alphabet*/ @u= @l; upper @u /*uppercase " " " " */ if inb\==10 then /*only convert if not base 10. */ do; #= 0 /*result of converted X (in base 10).*/ do j=1 for length(x) /*convert X: base inB ──► base 10. */ #= # * inB + pos(substr(x,j,1), @u)-1 /*build a new number, digit by digit. */ end /*j*/ /* [↑] this also verifies digits. */ end y= /*the value of X in base B (so far).*/ if tob==10 then return # /*if TOB is ten, then simply return #.*/ do while # >= toB /*convert #: base 10 ──► base toB.*/ y= substr(@l, (# // toB) + 1, 1)y /*construct the output number. */ #= # % toB /* ··· and whittle # down also. */ end /*while*/ /* [↑] algorithm may leave a residual.*/ return substr(@l, # + 1, 1)y /*prepend the residual, if any. */
/*──────────────────────────────────────────────────────────────────────────────────────*/ iSqrt: procedure; parse arg x; r=0; q=1; do while q<=x; q=q*4; end
do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do;x=_;r=r+q; end; end; return r</lang>
- output when using the default input:
base 2 root= 10 square= 100 base 3 root= 22 square= 2101 base 4 root= 33 square= 3201 base 5 root= 243 square= 132304 base 6 root= 523 square= 452013 base 7 root= 1431 square= 2450361 base 8 root= 3344 square= 13675420 base 9 root= 11642 square= 136802574 base 10 root= 32043 square= 1026753849 base 11 root= 111453 square= 1240a536789 base 12 root= 3966b9 square= 124a7b538609 base 13 root= 3828943 square= 10254773ca86b9 base 14 root= 3a9db7c square= 10269b8c57d3a4 base 15 root= 1012b857 square= 102597bace836d4 base 16 root= 404a9d9b square= 1025648cfea37bd9
more optimized
This REXX version uses a highly optimized base function since it was that particular function that was consuming the majority of the CPU time.
It is about 10% faster. <lang rexx>/*REXX program finds/displays the first perfect square with N unique digits in base N.*/ numeric digits 40 /*ensure enough decimal digits for a #.*/ parse arg n . /*obtain optional argument from the CL.*/ if n== | n=="," then n= 16 /*not specified? Then use the default.*/ @start= 1023456789abcdefghijklmnopqrstuvwxyz /*contains the start # (up to base 36).*/ call base /*initialize 2 arrays for BASE function*/
/* [↓] find the smallest square with */ do j=2 to n; beg= left(@start, j) /* N unique digits in base N. */ do k=iSqrt( base(beg,10,j) ) until #==0 /*start each search from smallest sqrt.*/ $= base(k*k, j, 10) /*calculate square, convert to base J. */ #= verify(beg, $) /*count differences between 2 numbers. */ end /*k*/ say 'base' right(j, length(n) ) " root=" , lower( right( base(k, j, 10), max(5, n) ) ) ' square=' lower($) end /*j*/
exit /*stick a fork in it, we're all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ base: procedure expose !. !!.; arg x 1 #,toB,inB /*obtain: three arguments. */
@= 0123456789abcdefghijklmnopqrstuvwxyz /*the characters for the Latin alphabet*/ if x== then do i=1 for length(@); _= substr(@, i, 1); m= i - 1; !._= m !!.m= substr(@, i, 1) if i==length(@) then return /*Done with shortcuts? Then go back. */ end /*i*/ /* [↑] assign shortcut radix values. */ if inb\==10 then /*only convert if not base 10. */ do; #= 0 /*result of converted X (in base 10).*/ do j=1 for length(x) /*convert X: base inB ──► base 10. */ _= substr(x, j, 1); #= # * inB + !._ /*build a new number, digit by digit. */ end /*j*/ /* [↑] this also verifies digits. */ end y= /*the value of X in base B (so far).*/ if tob==10 then return # /*if TOB is ten, then simply return #.*/ do while # >= toB /*convert #: base 10 ──► base toB.*/ _= # // toB; y= !!._ || y /*construct the output number. */ #= # % toB /* ··· and whittle # down also. */ end /*while*/ /* [↑] algorithm may leave a residual.*/ return !!.# || y /*prepend the residual, if any. */
/*──────────────────────────────────────────────────────────────────────────────────────*/ iSqrt: procedure; parse arg x; r=0; q=1; do while q<=x; q=q*4; end
do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do;x=_;r=r+q; end; end; return r
/*──────────────────────────────────────────────────────────────────────────────────────*/ lower: @abc= 'abcdefghijklmnopqrstuvwxyz'; return translate(arg(1), @abc, translate(@abc))</lang>
- output is identical to the 1st REXX version.
Sidef
<lang ruby>func first_square(b) {
var start = [1, 0, (2..^b)...].flip.map_kv{|k,v| v * b**k }.sum.isqrt
start..Inf -> first_by {|k| k.sqr.digits(b).freq.len == b }.sqr
}
for b in (2..16) {
var s = first_square(b) printf("Base %2d: %10s² == %s\n", b, s.isqrt.base(b), s.base(b))
}</lang>
- Output:
Base 2: 10² == 100 Base 3: 22² == 2101 Base 4: 33² == 3201 Base 5: 243² == 132304 Base 6: 523² == 452013 Base 7: 1431² == 2450361 Base 8: 3344² == 13675420 Base 9: 11642² == 136802574 Base 10: 32043² == 1026753849 Base 11: 111453² == 1240a536789 Base 12: 3966b9² == 124a7b538609 Base 13: 3828943² == 10254773ca86b9 Base 14: 3a9db7c² == 10269b8c57d3a4 Base 15: 1012b857² == 102597bace836d4 Base 16: 404a9d9b² == 1025648cfea37bd9
zkl
<lang zkl>fcn squareSearch(B){
basenumerals:=B.pump(String,T("toString",B)); // 13 --> "0123456789abc" highest:=("10"+basenumerals[2,*]).toInt(B); // 13 --> "10" "23456789abc" foreach n in ([highest.toFloat().sqrt().toInt() .. highest]){ ns:=(n*n).toString(B); if(""==(basenumerals - ns) ) return(n.toString(B),ns); } Void
}</lang> <lang zkl>println("Base Root N"); foreach b in ([2..16])
{ println("%2d %10s %s".fmt(b,squareSearch(b).xplode())) }</lang>
- Output:
Base Root N 2 10 100 3 22 2101 4 33 3201 5 243 132304 6 523 452013 7 1431 2450361 8 3344 13675420 9 11642 136802574 10 32043 1026753849 11 111453 1240a536789 12 3966b9 124a7b538609 13 3828943 10254773ca86b9 14 3a9db7c 10269b8c57d3a4 15 1012b857 102597bace836d4 16 404a9d9b 1025648cfea37bd9