First perfect square in base n with n unique digits
You are encouraged to solve this task according to the task description, using any language you may know.
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
11l
L(base) 2..16
V n = Int64(Float(base) ^ ((base - 1) / 2))
L
V sq = n * n
V sqstr = String(sq, radix' base)
I sqstr.len >= base & Set(Array(sqstr)).len == base
V nstr = String(n, radix' base)
print(‘Base #2: #8^2 = #.’.format(base, nstr, sqstr))
L.break
n++
- Output:
Base 2: 10^2 = 100 Base 3: 22^2 = 2101 Base 4: 33^2 = 3201 Base 5: 243^2 = 132304 Base 6: 523^2 = 452013 Base 7: 1431^2 = 2450361 Base 8: 3344^2 = 13675420 Base 9: 11642^2 = 136802574 Base 10: 32043^2 = 1026753849 Base 11: 111453^2 = 1240A536789 Base 12: 3966B9^2 = 124A7B538609 Base 13: 3828943^2 = 10254773CA86B9 Base 14: 3A9DB7C^2 = 10269B8C57D3A4 Base 15: 1012B857^2 = 102597BACE836D4 Base 16: 404A9D9B^2 = 1025648CFEA37BD9
ALGOL 68
Assumes LONG INT is at least 64 bits as in e.g., Algol 68G
BEGIN # find the first perfect square in base n with n unique digits n=1..16 #
[ 0 : 15 ]BITS dmask; # masks for recording the digits in a BITS string #
dmask[ 0 ] := 16r1;
FOR i TO UPB dmask DO dmask[ i ] := BIN ( 2 * ABS dmask[ i - 1 ] ) OD;
# base digits #
STRING digits = "0123456789abcdefghijklmnopqrstuvwxyz";
# returns a string representation of n in base b #
# the result is balank padded on the left to at least w digits #
PROC to base = ( LONG INT n, INT b, w )STRING:
BEGIN
STRING result := "";
LONG INT v := ABS n;
WHILE v > 0 DO
digits[ SHORTEN ( v MOD b ) + 1 ] +=: result;
v OVERAB b
OD;
IF INT len = ( UPB result - LWB result ) + 1;
len < w
THEN
( ( w - len ) * " " ) + result
ELSE result
FI
END # to base # ;
BITS all digits := dmask[ 0 ];
FOR b FROM 2 TO 16 DO
all digits := all digits OR dmask[ b - 1 ];
LONG INT root := 1;
FOR i TO b - 1 DO
root *:= b
OD;
root := ENTIER long sqrt( root );
BOOL found := FALSE;
WHILE NOT found DO
LONG INT square = root * root;
LONG INT v := square;
BITS present := 16r0;
WHILE v > 0 DO
present := present OR dmask[ SHORTEN ( v MOD b ) ];
v OVERAB b
OD;
IF found := present = all digits THEN
print( ( "Base: ", whole( b, -2 )
, ":", to base( root, b, 20 ), "^2 = ", to base( square, b, 0 )
, newline
)
)
FI;
root +:= 1
OD
OD
END
- Output:
Base: 2: 10^2 = 100 Base: 3: 22^2 = 2101 Base: 4: 33^2 = 3201 Base: 5: 243^2 = 132304 Base: 6: 523^2 = 452013 Base: 7: 1431^2 = 2450361 Base: 8: 3344^2 = 13675420 Base: 9: 11642^2 = 136802574 Base: 10: 32043^2 = 1026753849 Base: 11: 111453^2 = 1240a536789 Base: 12: 3966b9^2 = 124a7b538609 Base: 13: 3828943^2 = 10254773ca86b9 Base: 14: 3a9db7c^2 = 10269b8c57d3a4 Base: 15: 1012b857^2 = 102597bace836d4 Base: 16: 404a9d9b^2 = 1025648cfea37bd9
C
#include <stdio.h>
#include <string.h>
#define BUFF_SIZE 32
void toBaseN(char buffer[], long long num, int base) {
char *ptr = buffer;
char *tmp;
// write it backwards
while (num >= 1) {
int rem = num % base;
num /= base;
*ptr++ = "0123456789ABCDEF"[rem];
}
*ptr-- = 0;
// now reverse it to be written forwards
for (tmp = buffer; tmp < ptr; tmp++, ptr--) {
char c = *tmp;
*tmp = *ptr;
*ptr = c;
}
}
int countUnique(char inBuf[]) {
char buffer[BUFF_SIZE];
int count = 0;
int pos, nxt;
strcpy_s(buffer, BUFF_SIZE, inBuf);
for (pos = 0; buffer[pos] != 0; pos++) {
if (buffer[pos] != 1) {
count++;
for (nxt = pos + 1; buffer[nxt] != 0; nxt++) {
if (buffer[nxt] == buffer[pos]) {
buffer[nxt] = 1;
}
}
}
}
return count;
}
void find(int base) {
char nBuf[BUFF_SIZE];
char sqBuf[BUFF_SIZE];
long long n, s;
for (n = 2; /*blank*/; n++) {
s = n * n;
toBaseN(sqBuf, s, base);
if (strlen(sqBuf) >= base && countUnique(sqBuf) == base) {
toBaseN(nBuf, n, base);
toBaseN(sqBuf, s, base);
//printf("Base %d : Num %lld Square %lld\n", base, n, s);
printf("Base %d : Num %8s Square %16s\n", base, nBuf, sqBuf);
break;
}
}
}
int main() {
int i;
for (i = 2; i <= 15; i++) {
find(i);
}
return 0;
}
- Output:
Base 2 : Num 10 Square 100 Base 3 : Num 22 Square 2101 Base 4 : Num 33 Square 3201 Base 5 : Num 243 Square 132304 Base 6 : Num 523 Square 452013 Base 7 : Num 1431 Square 2450361 Base 8 : Num 3344 Square 13675420 Base 9 : Num 11642 Square 136802574 Base 10 : Num 32043 Square 1026753849 Base 11 : Num 111453 Square 1240A536789 Base 12 : Num 3966B9 Square 124A7B538609 Base 13 : Num 3828943 Square 10254773CA86B9 Base 14 : Num 3A9DB7C Square 10269B8C57D3A4 Base 15 : Num 1012B857 Square 102597BACE836D4
C#
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
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
D
import std.algorithm;
import std.exception;
import std.math;
import std.stdio;
import std.string;
string toBaseN(const long num, const int base)
in (base > 1, "base cannot be less than 2")
body {
immutable ALPHABET = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
enforce(base < ALPHABET.length, "base cannot be represented");
char[] result;
long cnum = abs(num);
while (cnum > 0) {
auto rem = cast(uint) (cnum % base);
result ~= ALPHABET[rem];
cnum = (cnum - rem) / base;
}
if (num < 0) {
result ~= '-';
}
return result.reverse.idup;
}
int countUnique(string buf) {
bool[char] m;
foreach (c; buf) {
m[c] = true;
}
return m.keys.length;
}
void find(int base) {
long nmin = cast(long) pow(cast(real) base, 0.5 * (base - 1));
for (long n = nmin; /*blank*/; n++) {
auto sq = n * n;
enforce(n * n > 0, "Overflowed the square");
string sqstr = toBaseN(sq, base);
if (sqstr.length >= base && countUnique(sqstr) == base) {
string nstr = toBaseN(n, base);
writefln("Base %2d : Num %8s Square %16s", base, nstr, sqstr);
return;
}
}
}
void main() {
foreach (i; 2..17) {
find(i);
}
}
- Output:
Base 2 : Num 10 Square 100 Base 3 : Num 22 Square 2101 Base 4 : Num 33 Square 3201 Base 5 : Num 243 Square 132304 Base 6 : Num 523 Square 452013 Base 7 : Num 1431 Square 2450361 Base 8 : Num 3344 Square 13675420 Base 9 : Num 11642 Square 136802574 Base 10 : Num 32043 Square 1026753849 Base 11 : Num 111453 Square 1240A536789 Base 12 : Num 3966B9 Square 124A7B538609 Base 13 : Num 3828943 Square 10254773CA86B9 Base 14 : Num 3A9DB7C Square 10269B8C57D3A4 Base 15 : Num 1012B857 Square 102597BACE836D4 Base 16 : Num 404A9D9B Square 1025648CFEA37BD9
Delphi
function GetRadixString(L: int64; Radix: Byte): string;
{Converts integer a string of any radix}
const RadixChars: array[0..35] Of char =
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'A', 'B', 'C', 'D', 'E', 'F',
'G','H', 'I', 'J', 'K', 'L', 'M', 'N',
'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
'W', 'X', 'Y', 'Z');
var I: integer;
var S: string;
var Sign: string[1];
begin
Result:='';
If (L < 0) then
begin
Sign:='-';
L:=Abs(L);
end
else Sign:='';
S:='';
repeat
begin
I:=L mod Radix;
S:=RadixChars[I] + S;
L:=L div Radix;
end
until L = 0;
Result:=Sign + S;
end;
function HasUniqueDigits(N: int64; Base: integer): boolean;
{Keep track of unique digits with bits in a mask}
var Mask,Bit: cardinal;
var I,Cnt: integer;
begin
Cnt:=0; Mask:=0;
repeat
begin
I:=N mod Base;
Bit:=1 shl I;
if (Bit and Mask)=0 then
begin
Mask:=Mask or Bit;
Inc(Cnt);
end;
N:=N div Base;
end
until N = 0;
Result:=Cnt=Base;
end;
function GetStartValue(Base: integer): Int64;
{Start with the first N-Digit number in the base}
var I: integer;
begin
Result:=1;
for I:=1 to Base-1 do Result:=Result*Base;
Result:=Trunc(Sqrt(Result+0.0))-1;
end;
function FindFirstSquare(Base: integer): int64;
{Test squares to find the first one with unique digits}
var Start: int64;
begin
Result:=GetStartValue(Base);
while Result<=high(integer) do
begin
if HasUniqueDigits(Result*Result,Base) then break;
Inc(Result);
end;
end;
procedure ShowFirstSquares(Memo: TMemo);
{Find and display first perfect square that uses all digits in bases 2-16}
var I: integer;
var N: int64;
var S1,S2: string;
begin
for I:=2 to 16 do
begin
N:=FindFirstSquare(I);
S1:=GetRadixString(N,I);
S2:=GetRadixString(N*N,I);
Memo.Lines.Add(Format('Base=%2d %14s^2 = %16s',[I,S1,S2]));
end;
end;
- Output:
Base= 2 10^2 = 100 Base= 3 22^2 = 2101 Base= 4 33^2 = 3201 Base= 5 243^2 = 132304 Base= 6 523^2 = 452013 Base= 7 1431^2 = 2450361 Base= 8 3344^2 = 13675420 Base= 9 11642^2 = 136802574 Base=10 32043^2 = 1026753849 Base=11 111453^2 = 1240A536789 Base=12 3966B9^2 = 124A7B538609 Base=13 3828943^2 = 10254773CA86B9 Base=14 3A9DB7C^2 = 10269B8C57D3A4 Base=15 1012B857^2 = 102597BACE836D4 Base=16 404A9D9B^2 = 1025648CFEA37BD9 Run Time = 28.2 sec
EasyLang
alpha$ = "0123456789AB"
func$ itoa n b .
if n > 0
return itoa (n div b) b & substr alpha$ (n mod b + 1) 1
.
.
func unique s$ .
len dig[] 12
for c$ in strchars s$
ind = strpos alpha$ c$
dig[ind] = 1
.
for v in dig[]
cnt += v
.
return cnt
.
proc find b . .
n = floor pow b ((b - 1) div 2)
repeat
sq = n * n
sq$ = itoa sq b
until len sq$ >= b and unique sq$ = b
n += 1
.
n$ = itoa n b
print "Base " & b & ": " & n$ & "² = " & sq$
.
for base = 2 to 12
find base
.
- 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
F#
The Task
// 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
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|]
Factor
The only thing this program does to save time is start the search at a root high enough such that its square has enough digits to be pandigital.
USING: assocs formatting fry kernel math math.functions
math.parser math.ranges math.statistics sequences ;
IN: rosetta-code.A260182
: pandigital? ( n base -- ? )
[ >base histogram assoc-size ] keep >= ;
! Return the smallest decimal integer square root whose squared
! digit length in base n is at least n.
: search-start ( base -- n ) dup 1 - ^ sqrt ceiling >integer ;
: find-root ( base -- n )
[ search-start ] [ ] bi
'[ dup sq _ pandigital? ] [ 1 + ] until ;
: show-base ( base -- )
dup find-root dup sq pick [ >base ] curry bi@
"Base %2d: %8s squared = %s\n" printf ;
: main ( -- ) 2 16 [a,b] [ show-base ] each ;
MAIN: main
- Output:
Base 2: 10 squared = 100 Base 3: 22 squared = 2101 Base 4: 33 squared = 3201 Base 5: 243 squared = 132304 Base 6: 523 squared = 452013 Base 7: 1431 squared = 2450361 Base 8: 3344 squared = 13675420 Base 9: 11642 squared = 136802574 Base 10: 32043 squared = 1026753849 Base 11: 111453 squared = 1240a536789 Base 12: 3966b9 squared = 124a7b538609 Base 13: 3828943 squared = 10254773ca86b9 Base 14: 3a9db7c squared = 10269b8c57d3a4 Base 15: 1012b857 squared = 102597bace836d4 Base 16: 404a9d9b squared = 1025648cfea37bd9
Forth
#! /usr/bin/gforth-fast
: 2^ 1 swap lshift ;
: sq s" dup *" evaluate ; immediate
: min-root ( -- n ) \ minimum root that can be pandigitial
base @ s>f fdup 1e f- 0.5e f* f** f>s ;
: pandigital? ( n -- f )
0 swap \ bitmask
begin
base @ /mod
>r 2^ or r>
dup 0= until drop
base @ 2^ 1- = ;
: panroot ( -- n ) \ get the minimum square root using the variable BASE.
min-root 1- begin
1+
dup sq pandigital? until ;
: .squares ( -- )
base @ 17 2 do
i base !
i 2 dec.r 3 spaces panroot dup 8 .r ." ² = " sq . cr
loop base ! ;
.squares
bye
- Output:
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
FreeBASIC
#define floor(x) ((x*2.0-0.5) Shr 1)
Dim Shared As Double n, base_ = 2. ' Base is a reserved word on FB
Sub NumOut(n As Double) 'Display n in the specified base
Dim As Integer remainder = Fix(n Mod base_)
n = floor(n / base_)
If n <> 0. Then NumOut(n)
Print Chr(remainder + Iif(remainder <= 9, Asc("0"), Asc("A")-10));
End Sub
Function isPandigital(n As Double) As Boolean
Dim As Integer used, remainder
used = 0
While n <> 0.
remainder = Fix(n Mod base_)
n = floor(n / base_)
used Or= 1 Shl remainder
Wend
Return used = (1 Shl Fix(base_)) - 1
End Function
Do
n = floor(Sqr(base_ ^ (base_-1.)))
Do
If isPandigital(n*n) Then
Print Using "Base ##: "; base_;
NumOut(n)
Print "^2 = ";
NumOut(n*n)
Print
Exit Do
End If
n += 1.
Loop
base_ += 1.
Loop Until base_ > 14.
Sleep
- Output:
Base 2: 10^2 = 100 Base 3: 22^2 = 2101 Base 4: 33^2 = 3201 Base 5: 243^2 = 132304 Base 6: 523^2 = 452013 Base 7: 1431^2 = 2450361 Base 8: 3344^2 = 13675420 Base 9: 11642^2 = 136802574 Base 10: 32043^2 = 1026753849 Base 11: 111453^2 = 1240A536789 Base 12: 3966B9^2 = 124A7B538609 Base 13: 3828943^2 = 10254773CA86B9 Base 14: 3A9DB7C^2 = 10269B8C57D3A4
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.
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 Intel Core i7-8565U laptop using Go 1.12.9 on Ubuntu 18.04.
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.000s Base 9: 11642² = 136802574 in 0.000s Base 10: 32043² = 1026753849 in 0.000s Base 11: 111453² = 1240a536789 in 0.001s Base 12: 3966b9² = 124a7b538609 in 0.002s Base 13: 3828943² = 10254773ca86b9 in 0.004s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.005s Base 15: 1012b857² = 102597bace836d4 in 0.006s Base 16: 404a9d9b² = 1025648cfea37bd9 in 0.008s Base 17: 423f82ga9² = 101246a89cgfb357ed in 0.074s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 0.084s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 0.116s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 3.953s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 4.174s Base 22: 4f94788gj0f² = 102369fbgdej48chi7lka5 in 14.084s Base 23: 1011d3el56mc² = 10234acedkg9hm8fbjil756 in 20.563s Base 24: 4lj0hdgf0hd3² = 102345b87hfeckjnigmdla69 in 22.169s Base 25: 1011e145fhghm² = 102345doeckj6gfb8liam7nh9 in 52.082s Base 26: 52k8n53bdm99k² = 1023458lo6iemkg79fpchnjdba in 209.808s Base 27: 1011f11e37objj² = 1023458elomdhbijfgkp7cq9n6a in 401.503s
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 15% 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.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.000s Base 9: 11642² = 136802574 in 0.000s Base 10: 32043² = 1026753849 in 0.000s Base 11: 111453² = 1240a536789 in 0.001s Base 12: 3966b9² = 124a7b538609 in 0.003s Base 13: 3828943² = 10254773ca86b9 in 0.005s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.006s Base 15: 1012b857² = 102597bace836d4 in 0.007s Base 16: 404a9d9b² = 1025648cfea37bd9 in 0.010s Base 17: 423f82ga9² = 101246a89cgfb357ed in 0.088s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 0.100s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 0.138s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 4.632s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 4.894s Base 22: 4f94788gj0f² = 102369fbgdej48chi7lka5 in 16.282s Base 23: 1011d3el56mc² = 10234acedkg9hm8fbjil756 in 23.697s Base 24: 4lj0hdgf0hd3² = 102345b87hfeckjnigmdla69 in 25.525s Base 25: 1011e145fhghm² = 102345doeckj6gfb8liam7nh9 in 59.592s Base 26: 52k8n53bdm99k² = 1023458lo6iemkg79fpchnjdba in 239.850s Base 27: 1011f11e37objj² = 1023458elomdhbijfgkp7cq9n6a in 461.305s Base 28: 58a3ckp3n4cqd7² = 1023456cgjbirqedhp98kmoan7fl in 911.059s
Haskell
import Control.Monad (guard)
import Data.List (find, unfoldr)
import Data.Char (intToDigit)
import qualified Data.Set as Set
import Text.Printf (printf)
digits :: Integral a => a -> a -> [a]
digits
b = unfoldr
(((>>) . guard . (0 /=)) <*> (pure . ((,) <$> (`mod` b) <*> (`div` b))))
sequenceForBaseN :: Integral a => a -> [a]
sequenceForBaseN
b = unfoldr (\(v, n) -> Just (v, (v + n, n + 2))) (i ^ 2, i * 2 + 1)
where
i = succ (round $ sqrt (realToFrac (b ^ pred b)))
searchSequence :: Integral a => a -> Maybe a
searchSequence
b = find ((digitsSet ==) . Set.fromList . digits b) (sequenceForBaseN b)
where
digitsSet = Set.fromList [0 .. pred b]
display :: Integer -> Integer -> String
display b n = map (intToDigit . fromIntegral) $ reverse $ digits b n
main :: IO ()
main = mapM_
(\b -> case searchSequence b of
Just n -> printf
"Base %2d: %8s² -> %16s\n"
b
(display b (squareRootValue n))
(display b n)
Nothing -> pure ())
[2 .. 16]
where
squareRootValue = round . sqrt . realToFrac
- 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
J
pandigital=: [ = [: # [: ~. #.inv NB. BASE pandigital Y
assert 10 pandigital 1234567890 assert -. 10 pandigital 123456789 [BASES=: 2+i.11 2 3 4 5 6 7 8 9 10 11 12 A=: BASES pandigital&>/ *: i. 1000000 NB. A is a Boolean array marking all pandigital squares in bases 2--12 of 0--999999 squared +/"1 A NB. tally of them per base 999998 999298 976852 856925 607519 324450 114943 33757 4866 416 3 ] SOLUTION=: A (i."1) 1 NB. but we need only the first 2 8 15 73 195 561 1764 7814 32043 177565 944493 representation=: (Num_j_ , 26 }. Alpha_j_) {~ #.inv NB. BASE representation INTEGER (<;._2'base;base 10;base BASE;') , BASES ([ ; ] ; representation)&> *: SOLUTION +----+------------+------------+ |base|base 10 |base BASE | +----+------------+------------+ |2 |4 |100 | +----+------------+------------+ |3 |64 |2101 | +----+------------+------------+ |4 |225 |3201 | +----+------------+------------+ |5 |5329 |132304 | +----+------------+------------+ |6 |38025 |452013 | +----+------------+------------+ |7 |314721 |2450361 | +----+------------+------------+ |8 |3111696 |13675420 | +----+------------+------------+ |9 |61058596 |136802574 | +----+------------+------------+ |10 |1026753849 |1026753849 | +----+------------+------------+ |11 |31529329225 |1240a536789 | +----+------------+------------+ |12 |892067027049|124a7b538609| +----+------------+------------+
Java
import java.math.BigInteger;
import java.time.Duration;
import java.util.ArrayList;
import java.util.Collections;
import java.util.HashSet;
import java.util.List;
import java.util.Set;
public class Program {
static final String ALPHABET = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|";
static byte base, bmo, blim, ic;
static long st0;
static BigInteger bllim, threshold;
static Set<Byte> hs = new HashSet<>();
static Set<Byte> o = new HashSet<>();
static final char[] chars = ALPHABET.toCharArray();
static List<BigInteger> limits;
static String ms;
static int indexOf(char c) {
for (int i = 0; i < chars.length; ++i) {
if (chars[i] == c) {
return i;
}
}
return -1;
}
// convert BigInteger to string using current base
static String toStr(BigInteger b) {
BigInteger bigBase = BigInteger.valueOf(base);
StringBuilder res = new StringBuilder();
while (b.compareTo(BigInteger.ZERO) > 0) {
BigInteger[] divRem = b.divideAndRemainder(bigBase);
res.append(chars[divRem[1].intValue()]);
b = divRem[0];
}
return res.toString();
}
// check for a portion of digits, bailing if uneven
static boolean allInQS(BigInteger b) {
BigInteger bigBase = BigInteger.valueOf(base);
int c = ic;
hs.clear();
hs.addAll(o);
while (b.compareTo(bllim) > 0) {
BigInteger[] divRem = b.divideAndRemainder(bigBase);
hs.add(divRem[1].byteValue());
c++;
if (c > hs.size()) {
return false;
}
b = divRem[0];
}
return true;
}
// check for a portion of digits, all the way to the end
static boolean allInS(BigInteger b) {
BigInteger bigBase = BigInteger.valueOf(base);
hs.clear();
hs.addAll(o);
while (b.compareTo(bllim) > 0) {
BigInteger[] divRem = b.divideAndRemainder(bigBase);
hs.add(divRem[1].byteValue());
b = divRem[0];
}
return hs.size() == base;
}
// check for all digits, bailing if uneven
static boolean allInQ(BigInteger b) {
BigInteger bigBase = BigInteger.valueOf(base);
int c = 0;
hs.clear();
while (b.compareTo(BigInteger.ZERO) > 0) {
BigInteger[] divRem = b.divideAndRemainder(bigBase);
hs.add(divRem[1].byteValue());
c++;
if (c > hs.size()) {
return false;
}
b = divRem[0];
}
return true;
}
// check for all digits, all the way to the end
static boolean allIn(BigInteger b) {
BigInteger bigBase = BigInteger.valueOf(base);
hs.clear();
while (b.compareTo(BigInteger.ZERO) > 0) {
BigInteger[] divRem = b.divideAndRemainder(bigBase);
hs.add(divRem[1].byteValue());
b = divRem[0];
}
return hs.size() == base;
}
// parse a string into a BigInteger, using current base
static BigInteger to10(String s) {
BigInteger bigBase = BigInteger.valueOf(base);
BigInteger res = BigInteger.ZERO;
for (int i = 0; i < s.length(); ++i) {
char c = s.charAt(i);
int idx = indexOf(c);
BigInteger bigIdx = BigInteger.valueOf(idx);
res = res.multiply(bigBase).add(bigIdx);
}
return res;
}
// returns the minimum value string, optionally inserting extra digit
static String fixup(int n) {
String res = ALPHABET.substring(0, base);
if (n > 0) {
StringBuilder sb = new StringBuilder(res);
sb.insert(n, n);
res = sb.toString();
}
return "10" + res.substring(2);
}
// checks the square against the threshold, advances various limits when needed
static void check(BigInteger sq) {
if (sq.compareTo(threshold) > 0) {
o.remove((byte) indexOf(ms.charAt(blim)));
blim--;
ic--;
threshold = limits.get(bmo - blim - 1);
bllim = to10(ms.substring(0, blim + 1));
}
}
// performs all the calculations for the current base
static void doOne() {
limits = new ArrayList<>();
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 st = System.nanoTime();
byte[] sdr = new byte[bmo];
byte rc = 0;
for (int 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;
}
long i = 0;
if (dr > 0) {
id = base;
for (i = 1; i <= dr; i++) {
if (sdr[(int) i] >= dr) {
if (id > sdr[(int) i]) {
id = sdr[(int) i];
}
}
}
id -= dr;
i = 0;
}
ms = fixup(id);
BigInteger sq = to10(ms);
BigInteger rt = BigInteger.valueOf((long) (Math.sqrt(sq.doubleValue()) + 1));
sq = rt.multiply(rt);
if (base > 9) {
for (int j = 1; j < base; j++) {
limits.add(to10(ms.substring(0, j) + String.valueOf(chars[bmo]).repeat(base - j + (rc > 0 ? 0 : 1))));
}
Collections.reverse(limits);
while (sq.compareTo(limits.get(0)) < 0) {
rt = rt.add(BigInteger.ONE);
sq = rt.multiply(rt);
}
}
BigInteger dn = rt.shiftLeft(1).add(BigInteger.ONE);
BigInteger d = BigInteger.ONE;
if (base > 3 && rc > 0) {
while (sq.remainder(BigInteger.valueOf(bmo)).compareTo(BigInteger.valueOf(dr)) != 0) {
rt = rt.add(BigInteger.ONE);
sq = sq.add(dn);
dn = dn.add(BigInteger.TWO);
} // aligns sq to dr
inc = bmo / rc;
if (inc > 1) {
dn = dn.add(rt.multiply(BigInteger.valueOf(inc - 2)).subtract(BigInteger.ONE));
d = BigInteger.valueOf(inc * inc);
}
dn = dn.add(dn).add(d);
}
d = d.shiftLeft(1);
if (base > 9) {
blim = 0;
while (sq.compareTo(limits.get(bmo - blim - 1)) < 0) {
blim++;
}
ic = (byte) (blim + 1);
threshold = limits.get(bmo - blim - 1);
if (blim > 0) {
for (byte j = 0; j <= blim; j++) {
o.add((byte) indexOf(ms.charAt(j)));
}
}
if (blim > 0) {
bllim = to10(ms.substring(0, blim + 1));
} else {
bllim = BigInteger.ZERO;
}
if (base > 5 && rc > 0)
while (!allInQS(sq)) {
sq = sq.add(dn);
dn = dn.add(d);
i += 1;
check(sq);
}
else {
while (!allInS(sq)) {
sq = sq.add(dn);
dn = dn.add(d);
i += 1;
check(sq);
}
}
} else {
if (base > 5 && rc > 0) {
while (!allInQ(sq)) {
sq = sq.add(dn);
dn = dn.add(d);
i += 1;
}
} else {
while (!allIn(sq)) {
sq = sq.add(dn);
dn = dn.add(d);
i += 1;
}
}
}
rt = rt.add(BigInteger.valueOf(i * inc));
long delta1 = System.nanoTime() - st;
Duration dur1 = Duration.ofNanos(delta1);
long delta2 = System.nanoTime() - st0;
Duration dur2 = Duration.ofNanos(delta2);
System.out.printf(
"%3d %2d %2s %20s -> %-40s %10d %9s %9s\n",
base, inc, (id > 0 ? ALPHABET.substring(id, id + 1) : " "), toStr(rt), toStr(sq), i, format(dur1), format(dur2)
);
}
private static String format(Duration d) {
int minP = d.toMinutesPart();
int secP = d.toSecondsPart();
int milP = d.toMillisPart();
return String.format("%02d:%02d.%03d", minP, secP, milP);
}
public static void main(String[] args) {
System.out.println("base inc id root square test count time total");
st0 = System.nanoTime();
for (base = 2; base < 28; ++base) {
doOne();
}
}
}
- Output:
base inc id root square test count time total 2 1 01 -> 001 0 00:00.030 00:00.030 3 1 22 -> 1012 4 00:00.000 00:00.040 4 3 33 -> 1023 2 00:00.000 00:00.042 5 1 2 342 -> 403231 14 00:00.000 00:00.044 6 5 325 -> 310254 20 00:00.000 00:00.047 7 6 1341 -> 1630542 34 00:00.000 00:00.049 8 7 4433 -> 02457631 41 00:00.000 00:00.051 9 4 24611 -> 475208631 289 00:00.002 00:00.055 10 3 34023 -> 9483576201 17 00:00.023 00:00.080 11 10 354111 -> 987635A0421 1498 00:00.009 00:00.091 12 11 9B6693 -> 906835B7A421 6883 00:00.012 00:00.109 13 1 3 3498283 -> 9B68AC37745201 8242 00:00.053 00:00.164 14 13 C7BD9A3 -> 4A3D75C8B96201 1330 00:00.001 00:00.166 15 14 758B2101 -> 4D638ECAB795201 4216 00:00.008 00:00.175 16 15 B9D9A404 -> 9DB73AEFC8465201 18457 00:00.070 00:00.247 17 1 1 9AG28F324 -> DE753BFGC98A642101 195112 00:00.415 00:00.664 18 17 DAC284B44 -> 7HC9DA4GE8F5B63201 30440 00:00.015 00:00.680 19 6 A9E55B1101 -> 5E9A6F8IC7GBHD43201 93021 00:00.116 00:00.797 20 19 G3D5HIGD94 -> G8AJF596BH3IDC7E4201 11310604 00:06.544 00:07.342 21 1 6 F72EF5EH9C4 -> FAECK6B6J8IH9GD7543201 601843 00:01.123 00:08.467 22 21 F0JG88749F4 -> 5AKL7IHC84JEDGBF963201 27804949 00:16.134 00:24.602 23 22 CM65LE3D1101 -> 657LIJBF8MH9GKDECA43201 17710217 00:09.976 00:34.579 24 23 3DH0FGDH0JL4 -> 96ALDMGINJKCEFH78B543201 4266555 00:02.115 00:36.695 25 12 MHGHF541E1101 -> 9HN7MAIL8BFG6JKCEOD543201 78092124 00:47.584 01:24.280 26 5 K99MDB35N8K25 -> ABDJNHCPF97GKMEI6OL8543201 402922566 04:37.368 06:01.649 27 26 JJBO73E11F1101 -> A6N9QC7PKGFJIBHDMOLE8543201 457555291 05:19.215 11:20.866
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')
(id > 0 ? chars.substr(id, 1) : " ") 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
jq
Adapted from Julia
Works with jq and gojq, the C and Go implementations of jq
Some useful filters, but nothing fancy here.
With a few minor tweaks, notably replacing `sqrt` with `isqrt` (see e.g. Isqrt_(integer_square_root)_of_X#jq), the following program also works with jaq, the Rust implementation of jq.
# Input: an integral decimal number
# Output: the representation of the input in base $b as
# an array of one-character digits, with the least significant digit first.
def tobaseDigits($b):
def digit: "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"[.:.+1];
def mod: . % $b;
def div: ((. - mod) / $b);
def digits: recurse( select(. > 0) | div) | mod ;
if . == 0 then "0"
else [digits | digit][:-1]
end;
def tobase($b):
tobaseDigits($b) | reverse | add;
# Input: an alphanumeric string to be interpreted as a number in base $b
# Output: the corresponding decimal value
def frombase($b):
def decimalValue:
if 48 <= . and . <= 57 then . - 48
elif 65 <= . and . <= 90 then . - 55 # (10+.-65)
elif 97 <= . and . <= 122 then . - 87 # (10+.-97)
else "decimalValue" | error
end;
reduce (explode|reverse[]|decimalValue) as $x ({p:1};
.value += (.p * $x)
| .p *= $b)
| .value ;
def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;
# $n and $base should be decimal integers
def hasallin($n; $base):
$base == ($n | tobaseDigits($base) | unique | length);
def squaresearch($base):
def num: "0123456789abcdef";
(("10" + num[2:$base]) | frombase($base)) as $highest
| first( range( $highest|sqrt|floor; infinite) # $highest + 1
| select(hasallin(.*.; $base)) );
def task:
"Base Root N",
(range(2;16) as $b
| squaresearch($b)
| "\($b|lpad(3)) \(tobase($b)|lpad(10) ) \( .*. | tobase($b))" );
task
- 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
Julia
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
Kotlin
import java.math.BigInteger
import java.time.Duration
import java.util.ArrayList
import java.util.HashSet
import kotlin.math.sqrt
const val ALPHABET = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz|"
var base: Byte = 0
var bmo: Byte = 0
var blim: Byte = 0
var ic: Byte = 0
var st0: Long = 0
var bllim: BigInteger? = null
var threshold: BigInteger? = null
var hs: MutableSet<Byte> = HashSet()
var o: MutableSet<Byte> = HashSet()
val chars = ALPHABET.toCharArray()
var limits: MutableList<BigInteger?>? = null
var ms: String? = null
fun indexOf(c: Char): Int {
for (i in chars.indices) {
if (chars[i] == c) {
return i
}
}
return -1
}
// convert BigInteger to string using current base
fun toStr(b: BigInteger): String {
var b2 = b
val bigBase = BigInteger.valueOf(base.toLong())
val res = StringBuilder()
while (b2 > BigInteger.ZERO) {
val divRem = b2.divideAndRemainder(bigBase)
res.append(chars[divRem[1].toInt()])
b2 = divRem[0]
}
return res.toString()
}
// check for a portion of digits, bailing if uneven
fun allInQS(b: BigInteger): Boolean {
var b2 = b
val bigBase = BigInteger.valueOf(base.toLong())
var c = ic.toInt()
hs.clear()
hs.addAll(o)
while (b2 > bllim) {
val divRem = b2.divideAndRemainder(bigBase)
hs.add(divRem[1].toByte())
c++
if (c > hs.size) {
return false
}
b2 = divRem[0]
}
return true
}
// check for a portion of digits, all the way to the end
fun allInS(b: BigInteger): Boolean {
var b2 = b
val bigBase = BigInteger.valueOf(base.toLong())
hs.clear()
hs.addAll(o)
while (b2 > bllim) {
val divRem = b2.divideAndRemainder(bigBase)
hs.add(divRem[1].toByte())
b2 = divRem[0]
}
return hs.size == base.toInt()
}
// check for all digits, bailing if uneven
fun allInQ(b: BigInteger): Boolean {
var b2 = b
val bigBase = BigInteger.valueOf(base.toLong())
var c = 0
hs.clear()
while (b2 > BigInteger.ZERO) {
val divRem = b2.divideAndRemainder(bigBase)
hs.add(divRem[1].toByte())
c++
if (c > hs.size) {
return false
}
b2 = divRem[0]
}
return true
}
// check for all digits, all the way to the end
fun allIn(b: BigInteger): Boolean {
var b2 = b
val bigBase = BigInteger.valueOf(base.toLong())
hs.clear()
while (b2 > BigInteger.ZERO) {
val divRem = b2.divideAndRemainder(bigBase)
hs.add(divRem[1].toByte())
b2 = divRem[0]
}
return hs.size == base.toInt()
}
// parse a string into a BigInteger, using current base
fun to10(s: String?): BigInteger {
val bigBase = BigInteger.valueOf(base.toLong())
var res = BigInteger.ZERO
for (element in s!!) {
val idx = indexOf(element)
val bigIdx = BigInteger.valueOf(idx.toLong())
res = res.multiply(bigBase).add(bigIdx)
}
return res
}
// returns the minimum value string, optionally inserting extra digit
fun fixup(n: Int): String {
var res = ALPHABET.substring(0, base.toInt())
if (n > 0) {
val sb = StringBuilder(res)
sb.insert(n, n)
res = sb.toString()
}
return "10" + res.substring(2)
}
// checks the square against the threshold, advances various limits when needed
fun check(sq: BigInteger) {
if (sq > threshold) {
o.remove(indexOf(ms!![blim.toInt()]).toByte())
blim--
ic--
threshold = limits!![bmo - blim - 1]
bllim = to10(ms!!.substring(0, blim + 1))
}
}
// performs all the calculations for the current base
fun doOne() {
limits = ArrayList()
bmo = (base - 1).toByte()
var dr: Byte = 0
if ((base.toInt() and 1) == 1) {
dr = (base.toInt() shr 1).toByte()
}
o.clear()
blim = 0
var id: Byte = 0
var inc = 1
val st = System.nanoTime()
val sdr = ByteArray(bmo.toInt())
var rc: Byte = 0
for (i in 0 until bmo) {
sdr[i] = (i * i % bmo).toByte()
if (sdr[i] == dr) {
rc = (rc + 1).toByte()
}
if (sdr[i] == 0.toByte()) {
sdr[i] = (sdr[i] + bmo).toByte()
}
}
var i: Long = 0
if (dr > 0) {
id = base
i = 1
while (i <= dr) {
if (sdr[i.toInt()] >= dr) {
if (id > sdr[i.toInt()]) {
id = sdr[i.toInt()]
}
}
i++
}
id = (id - dr).toByte()
i = 0
}
ms = fixup(id.toInt())
var sq = to10(ms)
var rt = BigInteger.valueOf((sqrt(sq.toDouble()) + 1).toLong())
sq = rt.multiply(rt)
if (base > 9) {
for (j in 1 until base) {
limits!!.add(to10(ms!!.substring(0, j) + chars[bmo.toInt()].toString().repeat(base - j + if (rc > 0) 0 else 1)))
}
limits!!.reverse()
while (sq < limits!![0]) {
rt = rt.add(BigInteger.ONE)
sq = rt.multiply(rt)
}
}
var dn = rt.shiftLeft(1).add(BigInteger.ONE)
var d = BigInteger.ONE
if (base > 3 && rc > 0) {
while (sq.remainder(BigInteger.valueOf(bmo.toLong())).compareTo(BigInteger.valueOf(dr.toLong())) != 0) {
rt = rt.add(BigInteger.ONE)
sq = sq.add(dn)
dn = dn.add(BigInteger.TWO)
} // aligns sq to dr
inc = bmo / rc
if (inc > 1) {
dn = dn.add(rt.multiply(BigInteger.valueOf(inc - 2.toLong())).subtract(BigInteger.ONE))
d = BigInteger.valueOf(inc * inc.toLong())
}
dn = dn.add(dn).add(d)
}
d = d.shiftLeft(1)
if (base > 9) {
blim = 0
while (sq < limits!![bmo - blim - 1]) {
blim++
}
ic = (blim + 1).toByte()
threshold = limits!![bmo - blim - 1]
if (blim > 0) {
for (j in 0..blim) {
o.add(indexOf(ms!![j]).toByte())
}
}
bllim = if (blim > 0) {
to10(ms!!.substring(0, blim + 1))
} else {
BigInteger.ZERO
}
if (base > 5 && rc > 0) while (!allInQS(sq)) {
sq = sq.add(dn)
dn = dn.add(d)
i += 1
check(sq)
} else {
while (!allInS(sq)) {
sq = sq.add(dn)
dn = dn.add(d)
i += 1
check(sq)
}
}
} else {
if (base > 5 && rc > 0) {
while (!allInQ(sq)) {
sq = sq.add(dn)
dn = dn.add(d)
i += 1
}
} else {
while (!allIn(sq)) {
sq = sq.add(dn)
dn = dn.add(d)
i += 1
}
}
}
rt = rt.add(BigInteger.valueOf(i * inc))
val delta1 = System.nanoTime() - st
val dur1 = Duration.ofNanos(delta1)
val delta2 = System.nanoTime() - st0
val dur2 = Duration.ofNanos(delta2)
System.out.printf(
"%3d %2d %2s %20s -> %-40s %10d %9s %9s\n",
base, inc, if (id > 0) ALPHABET.substring(id.toInt(), id + 1) else " ", toStr(rt), toStr(sq), i, format(dur1), format(dur2)
)
}
private fun format(d: Duration): String {
val minP = d.toMinutesPart()
val secP = d.toSecondsPart()
val milP = d.toMillisPart()
return String.format("%02d:%02d.%03d", minP, secP, milP)
}
fun main() {
println("base inc id root square test count time total")
st0 = System.nanoTime()
base = 2
while (base < 28) {
doOne()
++base
}
}
- Output:
base inc id root square test count time total 2 1 01 -> 001 0 00:00.001 00:00.002 3 1 22 -> 1012 4 00:00.000 00:00.016 4 3 33 -> 1023 2 00:00.000 00:00.018 5 1 2 342 -> 403231 14 00:00.000 00:00.021 6 5 325 -> 310254 20 00:00.000 00:00.023 7 6 1341 -> 1630542 34 00:00.000 00:00.026 8 7 4433 -> 02457631 41 00:00.000 00:00.028 9 4 24611 -> 475208631 289 00:00.002 00:00.032 10 3 34023 -> 9483576201 17 00:00.017 00:00.050 11 10 354111 -> 987635A0421 1498 00:00.011 00:00.063 12 11 9B6693 -> 906835B7A421 6883 00:00.016 00:00.083 13 1 3 3498283 -> 9B68AC37745201 8242 00:00.031 00:00.116 14 13 C7BD9A3 -> 4A3D75C8B96201 1330 00:00.002 00:00.120 15 14 758B2101 -> 4D638ECAB795201 4216 00:00.016 00:00.138 16 15 B9D9A404 -> 9DB73AEFC8465201 18457 00:00.087 00:00.226 17 1 1 9AG28F324 -> DE753BFGC98A642101 195112 00:00.435 00:00.664 18 17 DAC284B44 -> 7HC9DA4GE8F5B63201 30440 00:00.018 00:00.683 19 6 A9E55B1101 -> 5E9A6F8IC7GBHD43201 93021 00:00.061 00:00.745 20 19 G3D5HIGD94 -> G8AJF596BH3IDC7E4201 11310604 00:06.859 00:07.605 21 1 6 F72EF5EH9C4 -> FAECK6B6J8IH9GD7543201 601843 00:01.223 00:08.830 22 21 F0JG88749F4 -> 5AKL7IHC84JEDGBF963201 27804949 00:18.191 00:27.023 23 22 CM65LE3D1101 -> 657LIJBF8MH9GKDECA43201 17710217 00:11.143 00:38.167 24 23 3DH0FGDH0JL4 -> 96ALDMGINJKCEFH78B543201 4266555 00:02.381 00:40.549 25 12 MHGHF541E1101 -> 9HN7MAIL8BFG6JKCEOD543201 78092124 00:53.150 01:33.701 26 5 K99MDB35N8K25 -> ABDJNHCPF97GKMEI6OL8543201 402922566 05:15.307 06:49.008 27 26 JJBO73E11F1101 -> A6N9QC7PKGFJIBHDMOLE8543201 457555291 06:01.338 12:50.347
Mathematica / Wolfram Language
ClearAll[FirstSquare]
FirstSquare[b_Integer] := Module[{n, alldigits, digs, start},
digs = Range[0, b - 1];
digs[[{2, 1}]] //= Reverse;
start = Floor[Sqrt[FromDigits[digs, b]]];
n = start;
alldigits = Range[0, b - 1];
While[! ContainsAll[IntegerDigits[n^2, b], alldigits], n++];
{b, n, start, BaseForm[n, b]}
]
Scan[Print@*FirstSquare, Range[2, 16]]
- Output:
{2,2,1,10} {3,8,3,22} {4,15,8,33} {5,73,26,243} {6,195,91,523} {7,561,351,1431} {8,1764,1475,3344} {9,7814,6657,11642} {10,32043,31991,32043} {11,177565,162581,111453} {12,944493,868779,3966b9} {13,17527045,4858932,3828943} {14,28350530,28333238,3a9db7c} {15,171759007,171699980,1012b857} {16,1078631835,1078354969,404a9d9b}
Nim
import algorithm, math, strformat
const Alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
func toBaseN(num, base: Natural): string =
doAssert(base in 2..Alphabet.len, &"base must be in 2..{Alphabet.len}")
var num = num
while true:
result.add(Alphabet[num mod base])
num = num div base
if num == 0: break
result.reverse()
func countUnique(str: string): int =
var charset: set['0'..'Z']
for ch in str: charset.incl(ch)
result = charset.card
proc find(base: Natural) =
var n = pow(base.toFloat, (base - 1) / 2).int
while true:
let sq = n * n
let sqstr = sq.toBaseN(base)
if sqstr.len >= base and countUnique(sqstr) == base:
let nstr = n.toBaseN(base)
echo &"Base {base:2d}: {nstr:>8s}² = {sqstr:<16s}"
break
inc n
when isMainModule:
for base in 2..16:
base.find()
- 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
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!
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
I use now gmp to calculate the start values.Check Chai Wah Wu list on oeis.org/A260182
Now multithreaded at bases > 20 .Inserted StartOffset to run later on.For bases> 28 an intermediate stage of the minimal advanced thread is saved every minute.This is the candidate to start with again.
GetThreadCount needs improvement for Linux
The runtime is on my 6-Core PC AMD Ryzen 2200G ( 3.7 Ghz on all 4 cores Linux64 with SMT= off)
program Pandigital;
//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,ALL}
{$CODEALIGN proc=8,loop=1}// Ryzen Zen loop=1
{$ElSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
{$IFDEF UNIX}
unix,
cthreads,
{$ENDIF}
gmp,// to calculate start values
SysUtils;
type
tRegion32 = 0..31;
tSolSet32 = set of tRegion32;
tMask32 = array[tRegion32] of Uint32;
tpMask32 = ^tMask32;
tRegion64 = 0..63;
tSolSet64 = set of tRegion64;
tMask64 = array[tRegion64] of Uint64;
tpMask64 = ^tMask64;
const
// has hyperthreading
SMT = 0;
{$ALIGN 32}
//set Bit 0 til Bit 63
cOr_Mask64: tMask64 =
(1 shl 0,1 shl 1,1 shl 2,1 shl 3,1 shl 4,1 shl 5,1 shl 6,1 shl 7,
1 shl 8,1 shl 9,1 shl 10,1 shl 11,1 shl 12,1 shl 13,1 shl 14,1 shl 15,
1 shl 16,1 shl 17,1 shl 18,1 shl 19,1 shl 20,1 shl 21,1 shl 22,1 shl 23,
1 shl 24,1 shl 25,1 shl 26,1 shl 27,1 shl 28,1 shl 29,1 shl 30,1 shl 31,
1 shl 32,1 shl 33,1 shl 34,1 shl 35,1 shl 36,1 shl 37,1 shl 38,1 shl 39,
1 shl 40,1 shl 41,1 shl 42,1 shl 43,1 shl 44,1 shl 45,1 shl 46,1 shl 47,
1 shl 48,1 shl 49,1 shl 50,1 shl 51,1 shl 52,1 shl 53,1 shl 54,1 shl 55,
1 shl 56,1 shl 57,1 shl 58,1 shl 59,1 shl 60,1 shl 61,1 shl 62,1 shl 63);
charSet: array[0..62] of char =
'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
type
tRegion1 = 0..63 - 2 * SizeOf(byte);
tNumtoBase = packed record
ntb_dgt: array[tRegion1] of byte;
ntb_cnt,
ntb_bas: Byte;
end;
tDgtRootSqr = packed record
drs_List: array[tRegion64] of byte;
drs_SetOfSol: tSolSet64;
drs_bas: byte;
drs_Sol: byte;
drs_SolCnt: byte;
drs_Dgt2Add: byte;
drs_NeedsOneMoreDigit: boolean;
end;
tCombineForOneThread = record
cft_sqr2b,
cft_deltaNextSqr,
cft_delta: tNumtoBase;
cft_count : Uint64;
cft_offset: Uint64;// unused but doubles speed especially for base 25
cft_ThreadID: NativeUint;
cft_ThreadHandle: NativeUint;
//Alignment = 32
//Base 25 test every 12 0.539 s Testcount : 78092125
//Alignment = 24
//Base 25 test every 12 1.316 s Testcount : 78092125
end;
procedure AddNum(var add1: tNumtoBase; const add2: tNumtoBase); forward;
function AddNumSqr(var add1, add2: tNumtoBase): Uint64; forward;
var
ThreadBlocks: array of tCombineForOneThread;
{$ALIGN 32}
Num, sqr2B, deltaNextSqr, delta: tNumtoBase;
{$ALIGN 32}
DgtRtSqr: tDgtRootSqr;
{$ALIGN 8}
gblThreadCount,
Finished: Uint32;
function GetCoreCount:NativeInt;
// from lazarus forum
var
t: Text;
s: string;
begin
result := 1;
try
POpen(t, 'nproc', 'R');
while not Eof(t) do
Readln(t, s);
finally
PClose(t);
end;
result := StrToInt(s);
end;
function GetThreadCount: NativeUInt;
begin
{$IFDEF Windows}
Result := GetCpuCount;
{$ELSE}
Result := GetCoreCount;//GetCpuCount is not working under Linux ???
{$ENDIF}
if SMT = 1 then
Result := (Result+1) div 2;
end;
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;
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[tRegion64] of tSolSet64;
ChkCnt: array[tRegion64] of byte;
i, j: NativeUInt;
PTest: tSolSet64;
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;
write(' 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;
function ExtractThreadVal(ThreadNr: NativeInt ): Uint64;
begin
with ThreadBlocks[ThreadNr] do
begin
sqr2b := cft_sqr2b;
Result := cft_count;
cft_ThreadID := 0;
cft_ThreadHandle := 0;
end;
end;
function CheckPandigital(const n: tNumtoBase): boolean;
var
pMask: tpMask64;
TestSet: Uint64;
i: NativeInt;
begin
pMask := @cOr_Mask64;
TestSet := 0;
with n do
begin
for i := ntb_cnt - 1 downto 0 do
TestSet := TestSet or pMask[ntb_dgt[i]];
Result := (Uint64(1) shl ntb_bas - 1) = TestSet;
end;
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 IncSmallNum(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: tNumtoBase; const add2: tNumtoBase);
//add1 <= add1+add2;
var
i, 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;
procedure Mul_num_ui(var n: tNumtoBase; ui: Uint64);
var
dbl: tNumtoBase;
begin
dbl := n;
conv_ui_num(n.ntb_bas, 0, n);
while ui > 0 do
begin
if Ui and 1 <> 0 then
AddNum(n, dbl);
AddNum(dbl, dbl);
ui := ui div 2;
end;
end;
procedure CalcDeltaSqr(const num: tNumtoBase; var dnsq, dlt: tNumtoBase;
n: NativeUInt);
//calc deltaNextSqr //n*num
begin
dnsq := num;
Mul_num_ui(dnsq, n);
AddNum(dnsq, dnsq);
IncNumBig(dnsq, n * n);
conv_ui_num(num.ntb_bas, 2 * n * n, dlt);
end;
procedure PrepareThreads(thdCount,stepWidth:NativeInt);
//starting the threads at num,num+stepWidth,..,num+(thdCount-1)*stepWidth
//stepwith not stepWidth but thdCount*stepWidth
var
tmpnum,tmpsqr2B,tmpdeltaNextSqr,tmpdelta :tNumToBase;
i : NativeInt;
Begin
tmpnum := num;
tmpsqr2B := sqr2B;
tmpdeltaNextSqr := deltaNextSqr;
tmpdelta := delta;
For i := 0 to thdCount-1 do
Begin
//init ThreadBlock
With ThreadBlocks[i] do
begin
cft_sqr2b := tmpsqr2B;
cft_count := 0;
CalcDeltaSqr(tmpnum,cft_deltaNextSqr,cft_delta,thdCount*stepWidth);
end;
//Next sqr number in stepWidth
IncSmallNum(tmpnum,stepWidth);
AddNumSqr(tmpsqr2B,tmpdeltaNextSqr);
IF CheckPandigital(sqr2B) then
begin
writeln(' solution found ');
readln;
Halt(-124);
end;
AddNum(tmpdeltaNextSqr,tmpdelta);
end;
end;
function AddNumSqr(var add1, add2: tNumtoBase): Uint64;
//add1 <= add1+add2;
//prerequisites bases are the same,add1>=add2( cnt ),
//out Set of used digits
var
pMask: tpMask64;
i, base, s, carry: NativeInt;
begin
pMask := @cOr_Mask64;
base := add1.ntb_bas;
dec(s,s);
Result := s;
carry := s;
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);
Result := Result or pMask[s];
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);
Result := Result or pMask[s];
add1.ntb_dgt[i] := s;
Inc(i);
end;
if add1.ntb_cnt < i then
add1.ntb_cnt := i;
for i := i to add1.ntb_cnt - 1 do
Result := Result or pMask[add1.ntb_dgt[i]];
end;
procedure TestRunThd(parameter: pointer);
var
pSqrNum, pdeltaNextSqr, pDelta: ^tNumtoBase;
TestSet, TestSetComplete, i: Uint64;
ThreadBlockIdx: NativeInt;
begin
ThreadBlockIdx := NativeUint(parameter);
with ThreadBlocks[ThreadBlockIdx] do
begin
pSqrNum := @cft_sqr2b;
pdeltaNextSqr := @cft_deltaNextSqr;
pDelta := @cft_delta;
end;
TestSetComplete := Uint64(1) shl pSqrNum^.ntb_bas - 1;
i := 0;
repeat
//next square number
TestSet := AddNumSqr(pSqrNum^, pdeltaNextSqr^);
AddNum(pdeltaNextSqr^, pdelta^);
Inc(i);
if finished <> 0 then
BREAK;
until TestSetComplete = TestSet;
if finished = 0 then
begin
InterLockedIncrement(finished);
ThreadBlocks[ThreadBlockIdx].cft_count := i;
EndThread(i);
end
else
EndThread(0);
end;
procedure Test(base: NativeInt);
var
stepWidth: Uint64;
i, j,UsedThreads: NativeInt;
begin
write('Base ', base);
StartValueCreate(base);
deltaNextSqr := num;
AddNum(deltaNextSqr, deltaNextSqr);
IncSmallNum(deltaNextSqr, 1);
stepWidth := 1;
if (Base > 4) 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
IncSmallNum(num, 1);
AddNum(sqr2B, deltaNextSqr);
IncSmallNum(deltaNextSqr, 2);
end;
stepWidth := (Base - 1) div DgtRtSqr.drs_SolCnt;
if stepWidth * DgtRtSqr.drs_SolCnt <> (Base - 1) then
stepWidth := 1;
end;
CalcDeltaSqr(num,deltaNextSqr,delta,stepWidth);
writeln(' test every ', stepWidth);
// Write('Start :');OutNumSqr;
i := 0;
if not (CheckPandigital(sqr2b)) then
begin
finished := 0;
j := 0;
UsedThreads := gblThreadCount;
if base < 21 then
UsedThreads := 1;
PrepareThreads(UsedThreads,stepWidth);
j := 0;
while (j < UsedThreads) and (finished = 0) do
begin
with ThreadBlocks[j] do
begin
cft_ThreadHandle :=
BeginThread(@TestRunThd, Pointer(j), cft_ThreadID,
4 * 4096);
end;
Inc(j);
end;
WaitForThreadTerminate(ThreadBlocks[0].cft_ThreadHandle, -1);
repeat
Dec(j);
with ThreadBlocks[j] do
begin
WaitForThreadTerminate(cft_ThreadHandle, -1);
if cft_count <> 0 then
finished := j;
end;
until j = 0;
i := ExtractThreadVal(finished);
j := i*UsedThreads+finished;//TestCount starts at original num
IncNumBig(num,j*stepWidth);
end;
OutNumSqr;
end;
var
T: TDateTime;
base: NativeUint;
begin
T := now;
gblThreadCount:= GetThreadCount;
writeln(' Cpu Count : ', gblThreadCount);
setlength(ThreadBlocks, gblThreadCount);
for base := 2 to 28 do
Test(base);
writeln('completed in ', (now - T) * 86400: 0: 3, ' seconds');
setlength(ThreadBlocks, 0);
{$IFDEF WINDOWS}
readln;
{$ENDIF}
end.
- Output:
Cpu Count : 4 Base 2 test every 1 Num 10 sqr 100 Base 3 test every 1 Num 22 sqr 2101 Base 4 test every 1 Num 33 sqr 3201 Base 5 insert 2 test every 1 Num 243 sqr 132304 Base 6 test every 5 Num 523 sqr 452013 Base 7 test every 6 Num 1431 sqr 2450361 Base 8 test every 7 Num 3344 sqr 13675420 Base 9 test every 4 Num 11642 sqr 136802574 Base 10 test every 3 Num 32043 sqr 1026753849 Base 11 test every 10 Num 111453 sqr 1240A536789 Base 12 test every 11 Num 3966B9 sqr 124A7B538609 Base 13 insert 3 test every 1 Num 3828943 sqr 10254773CA86B9 Base 14 test every 13 Num 3A9DB7C sqr 10269B8C57D3A4 Base 15 test every 14 Num 1012B857 sqr 102597BACE836D4 Base 16 test every 15 Num 404A9D9B sqr 1025648CFEA37BD9 Base 17 insert 1 test every 1 Num 423F82GA9 sqr 101246A89CGFB357ED Base 18 test every 17 Num 44B482CAD sqr 10236B5F8EG4AD9CH7 Base 19 test every 6 Num 1011B55E9A sqr 10234DHBG7CI8F6A9E5 Base 20 test every 19 Num 49DGIH5D3G sqr 1024E7CDI3HB695FJA8G Base 21 insert 6 test every 1 Num 4C9HE5FE27F sqr 1023457DG9HI8J6B6KCEAF Base 22 test every 21 Num 4F94788GJ0F sqr 102369FBGDEJ48CHI7LKA5 Base 23 test every 22 Num 1011D3EL56MC sqr 10234ACEDKG9HM8FBJIL756 Base 24 test every 23 Num 4LJ0HDGF0HD3 sqr 102345B87HFECKJNIGMDLA69 Base 25 test every 12 Num 1011E145FHGHM sqr 102345DOECKJ6GFB8LIAM7NH9 Base 26 test every 5 Num 52K8N53BDM99K sqr 1023458LO6IEMKG79FPCHNJDBA Base 27 test every 26 Num 1011F11E37OBJJ sqr 1023458ELOMDHBIJFGKP7CQ9N6A Base 28 test every 9 Num 58A3CKP3N4CQD7 sqr 1023456CGJBIRQEDHP98KMOAN7FL completed in 15.652 seconds real 0m15,654s user 1m1,007s // Ryzen 5 1600 3.4 Ghz on 6 cores/12 threads Base 29 test every 1 threads = 12 Start : Num 5BAEFC5QHESPCLA sqr 10223456789ABCDKM4JI4S470KCSHD 1.00 min 24099604789 2.00 min 48201071089 3.00 min 72295381621 Result : Num 5BAEFC62RGS0KJF sqr 102234586REOSIGJD9PCF7HBLKANQM 230.632 s Testcount : 92238034003 92238034003 Num 5EF7R2P77FFPBMR sqr 1023456789ABCDEPPNIG6S4MJNB8C9 Base 30 test every 29 threads = 12 Start : Num 5EF7R2P77FFPBN5 sqr 1023456789ABCDHNHROTMC0MS6RGKP Result : Num 5EF7R2POS9MQRN7 sqr 1023456DMAPECBQOLSITK9FR87GHNJ 35.626 s Testcount : 13343410738 386958911402 Num 1011H10BS64GFL6U sqr 1023456789ABCDEH3122BRSP7T7G6H1 Base 31 test every 30 threads = 12 Start : Num 1011H10BS64GFL76 sqr 1023456789ABCDF03FNNQ29H0ULION5 Result : Num 1011H10CDMAUP44O sqr 10234568ABQUJGCNFP7KEM9RHDLTSOI 41.251 s Testcount : 15152895679 454586870370 Num 5L6HID7BTGM6RU9L sqr 1023456789ABCDEFGQNN3264K1GRK97P Base 32 test every 31 threads = 12 Start : Num 5L6HID7BTGM6RUAA sqr 1023456789ABCDEMULAP8DRPBULSA2B4 Result : Num 5L6HID7BVGE2CIEC sqr 102345678VS9CMJDRAIOPLHNFQETBUKG 5.626 s Testcount : 2207946558 68446343298 completed in 317.047 seconds Num 1011I10CLMTDCMPC1 sqr 1023456789ABCDEFHSSWJ340NGCV8MTO1 Base 33 test every 8 threads = 12 Start : Num 1011I10CLMTDCMPC6 sqr 1023456789ABCDEFRT6F1D7S9EA03JJD3 Num 1011I10CLMTDCMPC1 sqr 1023456789ABCDEFHSSWJ340NGCV8MTO1 Base 33 test every 8 threads = 12 Start : Num 1011I10CLMTDCMPC6 sqr 1023456789ABCDEFRT6F1D7S9EA03JJD3 1.00 min 184621467265 2.00 min 369105711649 Result : Num 1011I10CLWWNS6SKS sqr 102345678THKFAERNWJGDOSQ9BCIUVMLP 140.634 s Testcount : 53808573863 430468590904 Num 5SEMXRII09S90UO6V sqr 1023456789ABCDEFGKNK3JK9NREFLEH5Q9 Base 34 test every 33 threads = 12 Start : Num 5SEMXRII09S90UO7P sqr 1023456789ABCDEFQ7HPX8WRC9L0GV31SD 1.00 min 747770289553 2.00 min 1495002801997 .. 8.00 min 5978195501257 9.00 min 6725222258833 Result : Num 5SEMXRII42NG8AKSL sqr 102345679JIESRPA8BLCVKDNMHUFTGOQWX 549.392 s Testcount : 205094427126 6768116095158 Num 1011J10DE6M9QOAY42 sqr 1023456789ABCDEFGHSOEHTX34IF9YB1CG4 Base 35 test every 34 threads = 12 Start : Num 1011J10DE6M9QOAY42 sqr 1023456789ABCDEFGHSOEHTX34IF9YB1CG4 1.00 min 749708230993 2.00 min 1496695534873 .. 27.00 min 20178502394905 28.00 min 20925398930617 //<== > solution, because finisched tested every 1.875 seconds Result : Num 1011J10DEFW1QTVBXR sqr 102345678RUEPV9KGQIWFOBAXCNSLDMYJHT 1681.925 s Testcount : 614575698110 20895573735740 Num 6069962AODK1L20LTW sqr 1023456789ABCDEFGHSWJSDUGHWCR30SK5CG Base 36 test every 35 threads = 12 Start : Num 6069962AODK1L20LUU sqr 1023456789ABCDEFGT58D9PASNXYM2SLPEP0 1.00 min 787213111441 2.00 min 1586599478101 ..192.00 min 152890333403641 193.00 min 153686150046241 Result : Num 6069962APW1QG36EV8 sqr 102345678RGQKMOCBLZIYHN9WDJEUXFVPATS 11584.118 s Testcount : 4392178427722 153726244970270 completed in 11584.118 seconds Base 37 test every 1 threads = 12 Start : Num 638NMI7KVO4Z0LEB6K7 sqr 1023456778A35I0aGIP71DUIJIPV7Y895H0AMC 1.00 min 8626362427597 -> offset off 550 min calc before 2.00 min 8643195114781 ... 2740.00 min 54839279882317 2741.00 min 54936788352145 Result : Num 638NMI7KVOKXYYLI7DN sqr 1023456778FCLXTERSDZJ9WVHAPGaNIMYUOQKB 210398.691 s Testcount : 56097957152641 56097957152641 +33000 s for reaching 8626362427597 -> ~ 67h36m40s Num 66FVHSMH0OXH39bH6LT sqr 1023456789ABCDEFGHIV4YWaF08URZ5H135NO5 Base 38 test every 37 threads = 12 Start : Num 66FVHSMH0OXH39bH6MN sqr 1023456789ABCDEFGHT7ZLWWKUXYO9YZW62QbZ 1.00 min 785788279813 2.00 min 1568354438749 .. 58.00 min 45309747953833 59.00 min 46095937872493 Result : Num 66FVHSMH0P60WK173YQ sqr 1023456789DRTAINWaFJCHLYMQPGEBZVOKXSbU 3547.633 s Testcount : 1242398966051 45968761743887 completed in 3547.634 seconds Num 1011L10EZ7510RFTU2Ia sqr 1023456789ABCDEFGHIKb22ISU7MJC5GAPVLY39 Base 39 test every 38 threads = 12 Start : Num 1011L10EZ7510RFTU2J0 sqr 1023456789ABCDEFGHIQb8BRYWIcN3BKJ3F7A00 1.00 min 795117225457 2.00 min 1589942025409 ..398.00 min 315778732951561 399.00 min 316570538706841 Result : Num 1011L10EZ76L0a5UAJOF sqr 1023456789DCFaKJPGLcEVSIBYZRTOMAbQHWXNU 23998.810 s Testcount : 8310508262457 315799313973366 // old version 68000s
PascalABC.NET
uses School;
const
valid_chars = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
function ToBase(number: int64; base: integer): string;
begin
var sb := new System.Text.StringBuilder('');
while number > 0 do
begin
sb.Insert(0, valid_chars[integer(number mod base) + 1]);
number := number div base
end;
Result := if sb.Length = 0 then '0'
else sb.ToString
end;
begin
var n: Int64 := 1;
for var base := 2 to 15 do
begin
while True do
begin
var nn: int64 := n * n;
var dd := ToBase(nn,base);
if (dd.Length >= base) and (dd.ToHashSet.Count = base) then
begin
Println($'{base,2} {ToBase(n,base),8}^2 = {ToBase(n*n,base)}');
break;
end;
n += 1;
end;
end;
end.
- Output:
2 10^2 = 100 3 22^2 = 2101 4 33^2 = 3201 5 243^2 = 132304 6 523^2 = 452013 7 1431^2 = 2450361 8 3344^2 = 13675420 9 11642^2 = 136802574 10 32043^2 = 1026753849 11 111453^2 = 1240A536789 12 3966B9^2 = 124A7B538609 13 3828943^2 = 10254773CA86B9 14 3A9DB7C^2 = 10269B8C57D3A4 15 1012B857^2 = 102597BACE836D4
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;
- 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:
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));
}
Phix
Partial translation of VB with bitmap idea from C++ and adopting the digit-array approach from pascal instead of base conversion.
-- demo\rosetta\PandigitalSquares.exw without javascript_semantics -- (mpz_set_str() currently only supports bases 2, 8, 10, and 16 under pwa/p2js) include mpfr.e atom t0 = time() constant chars = "0123456789abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz|", use_hll_code = true function str_conv(sequence s, integer mode=+1) -- mode of +1: eg {1,2,3} -> "123", mode of -1 the reverse. -- note this doesn't really care what base s/res are in. {sequence res,integer dcheck} = iff(mode=+1?{"",9}:{{},'9'}) for i=1 to length(s) do integer d = s[i] d += mode*iff(d>dcheck?'a'-10:'0') res &= d end for return res end function procedure do_one(integer base) -- tabulates one base integer bm1 = base-1, dr = iff(and_bits(base,1) ? floor(base/2) : 0), id = 0, rc = 0, sdri atom st = time() sequence sdr = repeat(0,bm1) for i=0 to bm1-1 do sdri = mod(i*i,bm1) rc += (sdri==dr) sdr[i+1] = iff(sdri=0 ? bm1 : sdri) end for if dr>0 then id = base for i=1 to dr do sdri = sdr[i+1] if sdri>=dr and id>sdri then id = sdri end if end for id -= dr end if string sq = chars[1..base] if id>0 then sq = sq[1..id]&chars[id+1]&sq[id+1..$] end if sq[1..2] = "10" mpz sqz = mpz_init(), rtz = mpz_init(), dnz = mpz_init(), tmp = mpz_init() mpz_set_str(sqz,sq,base) mpz_sqrt(rtz,sqz) mpz_add_ui(rtz,rtz,1) -- rtz = sqrt(sqz)+1 mpz_mul_si(dnz,rtz,2) mpz_add_si(dnz,dnz,1) -- dnz = rtz*2+1 mpz_mul(sqz,rtz,rtz) -- sqz = rtz * rtz integer d = 1, inc = 1 if base>3 and rc>0 then while mpz_fdiv_ui(sqz,bm1)!=dr do -- align sqz to dr mpz_add_ui(rtz,rtz,1) -- rtz += 1 mpz_add(sqz,sqz,dnz) -- sqz += dnz mpz_add_ui(dnz,dnz,2) -- dnz += 2 end while inc = floor(bm1/rc) if inc>1 then mpz_mul_si(tmp,rtz,inc-2) mpz_sub_ui(tmp,tmp,1) mpz_add(dnz,dnz,tmp) -- dnz += rtz*(inc-2)-1 end if d = inc * inc mpz_add(dnz,dnz,dnz) mpz_add_ui(dnz,dnz,d) -- dnz += dnz + d end if d *= 2 atom mask, fullmask = power(2,base)-1 -- ie 0b111.. integer icount = 0 mpz_set_si(tmp,d) sequence sqi = str_conv(mpz_get_str(sqz,base), mode:=-1), dni = str_conv(mpz_get_str(dnz,base), mode:=-1), dti = str_conv(mpz_get_str(tmp,base), mode:=-1) while true do if use_hll_code then mask = 0 for i=1 to length(sqi) do mask = or_bits(mask,power(2,sqi[i])) end for else ?9/0 -- see below, inline part 1 end if if mask=fullmask then exit end if integer carry = 0, sidx, si if use_hll_code then for sidx=-1 to -length(dni) by -1 do si = sqi[sidx]+dni[sidx]+carry carry = si>=base sqi[sidx] = si-carry*base end for sidx += length(sqi)+1 while carry and sidx do si = sqi[sidx]+carry carry = si>=base sqi[sidx] = si-carry*base sidx -= 1 end while else ?9/0 --see below, inline part 2 end if if carry then sqi = carry&sqi end if carry = 0 for sidx=-1 to -length(dti) by -1 do si = dni[sidx]+dti[sidx]+carry carry = floor(si/base) dni[sidx] = remainder(si,base) end for sidx += length(dni)+1 while carry and sidx do si = dni[sidx]+carry carry = si>=base dni[sidx] = si-carry*base sidx -= 1 end while if carry then dni = carry&dni end if icount += 1 end while mpz_set_si(tmp,icount) mpz_mul_si(tmp,tmp,inc) mpz_add(rtz,rtz,tmp) -- rtz += icount * inc sq = str_conv(sqi, mode:=+1) string rt = mpz_get_str(rtz,base), idstr = iff(id?sprintf("%d",id):" "), ethis = elapsed_short(time()-st), etotal = elapsed_short(time()-t0) printf(1,"%3d %3d %s %18s -> %-28s %10d %8s %8s\n", {base, inc, idstr, rt, sq, icount, ethis, etotal}) {sqz,rtz,dnz,tmp} = mpz_free({sqz,rtz,dnz,tmp}) end procedure puts(1,"base inc id root -> square" & " test count time total\n") for base=2 to 19 do --for base=2 to 25 do --for base=2 to 28 do do_one(base) end for printf(1,"completed in %s\n", {elapsed(time()-t0)})
- Output:
base inc id root -> square test count time total 2 1 10 -> 100 0 0s 0s 3 1 22 -> 2101 4 0s 0s 4 3 33 -> 3201 2 0s 0s 5 1 2 243 -> 132304 14 0s 0s 6 5 523 -> 452013 20 0s 0s 7 6 1431 -> 2450361 34 0s 0s 8 7 3344 -> 13675420 41 0s 0s 9 4 11642 -> 136802574 289 0s 0s 10 3 32043 -> 1026753849 17 0s 0s 11 10 111453 -> 1240a536789 1498 0s 0s 12 11 3966b9 -> 124a7b538609 6883 0s 0s 13 1 3 3828943 -> 10254773ca86b9 8242 0s 0s 14 13 3a9db7c -> 10269b8c57d3a4 1330 0s 0s 15 14 1012b857 -> 102597bace836d4 4216 0s 0s 16 15 404a9d9b -> 1025648cfea37bd9 18457 0s 0s 17 1 1 423f82ga9 -> 101246a89cgfb357ed 195112 0s 0s 18 17 44b482cad -> 10236b5f8eg4ad9ch7 30440 0s 0s 19 6 1011b55e9a -> 10234dhbg7ci8f6a9e5 93021 0s 0s completed in 0.5s
Performance drops significantly after that:
20 19 49dgih5d3g -> 1024e7cdi3hb695fja8g 11310604 9s 10s 21 1 6 4c9he5fe27f -> 1023457dg9hi8j6b6kceaf 601843 0s 10s 22 21 4f94788gj0f -> 102369fbgdej48chi7lka5 27804949 25s 36s 23 22 1011d3el56mc -> 10234acedkg9hm8fbjil756 17710217 17s 53s 24 23 4lj0hdgf0hd3 -> 102345b87hfeckjnigmdla69 4266555 4s 58s 25 12 1011e145fhghm -> 102345doeckj6gfb8liam7nh9 78092125 1:16 2:14 completed in 2 minutes and 15s
It takes a little over half an hour to get to 28. We can use "with profile_time" to identify
a couple of hotspots and replace them with inline assembly (setting use_hll_code to false).
[This is probably quite a good target for improving the quality of the generated code.]
Requires version 0.8.1+, not yet shipped, which will include demo\rosetta\PandigitalSquares.exw
64 bit code omitted for clarity, the code in PandigitalSquares.exw is twice as long.
-- ?9/0 -- see below, inline part 1
mask = length(sqi)
#ilASM{
mov esi,[sqi]
mov edx,[mask]
shl esi,2
xor eax,eax
@@:
mov edi,1
mov cl,[esi]
shl edi,cl
add esi,4
or eax,edi
sub edx,1
jnz @b
mov [mask],eax
}
--and
-- ?9/0 --see below, inline part 2
if length(dni)=length(sqi) then
sqi = 0&sqi
end if
#ilASM{
mov esi,[sqi]
mov edi,[dni]
mov ecx,[ebx+esi*4-12] -- length(sqi)
mov edx,[ebx+edi*4-12] -- length(dni)
lea esi,[esi+ecx-1]
lea edi,[edi+edx-1]
sub ecx,edx
xor eax,eax
lea esi,[ebx+esi*4] -- locate sqi[$]
lea edi,[ebx+edi*4] -- locate dni[$]
push ecx
mov ecx,[base]
@@:
add eax,[esi]
add eax,[edi]
div cl
mov [esi],ah
xor ah,ah
sub esi,4
sub edi,4
sub edx,1
jnz @b
pop edx
@@:
test eax,eax
jz @f
add eax,[esi]
div cl
mov [esi],ah
xor ah,ah
sub esi,4
sub edx,1
jnz @b
@@:
mov [carry],eax
}
- Output:
20 19 49dgih5d3g -> 1024e7cdi3hb695fja8g 11310604 2s 3s 21 1 6 4c9he5fe27f -> 1023457dg9hi8j6b6kceaf 601843 0s 3s 22 21 4f94788gj0f -> 102369fbgdej48chi7lka5 27804949 7s 10s 23 22 1011d3el56mc -> 10234acedkg9hm8fbjil756 17710217 4s 14s 24 23 4lj0hdgf0hd3 -> 102345b87hfeckjnigmdla69 4266555 1s 15s 25 12 1011e145fhghm -> 102345doeckj6gfb8liam7nh9 78092125 18s 34s completed in 34.3s
It takes 7 minutes and 20s to get to 28, still not quite up to the frankly astonishing 27s 12.3s of pascal, but getting there.
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()
- 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.
Quackery
from
, index
, and end
are defined at Loops/Increment loop index within loop body#Quackery.
[ dup 1
[ 2dup > while
+ 1 >>
2dup / again ]
drop nip ] is sqrt ( n --> n )
[ base share bit 1 -
0 rot
[ dup while
base share /mod bit
rot | swap again ]
drop = ] is pandigital ( n --> b )
[ base share
dup 2 - times
[ base share *
i^ 2 + + ] ] is firstpan ( --> n )
[ dup * ] is squared ( n --> n )
11 times
[ i^ 2 + base put
firstpan sqrt from
[ index squared
pandigital if
[ index end ] ]
base share
say "Base " decimal echo
base release
say ": " dup echo
say "^" 2 echo say " = "
squared echo
cr base release ]
- Output:
Base 2: 10^10 = 100 Base 3: 22^2 = 2101 Base 4: 33^2 = 3201 Base 5: 243^2 = 132304 Base 6: 523^2 = 452013 Base 7: 1431^2 = 2450361 Base 8: 3344^2 = 13675420 Base 9: 11642^2 = 136802574 Base 10: 32043^2 = 1026753849 Base 11: 111453^2 = 1240A536789 Base 12: 3966B9^2 = 124A7B538609
Raku
(formerly 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.
#`[
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
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, but could be extended.
slightly optimized
/*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 LO HI . /*obtain optional argument from the CL.*/
if LO=='' then do; LO=2; HI=16; end /*not specified? Then use the default.*/
if LO==',' then LO=2 /*not specified? Then use the default.*/
if HI=='' | HI=="," then HI=LO /*not specified? Then use the default.*/
@start= 1023456789abcdefghijklmnopqrstuvwxyz /*contains the start # (up to base 36).*/
/* [↓] find the smallest square with */
do j=LO to HI; 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, length(HI) ) " root=" ,
lower( right( base(k, j, 10), max(5, HI) ) ) ' square=' lower($)
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 1; #= 0 /*result of converted X (in base 10).*/
if inb==2 then do; #= b2d(x); leave; end /*convert binary to decimal. */
if inb==16 then do; #= x2d(x); leave; end /* " hexadecimal " " */
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 #.*/
if tob==2 then return d2b(#) /*convert base 10 number to binary. */
if tob==16 then return lower( d2x(#) ) /* " " " " " hexadecimal*/
do while # >= toB /*convert #: decimal ──► 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
/*──────────────────────────────────────────────────────────────────────────────────────*/
b2d: return x2d( b2x( arg(1) ) ) /*convert binary number to decimal*/
d2b: return x2b( d2x( arg(1) ) ) + 0 /* " hexadecimal " " " */
lower: @abc= 'abcdefghijklmnopqrstuvwxyz'; return translate(arg(1), @abc, translate(@abc))
- 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.
/*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 LO HI . /*obtain optional argument from the CL.*/
if LO=='' then do; LO=2; HI=16; end /*not specified? Then use the default.*/
if LO==',' then LO=2 /* " " " " " " */
if HI=='' | HI=="," then HI=LO /* " " " " " " */
@start= 1023456789abcdefghijklmnopqrstuvwxyz /*contains the start # (up to base 36).*/
call base /*initialize 2 arrays for BASE function*/
/* [↓] find the smallest square with */
do j=LO to HI; 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(HI) ) " root=" ,
lower( right( base(k, j, 10), max(5, HI) ) ) ' 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 1; #= 0 /*result of converted X (in base 10).*/
if inb==2 then do; #= b2d(x); leave; end /*convert binary to decimal. */
if inb==16 then do; #= x2d(x); leave; end /* " hexadecimal " " */
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 #.*/
if tob==2 then return d2b(#) /*convert base 10 number to binary. */
if tob==16 then return d2x(#) /* " " " " " hexadecimal*/
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
/*──────────────────────────────────────────────────────────────────────────────────────*/
b2d: return x2d( b2x( arg(1) ) ) /*convert binary number to decimal*/
d2b: return x2b( d2x( arg(1) ) ) + 0 /* " hexadecimal " " " */
lower: @abc= 'abcdefghijklmnopqrstuvwxyz'; return translate(arg(1), @abc, translate(@abc))
- output is identical to the 1st REXX version.
Ring
basePlus = []
decList = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15]
baseList = ["0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"]
see "working..." + nl
for base = 2 to 10
for n = 1 to 40000
basePlus = []
nrPow = pow(n,2)
str = decimaltobase(nrPow,base)
ln = len(str)
for m = 1 to ln
nr = str[m]
ind = find(baseList,nr)
num = decList[ind]
add(basePlus,num)
next
flag = 1
basePlus = sort(basePlus)
if len(basePlus) = base
for p = 1 to base
if basePlus[p] = p-1
flag = 1
else
flag = 0
exit
ok
next
if flag = 1
see "in base: " + base + " root: " + n + " square: " + nrPow + " perfect square: " + str + nl
exit
ok
ok
next
next
see "done..." + nl
func decimaltobase(nr,base)
binList = []
binary = 0
remainder = 1
while(nr != 0)
remainder = nr % base
ind = find(decList,remainder)
rem = baseList[ind]
add(binList,rem)
nr = floor(nr/base)
end
binlist = reverse(binList)
binList = list2str(binList)
binList = substr(binList,nl,"")
return binList
- Output:
in base: 4 root: 15 square: 225 perfect square: 3201 in base: 6 root: 195 square: 38025 perfect square: 452013 in base: 7 root: 561 square: 314721 perfect square: 2450361 in base: 8 root: 1764 square: 3111696 perfect square: 13675420 in base: 9 root: 7814 square: 61058596 perfect square: 136802574 in base: 10 root: 32043 square: 1026753849 perfect square: 1026753849 done...
RPL
≪ → base ≪ { } base + 0 CON SWAP WHILE DUP REPEAT base IDIV2 ROT SWAP 1 + DUP PUT SWAP END DROP OBJ→ 1 GET →LIST ΠLIST ≫ ≫ 'PANB?' STO @ ( number base → boolean ) ≪ → base ≪ "" WHILE OVER REPEAT SWAP base IDIV2 "0123456789ABCDEF" SWAP 1 + DUP SUB ROT + END SWAP DROP ≫ ≫ '→B' STO @ ( number_10 base → "number_base" ) ≪ → base ≪ 0 1 base 1 - FOR j @ this loop generates the smallest pandigital number for the base base IF j 2 == THEN SQ END * j + NEXT √ IP WHILE DUP SQ base PANB? NOT REPEAT 1 + END base ": " + OVER base →B + "² = " + SWAP SQ base →B + ≫ ≫ ‘SQPAN’ STO @ ( → "base: n² = pandigital" ) ≪ { } 2 15 FOR b base SQPAN + NEXT ≫ ‘TASK’ STO
The above code can be run on a HP-48G if IDIV2
is implemented such as : ≪ MOD LASTARG / IP SWAP ≫
- Output:
1: { "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" }
Ruby
Takes about 15 seconds on my dated PC, most are spent calculating base 13.
DIGITS = "1023456789abcdefghijklmnopqrstuvwxyz"
2.upto(16) do |n|
start = Integer.sqrt( DIGITS[0,n].to_i(n) )
res = start.step.detect{|i| (i*i).digits(n).uniq.size == n }
puts "Base %2d:%10s² = %-14s" % [n, res.to_s(n), (res*res).to_s(n)]
end
- 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
Sidef
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
Uiua
Simple search. There's a big increase in time to run at base 12. Try it in Uiua Pad!
Base₁₀ ← /+×ⁿ:⊙(⇌⇡⧻.) # (b, [digits]) -> n
BaseN ← ⊙◌⊂⍢(⊙⊂⌊⊃÷◿⊃⋅⋅∘⊙⊙∘|≤⊙⋅∘)⊙[]: # (b, n) -> [digits]
IsPan ← =⧻◴: # IsPan 3 [0 1 2] -> true
# Smallest pan number for given base
# will always be = [1 0 2 3 4...] in base n
MinPanBase ← Base₁₀ ⟜(↙:⊂1_0↘2⇡+1.)
# Take sqrt of the smallest pan number and inc until found.
MinPanSqrBase ← ⊙◌⍢(+1|¬IsPan:BaseN,×.) ⌊√MinPanBase.
ShowMinPan ← (
⊃(⊙∘|⋅(×.)|BaseN ⊙(×.)) ⟜MinPanSqrBase
&p $"Base _\t_\t_\t_\t"
)
⍜now (≡ShowMinPan ↘2⇡13)
- Output:
stdout: Base 2 2 4 [1 0 0] Base 3 8 64 [2 1 0 1] Base 4 15 225 [3 2 0 1] Base 5 73 5329 [1 3 2 3 0 4] Base 6 195 38025 [4 5 2 0 1 3] Base 7 561 314721 [2 4 5 0 3 6 1] Base 8 1764 3111696 [1 3 6 7 5 4 2 0] Base 9 7814 61058596 [1 3 6 8 0 2 5 7 4] Base 10 32043 1026753849 [1 0 2 6 7 5 3 8 4 9] Base 11 177565 31529329225 [1 2 4 0 10 5 3 6 7 8 9] Base 12 944493 892067027049 [1 2 4 10 7 11 5 3 8 6 0 9] 11.461999893188477 [ooof]
Visual Basic .NET
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.
Wren
Base 21 is as far as we can reasonably fly here though (unsurprisingly) base 20 takes a long time.
import "./big" for BigInt
import "./math" for Nums
import "./fmt" for Conv, Fmt
var maxBase = 21
var minSq36 = "1023456789abcdefghijklmnopqrstuvwxyz"
var minSq36x = "10123456789abcdefghijklmnopqrstuvwxyz"
var containsAll = Fn.new { |sq, base|
var found = List.filled(maxBase, 0)
var le = sq.count
var reps = 0
for (r in sq) {
var d = r.bytes[0] - 48
if (d > 38) d = d - 39
found[d] = found[d] + 1
if (found[d] > 1) {
reps = reps + 1
if (le - reps < base) return false
}
}
return true
}
var sumDigits = Fn.new { |n, base|
var sum = BigInt.zero
while (n > 0) {
sum = sum + (n%base)
n = n/base
}
return sum
}
var digitalRoot = Fn.new { |n, base|
while (n > base - 1) n = sumDigits.call(n, base)
return n.toSmall
}
var minStart = Fn.new { |base|
var ms = minSq36[0...base]
var nn = BigInt.fromBaseString(ms, base)
var bdr = digitalRoot.call(nn, base)
var drs = []
var ixs = []
for (n in 1...2*base) {
nn = BigInt.new(n*n)
var dr = digitalRoot.call(nn, base)
if (dr == 0) dr = n * n
if (dr == bdr) ixs.add(n)
if (n < base && dr >= bdr) drs.add(dr)
}
var inc = 1
if (ixs.count >= 2 && base != 3) inc = ixs[1] - ixs[0]
if (drs.count == 0) return [ms, inc, bdr]
var min = Nums.min(drs)
var rd = min - bdr
if (rd == 0) return [ms, inc, bdr]
if (rd == 1) return [minSq36x[0..base], 1, bdr]
var ins = minSq36[rd]
return [(minSq36[0...rd] + ins + minSq36[rd..-1])[0..base], inc, bdr]
}
var start = System.clock
var n = 2
var k = 1
var base = 2
while (true) {
if (base == 2 || (n % base) != 0) {
var nb = BigInt.new(n)
var sq = nb.square.toBaseString(base)
if (containsAll.call(sq, base)) {
var ns = Conv.itoa(n, base)
var tt = System.clock - start
Fmt.print("Base $2d:$15s² = $-27s in $8.3fs", base, ns, sq, tt)
if (base == maxBase) break
base = base + 1
var res = minStart.call(base)
var ms = res[0]
var inc = res[1]
var bdr = res[2]
k = inc
var nn = BigInt.fromBaseString(ms, base)
nb = nn.isqrt
if (nb < n + 1) nb = BigInt.new(n+1)
if (k != 1) {
while (true) {
nn = nb.square
var dr = digitalRoot.call(nn, base)
if (dr == bdr) {
n = nb.toSmall - k
break
}
nb = nb.inc
}
} else {
n = nb.toSmall - k
}
}
}
n = 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.002s Base 7: 1431² = 2450361 in 0.003s Base 8: 3344² = 13675420 in 0.004s Base 9: 11642² = 136802574 in 0.011s Base 10: 32043² = 1026753849 in 0.011s Base 11: 111453² = 1240a536789 in 0.044s Base 12: 3966b9² = 124a7b538609 in 0.201s Base 13: 3828943² = 10254773ca86b9 in 0.426s Base 14: 3a9db7c² = 10269b8c57d3a4 in 0.501s Base 15: 1012b857² = 102597bace836d4 in 0.651s Base 16: 404a9d9b² = 1025648cfea37bd9 in 1.351s Base 17: 423f82ga9² = 101246a89cgfb357ed in 10.534s Base 18: 44b482cad² = 10236b5f8eg4ad9ch7 in 12.008s Base 19: 1011b55e9a² = 10234dhbg7ci8f6a9e5 in 18.055s Base 20: 49dgih5d3g² = 1024e7cdi3hb695fja8g in 696.567s Base 21: 4c9he5fe27f² = 1023457dg9hi8j6b6kceaf in 735.738s
XPL0
Base 14 is the largest that can be calculated using double precision floating point (14^13 = 7.9e14; 15^14 = 2.9e16). Runs in about 38 seconds on Pi4.
real Base; \Number Base used [2..14]
proc NumOut(N); \Display N in the specified Base
real N;
int Remain;
[Remain:= fix(Mod(N, Base));
N:= Floor(N/Base);
if N # 0. then NumOut(N);
ChOut(0, Remain + (if Remain <= 9 then ^0 else ^A-10));
];
func Pandigital(N); \Return 'true' if N is pandigital
real N;
int Used, Remain;
[Used:= 0;
while N # 0. do
[Remain:= fix(Mod(N, Base));
N:= Floor(N/Base);
Used:= Used ! 1<<Remain;
];
return Used = 1<<fix(Base) - 1;
];
real N;
[Base:= 2.;
Format(2, 0);
repeat N:= Floor(Sqrt(Pow(Base, Base-1.)));
loop [if Pandigital(N*N) then
[RlOut(0, Base); Text(0, ": ");
NumOut(N); Text(0, "^^2 = ");
NumOut(N*N); CrLf(0);
quit;
];
N:= N + 1.;
];
Base:= Base + 1.;
until Base > 14.;
]
- Output:
2: 10^2 = 100 3: 22^2 = 2101 4: 33^2 = 3201 5: 243^2 = 132304 6: 523^2 = 452013 7: 1431^2 = 2450361 8: 3344^2 = 13675420 9: 11642^2 = 136802574 10: 32043^2 = 1026753849 11: 111453^2 = 1240A536789 12: 3966B9^2 = 124A7B538609 13: 3828943^2 = 10254773CA86B9 14: 3A9DB7C^2 = 10269B8C57D3A4
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
}
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
- Programming Tasks
- Solutions by Programming Task
- 11l
- ALGOL 68
- C
- C sharp
- System.Numerics
- C++
- D
- Delphi
- SysUtils,StdCtrls
- EasyLang
- F Sharp
- Factor
- Forth
- FreeBASIC
- Go
- Haskell
- J
- Java
- JavaScript
- Jq
- Julia
- Kotlin
- Mathematica
- Wolfram Language
- Nim
- Pascal
- PascalABC.NET
- Perl
- Ntheory
- Phix
- Phix/mpfr
- Python
- Quackery
- Raku
- REXX
- Ring
- RPL
- Ruby
- Sidef
- Uiua
- Visual Basic .NET
- Wren
- Wren-big
- Wren-math
- Wren-fmt
- XPL0
- Zkl