First perfect square in base n with n unique digits
First perfect square in base n with n unique digits is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
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]byte
le := len(sq)
reps := 0
for _, r := range sq {
d := r - 48
if d > 38 {
d -= 39
}
found[d]++
if found[d] > 1 {
reps++
if le-reps < base {
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.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.002s Base 12: 3966b9² = 124a7b538609 in 0.009s Base 13: 3828943² = 10254773ca86b9 in 0.018s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.020s Base 15: 1012b857² = 102597bace836d4 in 0.025s Base 16: 404a9d9b² = 1025648cfea37bd9 in 0.034s Base 17: 423f82ga9² = 101246a89cgfb357ed in 0.293s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 0.334s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 0.459s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 16.017s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 16.953s Base 22: 4f94788gj0f² = 102369fbgdej48chi7lka5 in 57.406s Base 23: 1011d3el56mc² = 10234acedkg9hm8fbjil756 in 83.505s Base 24: 4lj0hdgf0hd3² = 102345b87hfeckjnigmdla69 in 89.939s Base 25: 1011e145fhghm² = 102345doeckj6gfb8liam7nh9 in 211.535s Base 26: 52k8n53bdm99k² = 1023458lo6iemkg79fpchnjdba in 854.955s Base 27: 1011f11e37objj² = 1023458elomdhbijfgkp7cq9n6a in 1619.151s
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 16% 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.001s Base 5: 243² = 132304 in 0.001s Base 6: 523² = 452013 in 0.001s Base 7: 1431² = 2450361 in 0.001s Base 8: 3344² = 13675420 in 0.001s Base 9: 11642² = 136802574 in 0.002s Base 10: 32043² = 1026753849 in 0.002s Base 11: 111453² = 1240a536789 in 0.004s Base 12: 3966b9² = 124a7b538609 in 0.016s Base 13: 3828943² = 10254773ca86b9 in 0.030s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.032s Base 15: 1012b857² = 102597bace836d4 in 0.038s Base 16: 404a9d9b² = 1025648cfea37bd9 in 0.052s Base 17: 423f82ga9² = 101246a89cgfb357ed in 0.369s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 0.421s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 0.576s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 19.270s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 20.375s Base 22: 4f94788gj0f² = 102369fbgdej48chi7lka5 in 68.070s Base 23: 1011d3el56mc² = 10234acedkg9hm8fbjil756 in 99.202s Base 24: 4lj0hdgf0hd3² = 102345b87hfeckjnigmdla69 in 106.909s Base 25: 1011e145fhghm² = 102345doeckj6gfb8liam7nh9 in 249.813s Base 26: 52k8n53bdm99k² = 1023458lo6iemkg79fpchnjdba in 999.026s Base 27: 1011f11e37objj² = 1023458elomdhbijfgkp7cq9n6a in 1880.265s Base 28: 58a3ckp3n4cqd7² = 1023456cgjbirqedhp98kmoan7fl in 3564.072s
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
Try it online!
The runtime is on my PC ( AMD Ryzen 5 1600 ) about 93 s to complete the task.
<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=8,loop=1} {$ENDIF} uses
SysUtils, gmp;// to calculate start values
const
charSet: array[0..62] of char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
type
tNumtoBase = packed record ntb_dgt: array[0..63 - 2] of Uint32; ntb_cnt, ntb_bas: Uint32; end;
tDgtRootSqr = packed record drs_List: array[0..61] of byte; drs_bas: byte; drs_Sol: byte; drs_SolCnt: byte; drs_Dgt2Add:byte; drs_NeedsOneMoreDigit: boolean; end;
var {$ALIGN 32}
Num, sqr2B, deltaNextSqr, delta: tNumtoBase;
{$ALIGN 32}
DgtRtSqr: tDgtRootSqr;
{$ALIGN 8}
T0, T1: TDateTime;
procedure OutNum(const num: tNumtoBase);
var
i: NativeInt;
begin
with num do
begin
for i := ntb_bas - ntb_cnt + 1 downto 0 do
Write(' ');
for i := ntb_cnt - 1 downto 0 do
Write(charSet[ntb_dgt[i]]);
end;
Write(' ');
end;
procedure OutNumSqr;
Begin
write(' Num ');
OutNum(Num);
writeln;
write(' sqr ');
OutNum(sqr2B);
writeln;
end;
procedure OutIndex(i: NativeUint);
var
s: string[127];
p: NativeInt;
begin
Write(#13, i div 1000000: 10, ' Mio ');
//check last digit sqr(num) mod base must be last digit of sqrnumber
if (sqr(Num.ntb_dgt[0]) mod Num.ntb_bas) <> sqr2B.ntb_dgt[0] then
begin
with Num do
begin
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);
for i := ntb_cnt - 1 downto 0 do
begin
s[p] := charSet[ntb_dgt[i]];
Inc(p);
end;
end;
writeln(s);
end;
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,j,MinAdd: 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;
//searching for 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
Begin
MinAdd := Base;
for j := 1 to drs_Sol do
for i := 1 to MinAdd do
IF drs_List[j] = (drs_Sol+i) MOD BASE then
if i < MinAdd then
MinAdd := i;
drs_Dgt2Add := MinAdd;
writeln('insert ',MinAdd);
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; var s: mpz_t);
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,dblDgt: NativeUint;
begin mpz_init(sv); mpz_init(sv_sqr);
mpz_init_set_si(sv_sqr, base);//"10" CalcDgtRootSqr(base);
if DgtRtSqr.drs_NeedsOneMoreDigit then
begin
dblDgt := DgtRtSqr.drs_Dgt2Add;
IF dblDgt= 1 then
Begin
For k := 1 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
For k := 2 to dblDgt do
Begin
mpz_mul_ui(sv_sqr, sv_sqr, base);
mpz_add_ui(sv_sqr, sv_sqr, k);
end;
For k := dblDgt to base-1 do
Begin
mpz_mul_ui(sv_sqr, sv_sqr, base);
mpz_add_ui(sv_sqr, sv_sqr, k);
end;
end
end
else
begin
For k := 2 to base-1 do
begin
mpz_mul_ui(sv_sqr, sv_sqr, base);
mpz_add_ui(sv_sqr, sv_sqr, k);
end;
end;
mpz_sqrt(sv, sv_sqr); mpz_add_ui(sv, sv, 1); mpz_mul(sv_sqr, sv, sv);
if base < 63 then
begin
conv2Num(base, Num, sv);
conv2Num(base, sqr2B, sv_sqr);
end;
Writeln(' starting value: ');
OutNumSqr;
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: NativeUInt);
//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;
base,carry, s: NativeUInt;
begin
carry := 0;
base := add1.ntb_bas;
for i := 0 to add2.ntb_cnt - 1 do
begin
s := add1.ntb_dgt[i] + add2.ntb_dgt[i] + carry;
carry := Ord(s >= base);
s := s - (-carry and base);
add1.ntb_dgt[i] := s;
end;
i := add2.ntb_cnt;
while carry = 1 do
begin
s := add1.ntb_dgt[i] + carry;
carry := Ord(s >= base);
s := s - (-carry and base);
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, TestSetComplete: Uint64;
i, j: NativeInt;
begin
Writeln('Base ',base: 3);
T0 := now;
StartValueCreate(base);
deltaNextSqr := num;
AddNum(deltaNextSqr, deltaNextSqr);
IncNum(deltaNextSqr, 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, deltaNextSqr);
IncNum(deltaNextSqr, 2);
end;
deltaCnt := (Base - 1) div DgtRtSqr.drs_SolCnt;
//j*num
deltaNextSqr := num;
for i := 2 to deltaCnt do
AddNum(deltaNextSqr, num);
AddNum(deltaNextSqr, deltaNextSqr);
IncNumBig(deltaNextSqr, deltaCnt * deltaCnt);
end;
conv_ui_num(base, 2 * deltaCnt * deltaCnt, delta);
writeln('Base ', base, ' test every ', deltaCnt);
i := 0;
TestSetComplete := Uint64(1) shl base - 1;
if deltaCnt = 1 then
begin
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 TestSetComplete = TestSet then
BREAK;
//next square number
AddNum(sqr2B, deltaNextSqr);
IncNum(deltaNextSqr, 2);
IncNum(num, 1);
Inc(i);
if i and (1 shl 23 - 1) = 0 then
OutIndex(i);
until False;
end
else
begin
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 TestSetComplete = TestSet then
BREAK;
//next square number
AddNum(sqr2B, deltaNextSqr);
AddNum(deltaNextSqr, delta);
IncNum(num, deltaCnt);
Inc(i);
if i and (1 shl 23 - 1) = 0 then
OutIndex(i);
until False;
end;
T1 := now;
Writeln(#13,(T1 - t0) * 86400: 9: 3, ' s Testcount : ', i);
OutNumSqr;
writeln;
end;
var
T: TDateTime; base : NativeUint;
begin
writeln('base n square(n) Testcnt');
T := now;
For base := 2 to 30 do
Test(base);
writeln('completed in ',(now - T) * 86400: 0: 3, ' seconds');
{$IFDEF WINDOWS}
readln;
{$ENDIF}
end.</lang>
- Output:
base n square(n) Testcnt
Base 2
starting value:
Num 10
sqr 100
Base 2 test every 1
0.000 s Testcount : 0
Num 10
sqr 100
Base 3
starting value:
Num 11
sqr 121
Base 3 test every 1
0.001 s Testcount : 4
Num 22
sqr 2101
Base 4
starting value:
Num 21
sqr 1101
Base 4 test every 3
0.001 s Testcount : 2
Num 33
sqr 3201
Base 5
insert 2
starting value:
Num 214
sqr 102411
Base 5 test every 1
0.002 s Testcount : 14
Num 243
sqr 132304
Base 6
starting value:
Num 232
sqr 103104
Base 6 test every 5
0.006 s Testcount : 20
Num 523
sqr 452013
Base 7
starting value:
Num 1012
sqr 1024144
Base 7 test every 6
0.002 s Testcount : 34
Num 1431
sqr 2450361
Base 8
starting value:
Num 2704
sqr 10237020
Base 8 test every 7
0.003 s Testcount : 41
Num 3344
sqr 13675420
Base 9
starting value:
Num 10117
sqr 102363814
Base 9 test every 4
0.002 s Testcount : 289
Num 11642
sqr 136802574
Base 10
starting value:
Num 31992
sqr 1023488064
Base 10 test every 3
0.002 s Testcount : 17
Num 32043
sqr 1026753849
Base 11
starting value:
Num 101172
sqr 10234761064
Base 11 test every 10
0.002 s Testcount : 1498
Num 111453
sqr 1240A536789
Base 12
starting value:
Num 35A924
sqr 102345A32554
Base 12 test every 11
0.005 s Testcount : 6883
Num 3966B9
sqr 124A7B538609
Base 13
insert 3
starting value:
Num 3824C73
sqr 10233460766739
Base 13 test every 1
0.003 s Testcount : 8242
Num 3828943
sqr 10254773CA86B9
Base 14
starting value:
Num 3A9774B
sqr 102345706AC8C9
Base 14 test every 13
0.002 s Testcount : 1330
Num 3A9DB7C
sqr 10269B8C57D3A4
Base 15
starting value:
Num 10119106
sqr 10234567A153C26
Base 15 test every 14
0.003 s Testcount : 4216
Num 1012B857
sqr 102597BACE836D4
Base 16
starting value:
Num 4046641A
sqr 10234567E55C52A4
Base 16 test every 15
0.002 s Testcount : 18457
Num 404A9D9B
sqr 1025648CFEA37BD9
Base 17
insert 1
starting value:
Num 423F5E486
sqr 101234567967G80FD2
Base 17 test every 1
0.011 s Testcount : 195112
Num 423F82GA9
sqr 101246A89CGFB357ED
Base 18
starting value:
Num 44B433H7D
sqr 102345678F601E1FB7
Base 18 test every 17
0.004 s Testcount : 30440
Num 44B482CAD
sqr 10236B5F8EG4AD9CH7
Base 19
starting value:
Num 1011B10785
sqr 102345678A30GF85556
Base 19 test every 6
0.007 s Testcount : 93021
Num 1011B55E9A
sqr 10234DHBG7CI8F6A9E5
Base 20
starting value:
Num 49DDBE2J9C
sqr 1023456789DHDH9DH834
Base 20 test every 19
0.538 s Testcount : 11310604
Num 49DGIH5D3G
sqr 1024E7CDI3HB695FJA8G
Base 21
insert 6
starting value:
Num 4C9HE5CC2DB
sqr 10234566789GK362F7BGIG
Base 21 test every 1
0.031 s Testcount : 601843
Num 4C9HE5FE27F
sqr 1023457DG9HI8J6B6KCEAF
Base 22
starting value:
Num 4F942523JK5
sqr 1023456789AF71694A3533
Base 22 test every 21
1.373 s Testcount : 27804949
Num 4F94788GJ0F
sqr 102369FBGDEJ48CHI7LKA5
Base 23
starting value:
Num 1011D108L541
sqr 1023456789ABD6D2675E381
Base 23 test every 22
0.837 s Testcount : 17710217
Num 1011D3EL56MC
sqr 10234ACEDKG9HM8FBJIL756
Base 24
starting value:
Num 4LJ0HD4763F4
sqr 1023456789ABE8FFN20B4E0G
Base 24 test every 23
0.226 s Testcount : 4266555
Num 4LJ0HDGF0HD3
sqr 102345B87HFECKJNIGMDLA69
Base 25
starting value:
Num 1011E109GHMMM
sqr 1023456789ABD5AHDHG370GC9
Base 25 test every 12
4.526 s Testcount : 78092125
Num 1011E145FHGHM
sqr 102345DOECKJ6GFB8LIAM7NH9
Base 26
starting value:
Num 52K8N4MNP7AMA
sqr 1023456789ABCMPE8HDDJL8P1M
Base 26 test every 5
19.679 s Testcount : 402922568
Num 52K8N53BDM99K
sqr 1023458LO6IEMKG79FPCHNJDBA
Base 27
starting value:
Num 1011F10AB5HL6J
sqr 1023456789ABCF787BM8395B5PA
Base 27 test every 26
23.782 s Testcount : 457555293
Num 1011F11E37OBJJ
sqr 1023458ELOMDHBIJFGKP7CQ9N6A
Base 28
starting value:
Num 58A3CKOHN4IK4D
sqr 1023456789ABCDIK29E6HB1R37Q1
Base 28 test every 9
41.341 s Testcount : 749593054
Num 58A3CKP3N4CQD7
sqr 1023456CGJBIRQEDHP98KMOAN7FL
Base 29
insert 2
starting value:
Num 5BAEFC5QHESPCLA
sqr 10223456789ABCDKM4JI4S470KCSHD
Base 29 test every 1
5049.550 s Testcount : 92238034003
Num 5BAEFC62RGS0KJF
sqr 102234586REOSIGJD9PCF7HBLKANQM
Base 30
starting value:
Num 5EF7R2P77FFPBMR
sqr 1023456789ABCDEPPNIG6S4MJNB8C9
Base 30 test every 29
793.685 s Testcount : 13343410738
Num 5EF7R2POS9MQRN7
sqr 1023456DMAPECBQOLSITK9FR87GHNJ
completed in 5935.721 seconds
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
5SEMXRII42NG8AKSL 102345679JIESRPA8BLCVKDNMHUFTGOQWX
28900.032 s Testcount : 205094427126
base 35 test every 34
1011J10DEFW1QTVBXR 102345678RUEPV9KGQIWFOBAXCNSLDMYJHT
48673.607 s Testcount : 614575698110
base 36 stopped after 3.3e12 tests ..
Base 38 test every 37
66FVHSMH0P60WK173YQ 1023456789DRTAINWaFJCHLYMQPGEBZVOKXSbU
114611.561 s Testcount : 1,242,398,966,051
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
Visual Basic .NET
This isn't as fast as the Go or Pascal versions. They use an array of integers to represent the square, as it's more efficient to increment and check that way.
This Visual Basic .NET version uses BigInteger variables for computation. It's quick enough for up to base19, tho.
I translated the Pascal algorithm (which utilized the array of integers) to vb.net, but it's only 50% faster than this version. This can only get to Base20 in under a minute on Try It Online!
<lang vbnet>Imports System.Numerics
Module Program
Dim base, bm1 As Byte, hs As New HashSet(Of Byte), st0 As DateTime Dim chars As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|"
Function toStr(ByVal b As BigInteger) As String
toStr = "" : Dim re As BigInteger : While b > 0
b = BigInteger.DivRem(b, base, re) : toStr = chars(CByte(re)) & toStr : End While
End Function
Function allIn(ByVal b As BigInteger) As Boolean
Dim re As BigInteger : hs.Clear() : While b > 0 : b = BigInteger.DivRem(b, base, re)
hs.Add(CByte(re)) : End While : Return hs.Count = base
End Function
' quicker, but must not have extra digit present
Function allInQ(ByVal b As BigInteger) As Boolean
Dim re As BigInteger, c As Integer = 0 : hs.Clear() : While b > 0
b = BigInteger.DivRem(b, base, re) : hs.Add(CByte(re)) : c += 1
If c <> hs.Count Then Return False
End While : Return True
End Function
Function to10(s As String) As BigInteger
to10 = 0 : For Each i As Char In s : to10 = to10 * base + chars.IndexOf(i) : Next
End Function
Function promote(s As String, n As Integer, d As Integer) As String
Dim i As Integer = s.IndexOf(chars(n)), c As Char = s(i)
Return s.Remove(i, 1).Insert(d, c)
End Function
Function fixup(n As Integer) As String
fixup = chars.Substring(0, base)
If n > 0 Then fixup = fixup.Replace((n - 1).ToString, (n - 1).ToString & n.ToString)
return "10" & fixup.Substring(2)
End Function
Function IntSqRoot(v As BigInteger) As BigInteger
Dim digs As Integer = Math.Max(0, v.ToString().Length \ 2 - 1)
IntSqRoot = New Biginteger(Math.Sqrt(CDbl(v))) : Dim term As BigInteger
Do : term = v / IntSqRoot : If BigInteger.Abs(term - IntSqRoot) < 2 Then Exit Do
IntSqRoot = (IntSqRoot + term) / 2 : Loop Until False
End Function
Sub doOne()
bm1 = base - 1 : Dim drs As Byte = 0 : If (base And 1) = 1 Then drs = base >> 1
Dim id As Integer = 0, inc As Integer = 1, i As Long = 0, st As DateTime = DateTime.Now
Dim sdr(bm1 - 1) As Byte, rc As Byte = 0 : For i = 0 To bm1 - 1 : sdr(i) = (i * i) Mod bm1
rc += If(sdr(i) = drs, 1, 0) : Next : i = 0 : If drs > 0 Then
id = base : For i = 1 To drs : If sdr(i) >= drs Then If id > sdr(i) Then id = sdr(i)
Next : id -= drs : i = 0 : End If
Dim sq As BigInteger = to10(fixup(id)), rt As BigInteger = IntSqRoot(sq) + 0,
dn As BigInteger = (rt << 1) + 1, d As BigInteger = 1
sq = rt * rt
If base > 3 AndAlso rc > 0 Then
While sq Mod bm1 <> drs : rt += 1 : sq += dn : dn += 2 : End While ' alligns sq to dr
inc = bm1 \ rc : If inc > 1 Then dn += rt * (inc - 2) - 1 : d = inc * inc
dn += dn + d
End If : d <<= 1 : If base > 5 AndAlso rc > 0 Then
Do : If allInQ(sq) Then Exit Do
sq += dn : dn += d : i += 1 : Loop Until False : Else : Do : If allIn(sq) Then Exit Do
sq += dn : dn += d : i += 1 : Loop Until False
End If : rt += i * inc : Console.WriteLine(
"{0,3} {1,2} {2,20} -> {3,-38} {4,10} {5,8:0.0000}s {6,8:0.0000}s",
base, inc, toStr(rt), toStr(sq), i, (DateTime.Now - st).TotalSeconds, (DateTime.Now - st0).TotalSeconds)
End Sub
Sub Main(args As String())
st0 = DateTime.Now
Console.WriteLine(
"base inc root square test count time total")
For base = 2 To 21 : doOne() : Next
Console.WriteLine("Elasped time was {0,8:0.00} minutes", (DateTime.Now - st0).TotalMinutes)
End Sub
End Module </lang>
- Output:
This output is on a somewhat modern PC. For comparison, it takes TIO.run around 30 seconds to reach base20, so TIO.run is around 2 1/2 times slower.
base inc root square test count time total 2 1 10 -> 100 1 0.0060s 0.0130s 3 1 22 -> 2101 5 0.0000s 0.0130s 4 3 33 -> 3201 2 0.0010s 0.0140s 5 1 243 -> 132304 15 0.0000s 0.0140s 6 5 523 -> 452013 20 0.0010s 0.0150s 7 6 1431 -> 2450361 35 0.0000s 0.0150s 8 7 3344 -> 13675420 41 0.0000s 0.0150s 9 4 11642 -> 136802574 289 0.0000s 0.0150s 10 3 32043 -> 1026753849 17 0.0000s 0.0150s 11 10 111453 -> 1240A536789 1498 0.0010s 0.0160s 12 11 3966B9 -> 124A7B538609 6883 0.0050s 0.0209s 13 1 3828943 -> 10254773CA86B9 8243 0.0120s 0.0329s 14 13 3A9DB7C -> 10269B8C57D3A4 1330 0.0010s 0.0339s 15 14 1012B857 -> 102597BACE836D4 4216 0.0040s 0.0379s 16 15 404A9D9B -> 1025648CFEA37BD9 18457 0.0170s 0.0549s 17 1 423F82GA9 -> 101246A89CGFB357ED 195113 0.4039s 0.4588s 18 17 44B482CAD -> 10236B5F8EG4AD9CH7 30440 0.0309s 0.4897s 19 6 1011B55E9A -> 10234DHBG7CI8F6A9E5 93021 0.0967s 0.5864s 20 19 49DGIH5D3G -> 1024E7CDI3HB695FJA8G 11310604 12.1056s 12.6920s 21 1 4C9HE5FE27F -> 1023457DG9HI8J6B6KCEAF 601844 1.6276s 14.3208s 22 21 4F94788GJ0F -> 102369FBGDEJ48CHI7LKA5 27804949 30.8136s 45.1343s 23 22 1011D3EL56MC -> 10234ACEDKG9HM8FBJIL756 17710217 20.5520s 65.6874s 24 23 4LJ0HDGF0HD3 -> 102345B87HFECKJNIGMDLA69 4266555 5.0096s 70.6970s 25 12 1011E145FHGHM -> 102345DOECKJ6GFB8LIAM7NH9 78092125 97.4054s 168.1024s 26 5 52K8N53BDM99K -> 1023458LO6IEMKG79FPCHNJDBA 402922569 510.6898s 678.7922s 27 26 1011F11E37OBJJ -> 1023458ELOMDHBIJFGKP7CQ9N6A 457555293 594.2456s 1273.0378s 28 9 58A3CKP3N4CQD7 -> 1023456CGJBIRQEDHP98KMOAN7FL 749593055 1015.4334s 2288.4714s Elasped time was 38.14 minutes
I'll update this once I complete the calculations for base29.
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