First perfect square in base N with N unique digits

From Rosetta Code
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)


See also
related task

Casting out nines

C++[edit]

Translation of: C#

A stripped down version of the C#, using unsigned longs instead of BigIntegers, and shifted bits instead of a HashSet accumulator.

#include <string>
#include <iostream>
#include <cstdlib>
#include <math.h>
#include <chrono>
#include <iomanip>
 
using namespace std;
 
const int maxBase = 16; // maximum base tabulated
int base, bmo, tc; // globals: base, base minus one, test count
const string chars = "0123456789ABCDEF"; // characters to use for the different bases
unsigned long long full; // for allIn() testing
 
// converts base 10 to string representation of the current base
string toStr(const unsigned long long ull) {
unsigned long long u = ull; string res = ""; while (u > 0) {
lldiv_t result1 = lldiv(u, base); res = chars[(int)result1.rem] + res;
u = (unsigned long long)result1.quot;
} return res;
}
 
// converts string to base 10
unsigned long long to10(string s) {
unsigned long long res = 0; for (char i : s) res = res * base + chars.find(i); return res;
}
 
// determines whether all characters are present
bool allIn(const unsigned long long ull) {
unsigned long long u, found; u = ull; found = 0; while (u > 0) {
lldiv_t result1 = lldiv(u, base); found |= (unsigned long long)1 << result1.rem;
u = result1.quot;
} return found == full;
}
 
// returns the minimum value string, optionally inserting extra digit
string fixup(int n) {
string res = chars.substr(0, base); if (n > 0) res = res.insert(n, chars.substr(n, 1));
return "10" + res.substr(2);
}
 
// perform the calculations for one base
void doOne() {
bmo = base - 1; tc = 0; unsigned long long sq, rt, dn, d;
int id = 0, dr = (base & 1) == 1 ? base >> 1 : 0, inc = 1, sdr[maxBase] = { 0 };
full = ((unsigned long long)1 << base) - 1;
int rc = 0; for (int i = 0; i < bmo; i++) {
sdr[i] = (i * i) % bmo; if (sdr[i] == dr) rc++; if (sdr[i] == 0) sdr[i] += bmo;
}
if (dr > 0) {
id = base; for (int i = 1; i <= dr; i++)
if (sdr[i] >= dr) if (id > sdr[i]) id = sdr[i]; id -= dr;
}
sq = to10(fixup(id)); rt = (unsigned long long)sqrt(sq) + 1; sq = rt * rt;
dn = (rt << 1) + 1; d = 1; if (base > 3 && rc > 0) {
while (sq % bmo != dr) { rt += 1; sq += dn; dn += 2; } // alligns sq to dr
inc = bmo / rc; if (inc > 1) { dn += rt * (inc - 2) - 1; d = inc * inc; }
dn += dn + d;
} d <<= 1;
do { if (allIn(sq)) break; sq += dn; dn += d; tc++; } while (true);
rt += tc * inc;
cout << setw(4) << base << setw(3) << inc << " " << setw(2)
<< (id > 0 ? chars.substr(id, 1) : " ") << setw(10) << toStr(rt) << " "
<< setw(20) << left << toStr(sq) << right << setw(12) << tc << endl;
}
 
int main() {
cout << "base inc id root sqr test count" << endl;
auto st = chrono::system_clock::now();
for (base = 2; base <= maxBase; base++) doOne();
chrono::duration<double> et = chrono::system_clock::now() - st;
cout << "\nComputation time was " << et.count() * 1000 << " milliseconds" << endl;
return 0;
}
Output:
base inc id      root  sqr                   test count
   2  1            10  100                            0
   3  1            22  2101                           4
   4  3            33  3201                           2
   5  1   2       243  132304                        14
   6  5           523  452013                        20
   7  6          1431  2450361                       34
   8  7          3344  13675420                      41
   9  4         11642  136802574                    289
  10  3         32043  1026753849                    17
  11 10        111453  1240A536789                 1498
  12 11        3966B9  124A7B538609                6883
  13  1   3   3828943  10254773CA86B9              8242
  14 13       3A9DB7C  10269B8C57D3A4              1330
  15 14      1012B857  102597BACE836D4             4216
  16 15      404A9D9B  1025648CFEA37BD9           18457

Computation time was 25.9016 milliseconds

C#[edit]

Translation of: Visual Basic .NET

Based on the Visual Basic .NET version, plus it shortcuts some of the allIn() checks. When the numbers checked are below a threshold, not every digit needs to be checked, saving a little time.

using System;
using System.Collections.Generic;
using System.Numerics;
 
static class Program
{
static byte Base, bmo, blim, ic; static DateTime st0; static BigInteger bllim, threshold;
static HashSet<byte> hs = new HashSet<byte>(), o = new HashSet<byte>();
static string chars = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|";
static List<BigInteger> limits;
static string ms;
 
// convert BigInteger to string using current base
static string toStr(BigInteger b) {
string res = ""; BigInteger re; while (b > 0) {
b = BigInteger.DivRem(b, Base, out re); res = chars[(byte)re] + res;
} return res;
}
 
// check for a portion of digits, bailing if uneven
static bool allInQS(BigInteger b) {
BigInteger re; int c = ic; hs.Clear(); hs.UnionWith(o); while (b > bllim) {
b = BigInteger.DivRem(b, Base, out re);
hs.Add((byte)re); c += 1; if (c > hs.Count) return false;
} return true;
}
 
// check for a portion of digits, all the way to the end
static bool allInS(BigInteger b) {
BigInteger re; hs.Clear(); hs.UnionWith(o); while (b > bllim) {
b = BigInteger.DivRem(b, Base, out re); hs.Add((byte)re);
} return hs.Count == Base;
}
 
// check for all digits, bailing if uneven
static bool allInQ(BigInteger b) {
BigInteger re; int c = 0; hs.Clear(); while (b > 0) {
b = BigInteger.DivRem(b, Base, out re);
hs.Add((byte)re); c += 1; if (c > hs.Count) return false;
} return true;
}
 
// check for all digits, all the way to the end
static bool allIn(BigInteger b) {
BigInteger re; hs.Clear(); while (b > 0) {
b = BigInteger.DivRem(b, Base, out re); hs.Add((byte)re);
} return hs.Count == Base;
}
 
// parse a string into a BigInteger, using current base
static BigInteger to10(string s) {
BigInteger res = 0; foreach (char i in s) res = res * Base + chars.IndexOf(i);
return res;
}
 
// returns the minimum value string, optionally inserting extra digit
static string fixup(int n) {
string res = chars.Substring(0, Base); if (n > 0) res = res.Insert(n, n.ToString());
return "10" + res.Substring(2);
}
 
// checks the square against the threshold, advances various limits when needed
static void check(BigInteger sq) {
if (sq > threshold) {
o.Remove((byte)chars.IndexOf(ms[blim])); blim -= 1; ic -= 1;
threshold = limits[bmo - blim - 1]; bllim = to10(ms.Substring(0, blim + 1));
}
}
 
// performs all the caclulations for the current base
static void doOne() {
limits = new List<BigInteger>();
bmo = (byte)(Base - 1); byte dr = 0; if ((Base & 1) == 1) dr = (byte)(Base >> 1);
o.Clear(); blim = 0;
byte id = 0; int inc = 1; long i = 0; DateTime st = DateTime.Now; if (Base == 2) st0 = st;
byte[] sdr = new byte[bmo]; byte rc = 0; for (i = 0; i < bmo; i++) {
sdr[i] = (byte)((i * i) % bmo); rc += sdr[i] == dr ? (byte)1 : (byte)0;
sdr[i] += sdr[i] == 0 ? bmo : (byte)0;
} i = 0; if (dr > 0) {
id = Base;
for (i = 1; i <= dr; i++) if (sdr[i] >= dr) if (id > sdr[i]) id = sdr[i]; id -= dr;
i = 0;
} ms = fixup(id);
BigInteger sq = to10(ms); BigInteger rt = new BigInteger(Math.Sqrt((double)sq) + 1);
sq = rt * rt; if (Base > 9) {
for (int j = 1; j < Base; j++)
limits.Add(to10(ms.Substring(0, j) + new string(chars[bmo], Base - j + (rc > 0 ? 0 : 1))));
limits.Reverse(); while (sq < limits[0]) { rt++; sq = rt * rt; }
}
BigInteger dn = (rt << 1) + 1; BigInteger d = 1; if (Base > 3 && rc > 0) {
while (sq % bmo != dr) { rt += 1; sq += dn; dn += 2; } // alligns sq to dr
inc = bmo / rc;
if (inc > 1) { dn += rt * (inc - 2) - 1; d = inc * inc; }
dn += dn + d;
}
d <<= 1; if (Base > 9) {
blim = 0; while (sq < limits[bmo - blim - 1]) blim++; ic = (byte)(blim + 1);
threshold = limits[bmo - blim - 1];
if (blim > 0) for (byte j = 0; j <= blim; j++) o.Add((byte)chars.IndexOf(ms[j]));
if (blim > 0) bllim = to10(ms.Substring(0, blim + 1)); else bllim = 0;
if (Base > 5 && rc > 0)
do { if (allInQS(sq)) break; sq += dn; dn += d; i += 1; check(sq); } while (true);
else
do { if (allInS(sq)) break; sq += dn; dn += d; i += 1; check(sq); } while (true);
} else {
if (Base > 5 && rc > 0)
do { if (allInQ(sq)) break; sq += dn; dn += d; i += 1; } while (true);
else
do { if (allIn(sq)) break; sq += dn; dn += d; i += 1; } while (true);
} rt += i * inc;
Console.WriteLine("{0,3} {1,2} {2,2} {3,20} -> {4,-40} {5,10} {6,9:0.0000}s {7,9:0.0000}s",
Base, inc, (id > 0 ? chars.Substring(id, 1) : " "), toStr(rt), toStr(sq), i,
(DateTime.Now - st).TotalSeconds, (DateTime.Now - st0).TotalSeconds);
}
 
static void Main(string[] args) {
Console.WriteLine("base inc id root square" +
" test count time total");
for (Base = 2; Base <= 28; Base++) doOne();
Console.WriteLine("Elasped time was {0,8:0.00} minutes", (DateTime.Now - st0).TotalMinutes);
}
}
Output:
base inc id                 root    square                                   test count    time        total
  2   1                       10 -> 100                                               0    0.0050s     0.0050s
  3   1                       22 -> 2101                                              4    0.0000s     0.0050s
  4   3                       33 -> 3201                                              2    0.0010s     0.0060s
  5   1   2                  243 -> 132304                                           14    0.0000s     0.0060s
  6   5                      523 -> 452013                                           20    0.0000s     0.0060s
  7   6                     1431 -> 2450361                                          34    0.0000s     0.0060s
  8   7                     3344 -> 13675420                                         41    0.0000s     0.0060s
  9   4                    11642 -> 136802574                                       289    0.0010s     0.0070s
 10   3                    32043 -> 1026753849                                       17    0.0050s     0.0120s
 11  10                   111453 -> 1240A536789                                    1498    0.0010s     0.0130s
 12  11                   3966B9 -> 124A7B538609                                   6883    0.0040s     0.0170s
 13   1   3              3828943 -> 10254773CA86B9                                 8242    0.0439s     0.0609s
 14  13                  3A9DB7C -> 10269B8C57D3A4                                 1330    0.0010s     0.0619s
 15  14                 1012B857 -> 102597BACE836D4                                4216    0.0020s     0.0638s
 16  15                 404A9D9B -> 1025648CFEA37BD9                              18457    0.0100s     0.0738s
 17   1   1            423F82GA9 -> 101246A89CGFB357ED                           195112    0.2783s     0.3521s
 18  17                44B482CAD -> 10236B5F8EG4AD9CH7                            30440    0.0199s     0.3720s
 19   6               1011B55E9A -> 10234DHBG7CI8F6A9E5                           93021    0.0589s     0.4309s
 20  19               49DGIH5D3G -> 1024E7CDI3HB695FJA8G                       11310604    6.9833s     7.4142s
 21   1   6          4C9HE5FE27F -> 1023457DG9HI8J6B6KCEAF                       601843    1.0871s     8.5013s
 22  21              4F94788GJ0F -> 102369FBGDEJ48CHI7LKA5                     27804949   18.3290s    26.8302s
 23  22             1011D3EL56MC -> 10234ACEDKG9HM8FBJIL756                    17710217   11.4105s    38.2407s
 24  23             4LJ0HDGF0HD3 -> 102345B87HFECKJNIGMDLA69                    4266555    2.4763s    40.7171s
 25  12            1011E145FHGHM -> 102345DOECKJ6GFB8LIAM7NH9                  78092124   52.6831s    93.4012s
 26   5            52K8N53BDM99K -> 1023458LO6IEMKG79FPCHNJDBA                402922568  287.9058s   381.3080s
 27  26           1011F11E37OBJJ -> 1023458ELOMDHBIJFGKP7CQ9N6A               457555293  326.1714s   707.4794s
 28   9           58A3CKP3N4CQD7 -> 1023456CGJBIRQEDHP98KMOAN7FL              749592976  508.4498s  1215.9292s
Elasped time was    20.27 minutes

F#[edit]

The Task[edit]

 
// 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))
 
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[edit]

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.

 
// 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|]
 

Go[edit]

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.

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
}
}
}
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:

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)
}
}
}
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[edit]

Translation of: Python
(() => {
'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();
})();
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[edit]

Runs in about 4 seconds with using occursin().

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
 
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[edit]

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!

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.
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[edit]

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 3 2200G Win 10 1903 .

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,Peephole,regvar,CSE,ASMCSE}
{$ENDIF}
uses
SysUtils,
gmp;// to calculate start values
 
const
{$ALIGN 32}
cOr_Mask : array[0..63] of Uint64 =
(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,
32768,65536,131072,262144,524288,1048576,2097152,4194304,
8388608,16777216,33554432,67108864,134217728,268435456,
536870912,1073741824,2147483648,4294967296,8589934592,
17179869184,34359738368,68719476736,137438953472,
274877906944,549755813888,1099511627776,2199023255552,
4398046511104,8796093022208,17592186044416,35184372088832,
70368744177664,140737488355328,281474976710656,
562949953421312,1125899906842624,2251799813685248,
4503599627370496,9007199254740992,18014398509481984,
36028797018963968,72057594037927936,144115188075855872,
288230376151711744,576460752303423488,1152921504606846976,
2305843009213693952,4611686018427387904,9223372036854775808);
 
 
charSet: array[0..62] of char =
'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
type
tRegion1 = 0..63-2*SizeOf(Uint32);
tNumtoBase = packed record
ntb_dgt: array[tRegion1] of byte;
ntb_cnt,
ntb_bas: Uint32;
end;
tRegion = 0..63;
tSolSet = set of tRegion;
tDgtRootSqr = packed record
drs_List: array[tRegion] of byte;
drs_SetOfSol:tSolSet;
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_cnt - 1 downto 0 do
Write(charSet[ntb_dgt[i]]);
end;
Write(' ');
end;
procedure OutNumSqr;
Begin
write(' Num ');
OutNum(Num);
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
ChkSet : array[tRegion] of tSolSet;
ChkCnt : array[tRegion] of byte;
i,j: NativeUInt;
PTest : tSolSet;
begin
For i := low(ChkCnt) to High(ChkCnt) do
Begin
ChkCnt[i] := 0;
ChkSet[i] := [];
end;
ptest := [];
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
Begin
include(ptest,i);
Inc(drs_SolCnt);
end;
//if not found then NeedsOneMoreDigit
drs_NeedsOneMoreDigit := drs_SolCnt = 0;
IF drs_NeedsOneMoreDigit then
Begin
for j := 1 to Base do
for i := 0 to Base do
IF drs_List[j] = (drs_Sol+i) MOD BASE then
Begin
include(ptest,i);
include(ChkSet[i],j);
inc(ChkCnt[i]);
end;
i := 1;
repeat
If i in pTest then
Begin
drs_Dgt2Add := i;
BREAK;
end;
inc(i);
until i > base;
writeln('insert ',i);
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
tmp: mpz_t;
i: NativeUInt;
begin
mpz_init_set(tmp,s);
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;
mpz_clear(tmp);
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);
 
conv2Num(base, Num, sv);
conv2Num(base, sqr2B, sv_sqr);
 
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,s,carry: 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;
function TestRun1(base:NativeInt):NativeInt;
var
pMask : pUint64;
pSqrNum,pdeltaNextSqr : ^tNumtoBase;
TestSet,TestSetComplete: Uint64;
j: NativeInt;
begin
TestSetComplete := Uint64(1) shl base - 1;
result := 0;
pSqrNum := @sqr2B;
pdeltaNextSqr := @deltaNextSqr;
pMask := @cOr_Mask;
repeat
//next square number
AddNum(pSqrNum^, pdeltaNextSqr^);
IncNum(pdeltaNextSqr^, 2);
//check used digits
TestSet := 0;
for j := 0 to pSqrNum^.ntb_cnt - 1 do
TestSet := pMask[pSqrNum^.ntb_dgt[j]] or TestSet;
Inc(result);
until TestSetComplete = TestSet;
end;
 
function TestRun(base:NativeInt):NativeInt;
var
pMask : pUint64;
pSqrNum,pdeltaNextSqr : ^tNumtoBase;
TestSet,TestSetComplete: Uint64;
j: NativeInt;
begin
TestSetComplete := Uint64(1) shl base - 1;
result := 0;
pSqrNum := @sqr2B;
pdeltaNextSqr := @deltaNextSqr;
pMask := @cOr_Mask;
repeat
//next square number
AddNum(pSqrNum^, pdeltaNextSqr^);
AddNum(pdeltaNextSqr^, delta);
//check used digits
TestSet := 0;
for j := 0 to pSqrNum^.ntb_cnt - 1 do
TestSet := pMask[pSqrNum^.ntb_dgt[j]] or TestSet;
Inc(result);
until TestSetComplete = TestSet;
end;
 
procedure Test(base:NativeInt);
var
deltaCnt, TestSet,MyOne, TestSetComplete: Uint64;
i, j: NativeInt;
begin
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;
IF deltaCnt*DgtRtSqr.drs_SolCnt = (Base-1) then
Begin
//j*num
deltaNextSqr := num;
for i := 2 to deltaCnt do
AddNum(deltaNextSqr, num);
AddNum(deltaNextSqr, deltaNextSqr);
IncNumBig(deltaNextSqr, deltaCnt * deltaCnt);
end
else
deltaCnt := 1;
end;
conv_ui_num(base, 2 * deltaCnt * deltaCnt, delta);
 
writeln('Base ', base, ' test every ', deltaCnt);
Write('Start  :');OutNumSqr;
i := 0;
MyOne := 1;
TestSetComplete := MyOne shl base - 1;
//count used digits
TestSet := 0;
for j := sqr2B.ntb_cnt - 1 downto 0 do
TestSet := TestSet or (MyOne shl sqr2B.ntb_dgt[j]);
if TestSetComplete <> TestSet then
Begin
if deltaCnt = 1 then
i := TestRun1(base)
else
i := TestRun(base);
 
IncNumBig(num,i*deltaCnt);
end;
T1 := now;
Write('Result :');OutNumSqr;
Writeln(#13,(T1 - t0) * 86400: 9: 3, ' s Testcount : ', i);
end;
 
var
T: TDateTime;
base : NativeUint;
begin
T:= now;
For base := 2 to 28 do
Test(base);
writeln('completed in ',(now - T) * 86400: 0: 3, ' seconds');
{$IFDEF WINDOWS}
readln;
{$ENDIF}
end.
Output:
Base 2 test every 1
Start  : Num 10  sqr 100
Result : Num 10  sqr 100
    0.001 s Testcount : 0
Base 3 test every 1
Start  : Num 11  sqr 121
Result : Num 22  sqr 2101
    0.000 s Testcount : 4
Base 4 test every 3
Start  : Num 21  sqr 1101
Result : Num 33  sqr 3201
    0.000 s Testcount : 2
insert 2
Base 5 test every 1
Start  : Num 214  sqr 102411
Result : Num 243  sqr 132304
    0.000 s Testcount : 14
Base 6 test every 5
Start  : Num 235  sqr 105441
Result : Num 523  sqr 452013
    0.000 s Testcount : 20
Base 7 test every 6
Start  : Num 1020  sqr 1040400
Result : Num 1431  sqr 2450361
    0.001 s Testcount : 34
Base 8 test every 7
Start  : Num 2705  sqr 10244631
Result : Num 3344  sqr 13675420
    0.000 s Testcount : 41
Base 9 test every 4
Start  : Num 10117  sqr 102363814
Result : Num 11642  sqr 136802574
    0.002 s Testcount : 289
Base 10 test every 3
Start  : Num 31992  sqr 1023488064
Result : Num 32043  sqr 1026753849
    0.001 s Testcount : 17
Base 11 test every 10
Start  : Num 101175  sqr 10235267A63
Result : Num 111453  sqr 1240A536789
    0.002 s Testcount : 1498
Base 12 test every 11
Start  : Num 35A924  sqr 102345A32554
Result : Num 3966B9  sqr 124A7B538609
    0.002 s Testcount : 6883
insert 3
Base 13 test every 1
Start  : Num 3824C73  sqr 10233460766739
Result : Num 3828943  sqr 10254773CA86B9
    0.002 s Testcount : 8242
Base 14 test every 13
Start  : Num 3A9774C  sqr 1023457801D984
Result : Num 3A9DB7C  sqr 10269B8C57D3A4
    0.001 s Testcount : 1330
Base 15 test every 14
Start  : Num 10119108  sqr 1023456BA5BA144
Result : Num 1012B857  sqr 102597BACE836D4
    0.001 s Testcount : 4216
Base 16 test every 15
Start  : Num 40466424  sqr 1023456CEADC2510
Result : Num 404A9D9B  sqr 1025648CFEA37BD9
    0.001 s Testcount : 18457
insert 1
Base 17 test every 1
Start  : Num 423F5E486  sqr 101234567967G80FD2
Result : Num 423F82GA9  sqr 101246A89CGFB357ED
    0.007 s Testcount : 195112
Base 18 test every 17
Start  : Num 44B433H7F  sqr 102345679E6908HD69
Result : Num 44B482CAD  sqr 10236B5F8EG4AD9CH7
    0.002 s Testcount : 30440
Base 19 test every 6
Start  : Num 1011B10789  sqr 102345678I39A8G87F5
Result : Num 1011B55E9A  sqr 10234DHBG7CI8F6A9E5
    0.004 s Testcount : 93021
Base 20 test every 19
Start  : Num 49DDBE2JA0  sqr 102345678D5CCEH05000
Result : Num 49DGIH5D3G  sqr 1024E7CDI3HB695FJA8G
    0.365 s Testcount : 11310604
insert 6
Base 21 test every 1
Start  : Num 4C9HE5CC2DB  sqr 10234566789GK362F7BGIG
Result : Num 4C9HE5FE27F  sqr 1023457DG9HI8J6B6KCEAF
    0.023 s Testcount : 601843
Base 22 test every 21
Start  : Num 4F942523JL0  sqr 1023456789HL35DJ1I4100
Result : Num 4F94788GJ0F  sqr 102369FBGDEJ48CHI7LKA5
    0.932 s Testcount : 27804949
Base 23 test every 22
Start  : Num 1011D108L54M  sqr 1023456789C7F59L30C8ED1
Result : Num 1011D3EL56MC  sqr 10234ACEDKG9HM8FBJIL756
    0.579 s Testcount : 17710217
Base 24 test every 23
Start  : Num 4LJ0HD4763F6  sqr 1023456789AC9NJIL6HG54DC
Result : Num 4LJ0HDGF0HD3  sqr 102345B87HFECKJNIGMDLA69
    0.156 s Testcount : 4266555
Base 25 test every 12
Start  : Num 1011E109GHMMM  sqr 1023456789ABD5AHDHG370GC9
Result : Num 1011E145FHGHM  sqr 102345DOECKJ6GFB8LIAM7NH9
    2.828 s Testcount : 78092125
Base 26 test every 5
Start  : Num 52K8N4MNP7AME  sqr 1023456789ABEBLL1L0F3FG7PE
Result : Num 52K8N53BDM99K  sqr 1023458LO6IEMKG79FPCHNJDBA
   13.407 s Testcount : 402922568
Base 27 test every 26
Start  : Num 1011F10AB5HL71  sqr 1023456789ABD6808CDF1LQ7AE1
Result : Num 1011F11E37OBJJ  sqr 1023458ELOMDHBIJFGKP7CQ9N6A
   16.423 s Testcount : 457555293
Base 28 test every 9
Start  : Num 58A3CKOHN4IK4L  sqr 1023456789ABCGJDO8M4JG8HMMFL
Result : Num 58A3CKP3N4CQD7  sqr 1023456CGJBIRQEDHP98KMOAN7FL
   27.674 s Testcount : 749593054
completed in 62.443 seconds
//now running one after the other, before was 29 to 38 in parallel 
insert 2
Base 29 test every 1
Start  : Num 5BAEFC5QHESPCLA  sqr 10223456789ABCDKM4JI4S470KCSHD
Result : Num 5BAEFC62RGS0KJF  sqr 102234586REOSIGJD9PCF7HBLKANQM
 4422.879 s Testcount : 92238034003
Base 30 test every 29
Start  : Num 5EF7R2P77FFPBN5  sqr 1023456789ABCDHNHROTMC0MS6RGKP
Result : Num 5EF7R2POS9MQRN7  sqr 1023456DMAPECBQOLSITK9FR87GHNJ
  557.680 s Testcount : 13343410738
Base 31 test every 30
Start  : Num 1011H10BS64GFL76  sqr 1023456789ABCDF03FNNQ29H0ULION5
Result : Num 1011H10CDMAUP44O  sqr 10234568ABQUJGCNFP7KEM9RHDLTSOI
  612.756 s Testcount : 15152895679
Base 32 test every 31
Start  : Num 5L6HID7BTGM6RUAA  sqr 1023456789ABCDEMULAP8DRPBULSA2B4
Result : Num 5L6HID7BVGE2CIEC  sqr 102345678VS9CMJDRAIOPLHNFQETBUKG
   96.512 s Testcount : 2207946558
Base 33 test every 8
Start  : Num 1011I10CLMTDCMPC6  sqr 1023456789ABCDEFRT6F1D7S9EA03JJD3
Result : Num 1011I10CLWWNS6SKS  sqr 102345678THKFAERNWJGDOSQ9BCIUVMLP
 2465.991 s Testcount : 53808573863
Base 34 test every 33
Start  : Num 5SEMXRII09S90UO7P  sqr 1023456789ABCDEFQ7HPX8WRC9L0GV31SD
Result : Num 5SEMXRII42NG8AKSL  sqr 102345679JIESRPA8BLCVKDNMHUFTGOQWX
 9379.442 s Testcount : 205094427126
Base 35 test every 34
Start  : Num 1011J10DE6M9QOAY42  sqr 1023456789ABCDEFGHSOEHTX34IF9YB1CG4
Result : Num 1011J10DEFW1QTVBXR  sqr 102345678RUEPV9KGQIWFOBAXCNSLDMYJHT
27848.391 s Testcount : 614575698110

(* no new test ;-) *)
Base 38 test every 37
           66FVHSMH0P60WK173YQ 1023456789DRTAINWaFJCHLYMQPGEBZVOKXSbU
114611.561 s Testcount : 1,242,398,966,051

Perl[edit]

Library: ntheory
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;
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:

Library: ntheory
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));
}

Perl 6[edit]

Works with: Rakudo version 2019.03

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.

Try it online!

#`[
 
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, # "
;
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[edit]

Works with: Python version 3.7
'''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()
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[edit]

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[edit]

/*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
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[edit]

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.

/*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))
output   is identical to the 1st REXX version.


Sidef[edit]

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))
}
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[edit]

This is faster than the Go version, but not as fast as the Pascal version. The Pascal version uses 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.
Imports System.Numerics
 
Module Program
Dim base, bm1 As Byte, hs As New HashSet(Of Byte), st0 As DateTime
Const chars As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|"
 
' converts base10 to string, using current base
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
 
' checks for all digits present, checks every one (use when extra digit is present)
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
 
' checks for all digits present, bailing when duplicates occur (can't use when extra digit is 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
 
' converts string to base 10, using current base
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
 
' returns minimum string representation, optionally inserting a digit
Function fixup(n As Integer) As String
fixup = chars.Substring(0, base)
If n > 0 Then fixup = fixup.Insert(n, n.ToString)
fixup = "10" & fixup.Substring(2)
End Function
 
' returns close approx.
Function IntSqRoot(v As BigInteger) As BigInteger
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
 
' tabulates one base
Sub doOne()
bm1 = base - 1 : Dim dr As Byte = 0 : If (base And 1) = 1 Then dr = 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) = dr, 1, 0) : sdr(i) += If(sdr(i) = 0, bm1, 0) : Next : i = 0
If dr > 0 Then
id = base : For i = 1 To dr : If sdr(i) >= dr Then If id > sdr(i) Then id = sdr(i)
Next : id -= dr : 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 <> dr : 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,3} {2,2} {3,20} -> {4,-38} {5,10} {6,8:0.000}s {7,8:0.000}s",
base, inc, If(id = 0, " ", id.ToString), 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 id root square" & _
" test count time total")
For base = 2 To 28 : doOne() : Next
Console.WriteLine("Elasped time was {0,8:0.00} minutes", (DateTime.Now - st0).TotalMinutes)
End Sub
End Module
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 3 times slower there.
base inc id                root    square                                 test count    time        total
  2   1                      10 -> 100                                             1    0.007s      0.057s
  3   1                      22 -> 2101                                            5    0.000s      0.057s
  4   3                      33 -> 3201                                            2    0.001s      0.058s
  5   1  2                  243 -> 132304                                         15    0.000s      0.058s
  6   5                     523 -> 452013                                         20    0.000s      0.059s
  7   6                    1431 -> 2450361                                        35    0.000s      0.059s
  8   7                    3344 -> 13675420                                       41    0.000s      0.059s
  9   4                   11642 -> 136802574                                     289    0.000s      0.059s
 10   3                   32043 -> 1026753849                                     17    0.000s      0.059s
 11  10                  111453 -> 1240A536789                                  1498    0.001s      0.060s
 12  11                  3966B9 -> 124A7B538609                                 6883    0.005s      0.065s
 13   1  3              3828943 -> 10254773CA86B9                               8243    0.013s      0.078s
 14  13                 3A9DB7C -> 10269B8C57D3A4                               1330    0.000s      0.078s
 15  14                1012B857 -> 102597BACE836D4                              4216    0.003s      0.081s
 16  15                404A9D9B -> 1025648CFEA37BD9                            18457    0.012s      0.093s
 17   1  1            423F82GA9 -> 101246A89CGFB357ED                         195113    0.341s      0.434s
 18  17               44B482CAD -> 10236B5F8EG4AD9CH7                          30440    0.022s      0.456s
 19   6              1011B55E9A -> 10234DHBG7CI8F6A9E5                         93021    0.068s      0.524s
 20  19              49DGIH5D3G -> 1024E7CDI3HB695FJA8G                     11310604    8.637s      9.162s
 21   1  6          4C9HE5FE27F -> 1023457DG9HI8J6B6KCEAF                     601844    1.181s     10.342s
 22  21             4F94788GJ0F -> 102369FBGDEJ48CHI7LKA5                   27804949   21.677s     32.020s
 23  22            1011D3EL56MC -> 10234ACEDKG9HM8FBJIL756                  17710217   14.292s     46.312s
 24  23            4LJ0HDGF0HD3 -> 102345B87HFECKJNIGMDLA69                  4266555    3.558s     49.871s
 25  12           1011E145FHGHM -> 102345DOECKJ6GFB8LIAM7NH9                78092125   69.914s    119.785s
 26   5           52K8N53BDM99K -> 1023458LO6IEMKG79FPCHNJDBA              402922569  365.929s    485.714s
 27  26          1011F11E37OBJJ -> 1023458ELOMDHBIJFGKP7CQ9N6A             457555293  420.607s    906.321s
 28   9          58A3CKP3N4CQD7 -> 1023456CGJBIRQEDHP98KMOAN7FL            749593055  711.660s   1617.981s
Elasped time was    26.97 minutes
Base29 seems to take an order of magnitude longer. I'm looking into some shortcuts.

zkl[edit]

Translation of: Julia
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
}
println("Base     Root   N");
foreach b in ([2..16])
{ println("%2d %10s  %s".fmt(b,squareSearch(b).xplode())) }
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