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)
F#
<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
Go
Basic plus optional
This takes advantage of the following optimizations pointed out by Nigel Galloway in the Discussion page:
- The Digital Root of a perfect square expressed in base n is a quadratic residual in base n-1.
- So, taking base 13 as an example, the 13 digit pandigital number 1023456789abc has a digital root of 6 which doesn't correspond to one of the quadratic residuals of base 12 (1, 4, 9 or 12). Consequently, the first square for base 13 must have (at least) 14 digits.
- When an additional digit is required, the repeated digit cannot be zero.
- Again taking base 13 as an example, the starting 14 digit number should be 10123456789abc rather than 10023456789abc. This is because the insertion of an extra zero doesn't change the digital root and hence the repeated digit must be at least 1.
<lang go>package main
import (
"fmt" "math" "strconv" "time"
)
const maxBase = 16 const minSq16 = "1023456789abcdef" const minSq16x = "10123456789abcdef"
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 uint64, base int) int {
sum := 0
b := uint64(base)
for n > 0 {
sum += int(n % b)
n /= b
}
return sum
}
func digitalRoot(n uint64, base int) int {
root := uint64(0)
for i := n; i >= uint64(base); i = root {
root = uint64(sumDigits(i, base))
}
return int(root)
}
func quadRes(base int) map[int]bool {
res := make(map[int]bool)
res[base] = true
for i := 1; i <= base/2; i++ {
res[(i*i)%base] = true
}
return res
}
func main() {
start := time.Now()
for n, base := uint64(2), 2; ; n++ {
sq := strconv.FormatUint(n*n, base)
if !containsAll(sq, base) {
continue
}
ns := strconv.FormatUint(n, base)
fmt.Printf("Base %2d:%10s² = %s\n", base, ns, sq)
if base == maxBase {
break
}
base++
minNN, _ := strconv.ParseUint(minSq16[:base], base, 64)
dr := digitalRoot(minNN, base)
qr := quadRes(base - 1)
if !qr[dr] {
minNN, _ = strconv.ParseUint(minSq16x[:base+1], base, 64)
}
if minNN > (n+1)*(n+1) {
n = uint64(math.Sqrt(float64(minNN))) - 1
}
}
fmt.Printf("\nTook %s\n", time.Since(start))
}</lang>
- Output:
Timing is for my trusty old Celeron @1.6GHz and should be much faster on a more modern machine.
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 Took 231.583301ms
Stretch (to base 20)
The following version uses big.Int rather than uint64 so it can deal with the stretch goal but otherwise uses the same optimizations as before (particularly valuable in the case of base 17 which takes 'hours' to brute-force!).
Expect a run time of a few minutes to reach base 20. <lang go>package main
import (
"fmt" "math/big" "strconv" "time"
)
const maxBase = 20 const minSq36 = "1023456789abcdefghijklmnopqrstuvwxyz" const minSq36x = "10123456789abcdefghijklmnopqrstuvwxyz"
var bigZero = new(big.Int)
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 quadRes(base int) map[int]bool {
res := make(map[int]bool)
res[base] = true
for i := 1; i <= base/2; i++ {
res[(i*i)%base] = true
}
return res
}
func main() {
start := time.Now()
var nb, nn big.Int
for n, base := uint64(2), 2; ; n++ {
nb.SetUint64(n)
sq := nb.Mul(&nb, &nb).Text(base)
if !containsAll(sq, base) {
continue
}
ns := strconv.FormatUint(n, base)
fmt.Printf("Base %2d:%12s² = %s\n", base, ns, sq)
if base == maxBase {
break
}
base++
nn.SetString(minSq36[:base], base)
dr := digitalRoot(&nn, base)
qr := quadRes(base - 1)
if !qr[dr] {
nn.SetString(minSq36x[:base+1], base)
}
nb.SetUint64(n + 1)
nb.Mul(&nb, &nb)
if nn.Cmp(&nb) == 1 {
nb.Sqrt(&nn)
n = nb.Uint64() - 1
}
}
fmt.Printf("Took %s\n", time.Since(start))
}</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 Base 17: 423f82ga9² = 101246a89cgfb357ed Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g Took 5m29.28880689s
Stretch more (to base 25)
This uses the technique described in the Discussion page by Thundergnat to "analytically determine minimum start value" which, for those cases which require an extra digit, allows us to place a lower bound on what that digit should be. This helps considerably with base 21 which is now more or less instant though doesn't help with higher bases (up to 25) which are still slow (or very slow) to emerge. <lang go>package main
import (
"fmt" "math/big" "strconv" "time"
)
const maxBase = 25 const minSq36 = "1023456789abcdefghijklmnopqrstuvwxyz" const minSq36x = "10123456789abcdefghijklmnopqrstuvwxyz"
var bigZero = new(big.Int)
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 {
nn := new(big.Int)
ms := minSq36[:base]
nn.SetString(ms, base)
bdr := digitalRoot(nn, base)
var drs []int
for n := uint64(1); n < uint64(base); n++ {
nn.SetUint64(n * n)
dr := digitalRoot(nn, base)
if dr == 0 {
dr = int(n * n)
}
if dr >= bdr {
drs = append(drs, dr)
}
}
if len(drs) == 0 {
return ms
}
min := drs[0]
for _, dr := range drs[1:] {
if dr < min {
min = dr
}
}
rd := min - bdr
if rd == 0 {
return ms
}
if rd == 1 {
return minSq36x[:base+1]
}
ins := string(minSq36[rd])
return (minSq36[:rd] + ins + minSq36[rd:])[:base+1]
}
func main() {
start := time.Now()
var nb, nn big.Int
for n, base := uint64(2), 2; ; n++ {
nb.SetUint64(n)
sq := nb.Mul(&nb, &nb).Text(base)
if !containsAll(sq, base) {
continue
}
ns := strconv.FormatUint(n, base)
fmt.Printf("Base %2d:%15s² = %s\n", base, ns, sq)
if base == maxBase {
break
}
base++
ms := minStart(base)
nn.SetString(ms, base)
nb.SetUint64(n + 1)
nb.Mul(&nb, &nb)
if nn.Cmp(&nb) == 1 {
nb.Sqrt(&nn)
n = nb.Uint64() - 1
}
}
fmt.Printf("\nTook %s\n", time.Since(start))
}</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 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 Took 1h0m44.375579095s
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
proof of concept
I tested my program using precalculated start values to check Chai Wah Wu list on oeis.org/A260182
The runtime is by far faster."23 through 26 takes several hours" => 1 minute.
<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;
type
ttestCaseData = string[31];
tTestcase = record
tc_n,
tc_sqr_n :ttestCaseData;
end;
const
charSet : array[0..36] of char ='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cTestCases : array[22..28] of tTestcase =
((tc_n:'4F942523JK5';
tc_sqr_n:'1023456789AF71694A3533'),
(tc_n:'1011D108L540';
tc_sqr_n:'1023456789A9D49M46AHG00'),
(tc_n:'4LJ0HD4763F3';
tc_sqr_n:'1023456789AB4D1EBNFKG6I9s'),
(tc_n:'1011E109GHMMM';
tc_sqr_n:'1023456789ABD5AHDHG370GC9'),
(tc_n:'52K8N4MNP7AM9';
tc_sqr_n:'1023456789ABCCJPGN3JNMK393'),
(tc_n:'1011F10AB5HL6I';
tc_sqr_n:'1023456789ABCD7648K79DL2HC0'),
(tc_n:'58A3CKOHN4IK4C';
tc_sqr_n:'1023456789ABCD83A2GKO3BHLNH4'));
type
tNumtoBase = record
ntb_dgt : array[0..31-4] of byte;
ntb_cnt,
ntb_bas : Word;
end;
var {$ALIGN 32}
Num, sqr2B, deltaNum : tNumtoBase; 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 conv2Num(base:NativeUint;var Num:tNumtoBase;const s:ttestCaseData); var
i,j : NativeInt;
Begin
For i := 0 to high(tNumtoBase.ntb_dgt) do
Num.ntb_dgt[i] := 0;
i := length(s);
with num do
begin
ntb_bas := base;
ntb_cnt:= i;
j := 1;
while i > 0 do
Begin
dec(i);
ntb_dgt[i] := Pos(s[j],charSet)-1;
inc(j);
end;
end;
end;
procedure GetNum(base:NativeUint); Begin
conv2Num(base,Num,cTestCases[base].tc_n); conv2Num(base,sqr2B,cTestCases[base].tc_sqr_n);
end;
procedure IncNumBig(var add1:tNumtoBase;n:Uint64); //prerequisites //bases are the same,delta < base 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,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); 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
i,j,TestSet : NativeInt;
Begin
writeln(base:5);
GetNum(base);
OutNum(Num);
OutNum(sqr2B);
writeln;
T0 := now;
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);
// IF i AND ( 1 shl 24 - 1) = 0 then write(i,#13);// takes to much time
until false; IncNumBig(num,i); T1 := now; OutNum(Num); OutNum(sqr2B);
Writeln(' testcount ',i:12,(T1-t0 )*86400:9:3,' seconds');
writeln;
end;
var
T: TDateTime; base :nativeInt;
begin
T := now;
writeln('base n square(n) Testcnt');
For base := 22 to 28 do
Test(base);
writeln((now-T)*86400:10:3,' seconds');
{$IFDEF WINDOWS}readln;{$ENDIF}
end. </lang>{{out}
base n square(n)
22
{startvalue} 4F942523JK5 1023456789AF71694A3533
4F94788GJ0F 102369FBGDEJ48CHI7LKA5 testcount 583903946 25.960 seconds
23
1011D108L540 1023456789A9D49M46AHG00
1011D3EL56MC 10234ACEDKG9HM8FBJIL756 testcount 389624796 16.517 seconds
24
4LJ0HD4763F3 1023456789AB4D1EBNFKG6I9 <- Uups 0 is gone
4LJ0HD95KAE6 102345698LDKMCAF7EGBHJN2I testcount 39347115 1.859 seconds
25
1011E109GHMMM 1023456789ABD5AHDHG370GC9
1011E145FHGHM 102345DOECKJ6GFB8LIAM7NH9 testcount 937105500 42.284 seconds
26
52K8N4MNP7AM9 1023456789ABCCJPGN3JNMK393
52K8N53BDM99K 1023458LO6IEMKG79FPCHNJDBA testcount 2014612845 99.679 seconds
27
1011F10AB5HL6I 1023456789ABCD7648K79DL2HC0
1011F11E37OBJJ 1023458ELOMDHBIJFGKP7CQ9N6A testcount 11896437628 577.726 seconds
28
58A3CKOHN4IK4C 1023456789ABCD83A2GKO3BHLNH4
58A3CKP3N4CQD7 1023456CGJBIRQEDHP98KMOAN7FL testcount 6746337495 356.024 seconds
1120.081 seconds
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