Penholodigital squares

Penholodigital squares are perfect square numbers that contain all of the digits from the base in which the number is represented, except for zero, exactly once.

Penholodigital squares is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

From the Latin prefix pene- (before, or next to, nearly)

and holo- (whole, or all)

penholodigital: Nearly-all-digits.

So, in a particular base, a penholodigital square number will contain all of the digits used in that base (except zero) once, and only once. Base eight penholodigitals contain the digits 1 through 7, base 10, 1 through 9, etc.

For example

In base 10, 139854276 is a penholodigital square. It is the square of the integer 11826, and contains every digit from 1 through 9 exactly once.

Penholodigital squares can occur in many, though not every, base. They tend to be pretty rare in lower bases.

There is a total of 1 penholodigital squares in base 2:
1² = 1

There is a total of 0 penholodigital squares in base 3:

There is a total of 0 penholodigital squares in base 4:

There is a total of 0 penholodigital squares in base 5:

There is a total of 2 penholodigital squares in base 6:
122² = 15324, 221² = 53241

There is a total of 1 penholodigital squares in base 7:
645² = 623514

There is a total of 1 penholodigital squares in base 8:
2453² = 6532471

Task

Find and display the total count, and the penholodigital squares and the integers that are squared to produce them, represented in the base in which they are calculated, for bases 9, 10, 11 and 12.

Stretch

Find and display the total count, and the first and last penholodigital squares and the integers that are squared to produce them, represented in the base in which they are calculated, for bases 13, 14, 15, ... ?

See also

• OEIS:A036744 - Penholodigital squares in base 10
• First_perfect_square_in_base_n_with_n_unique_digits

Go

Translation of: Wren

Library: Go-rcu

package main

import (
    "fmt"
    "math"
    "rcu"
    "strconv"
)

func reverse(s string) string {
    r := make([]byte, len(s))
    for i := 0; i < len(s); i++ {
        r[i] = s[len(s)-1-i]
    }
    return string(r)
}

func main() {
    primes := []int{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47}
    digits := "123456789ABCDEF"
    for b := 9; b <= 16; b++ {
        master := 1
        for d := 1; d < b; d++ {
            master *= primes[d-1]
        }
        var phd []int
        smin, _ := strconv.ParseInt(digits[0:b-1], b, 64)
        min := int(math.Ceil(math.Sqrt(float64(smin))))
        smax, _ := strconv.ParseInt(reverse(digits[0:b-1]), b, 64)
        max := int(math.Floor(math.Sqrt(float64(smax))))
        factors := rcu.PrimeFactors(b - 1)
        div := factors[len(factors)-1]
        for i := min; i <= max; i++ {
            if (i % div) != 0 {
                continue
            }
            sq := i * i
            digs := rcu.Digits(sq, b)
            containsZero := false
            key := 1
            for _, dig := range digs {
                if dig == 0 {
                    containsZero = true
                    break
                }
                key *= primes[dig-1]
            }
            if containsZero {
                continue
            }
            if key == master {
                phd = append(phd, i)
            }
        }
        fmt.Println("There is a total of", len(phd), "penholodigital squares in base", b, "\b:")
        if b > 13 {
            phd = []int{phd[0], phd[len(phd)-1]}
        }
        for i := 0; i < len(phd); i++ {
            sq2 := phd[i] * phd[i]
            fmt.Printf("%s² = %s  ", strconv.FormatInt(int64(phd[i]), b), strconv.FormatInt(int64(sq2), b))
            if (i+1)%3 == 0 {
                fmt.Println()
            }
        }
        if len(phd)%3 != 0 {
            fmt.Println()
        }
        fmt.Println()
    }
}

Output:

There is a total of 10 penholodigital squares in base 9:
3825² = 16328547  3847² = 16523874  4617² = 23875614  
4761² = 25487631  6561² = 47865231  6574² = 48162537  
6844² = 53184267  7285² = 58624317  7821² = 68573241  
8554² = 82314657  

There is a total of 30 penholodigital squares in base 10:
11826² = 139854276  12363² = 152843769  12543² = 157326849  
14676² = 215384976  15681² = 245893761  15963² = 254817369  
18072² = 326597184  19023² = 361874529  19377² = 375468129  
19569² = 382945761  19629² = 385297641  20316² = 412739856  
22887² = 523814769  23019² = 529874361  23178² = 537219684  
23439² = 549386721  24237² = 587432169  24276² = 589324176  
24441² = 597362481  24807² = 615387249  25059² = 627953481  
25572² = 653927184  25941² = 672935481  26409² = 697435281  
26733² = 714653289  27129² = 735982641  27273² = 743816529  
29034² = 842973156  29106² = 847159236  30384² = 923187456  

There is a total of 20 penholodigital squares in base 11:
42045² = 165742a893  43152² = 173a652894  44926² = 18792a6453  
47149² = 1a67395824  47257² = 1a76392485  52071² = 249a758631  
54457² = 2719634a85  55979² = 286a795314  59597² = 314672a895  
632a4² = 3671a89245  64069² = 376198a254  68335² = 41697528a3  
71485² = 46928a7153  81196² = 5a79286413  83608² = 632a741859  
86074² = 6713498a25  89468² = 7148563a29  91429² = 76315982a4  
93319² = 795186a234  a3a39² = 983251a764  

There is a total of 23 penholodigital squares in base 12:
117789² = 135b7482a69  16357b² = 23a5b976481  16762b² = 24ab5379861  
16906b² = 25386749ba1  173434² = 26b859a3714  178278² = 2835ba17694  
1a1993² = 34a8125b769  1a3595² = 354a279b681  1b0451² = 3824b7569a1  
1b7545² = 3a5b2487961  2084a9² = 42a1583b769  235273² = 5287ba13469  
2528b5² = 5b23a879641  25b564² = 62937b5a814  262174² = 63a8527b194  
285a44² = 73b615a8294  29a977² = 7b9284a5361  2a7617² = 83ab5479261  
2b0144² = 8617b35a294  307381² = 93825a67b41  310828² = 96528ab7314  
319488² = 9ab65823714  319a37² = 9b2573468a1  

There is a total of 0 penholodigital squares in base 13:

There is a total of 160 penholodigital squares in base 14:
1129535² = 126a84d79c53b  3a03226² = db3962a7541c8  

There is a total of 419 penholodigital squares in base 15:
4240c58² = 12378da5b6ec94  ee25e4a² = ed4c93285671ba  

There is a total of 740 penholodigital squares in base 16:
11156eb6² = 123da7f85bce964  3fd8f786² = fec81b69573da24  

J

Implementation:

digch=: a.{~;48 97(+i.)&.>10 26
brep=: (digch {~ #.inv)&.>

penholod=: {{
  F=: >.%:y#.D=:}.i.y
  C=: <.%:y#.}:i.-y
  ok=: (D */@e. y #.inv ])"0
  (#~ok) *:F+i.1+C-F
}}

task=: {{
  sq=. penholod y
  hd=. ,:(#sq),&":' penholodigital squares in base ',":y
  hd,(*#sq)#names (y brep sq),each '=',each(y brep %:sq),each<'²'
}}

stretch=: {{
  sq=. penholod y
  hd=. ,:(#sq),&":' penholodigital squares in base ',":y
  hd,(*#sq)#names ({.,'...';{:) (y brep sq),each '=',each(y brep %:sq),each<'²'
}}

Task examples:

   task 9
10 penholodigital squares in base 9                                                             
16328547=3825² 16523874=3847² 23875614=4617² 25487631=4761² 47865231=6561² 48162537=6574² 
53184267=6844² 58624317=7285² 68573241=7821² 82314657=8554²                                 
   task 10
30 penholodigital squares in base 10                                                                        
139854276=11826² 152843769=12363² 157326849=12543² 215384976=14676² 245893761=15681² 254817369=15963² 
326597184=18072² 361874529=19023² 375468129=19377² 382945761=19569² 385297641=19629² 412739856=20316² 
523814769=22887² 529874361=23019² 537219684=23178² 549386721=23439² 587432169=24237² 589324176=24276² 
597362481=24441² 615387249=24807² 627953481=25059² 653927184=25572² 672935481=25941² 697435281=26409² 
714653289=26733² 735982641=27129² 743816529=27273² 842973156=29034² 847159236=29106² 923187456=30384² 
   task 11
20 penholodigital squares in base 11                                                           
165742a893=42045² 173a652894=43152² 18792a6453=44926² 1a67395824=47149² 1a76392485=47257² 
249a758631=52071² 2719634a85=54457² 286a795314=55979² 314672a895=59597² 3671a89245=632a4² 
376198a254=64069² 41697528a3=68335² 46928a7153=71485² 5a79286413=81196² 632a741859=83608² 
6713498a25=86074² 7148563a29=89468² 76315982a4=91429² 795186a234=93319² 983251a764=a3a39² 
   task 12
23 penholodigital squares in base 12                                                                     
135b7482a69=117789² 23a5b976481=16357b² 24ab5379861=16762b² 25386749ba1=16906b² 26b859a3714=173434² 
2835ba17694=178278² 34a8125b769=1a1993² 354a279b681=1a3595² 3824b7569a1=1b0451² 3a5b2487961=1b7545² 
42a1583b769=2084a9² 5287ba13469=235273² 5b23a879641=2528b5² 62937b5a814=25b564² 63a8527b194=262174² 
73b615a8294=285a44² 7b9284a5361=29a977² 83ab5479261=2a7617² 8617b35a294=2b0144² 93825a67b41=307381² 
96528ab7314=310828² 9ab65823714=319488² 9b2573468a1=319a37²                                           
   stretch 13
0 penholodigital squares in base 13
   stretch 14
160 penholodigital squares in base 14           
126a84d79c53b=1129535² ...                     
db3962a7541c8=3a03226²                         
   stretch 15
419 penholodigital squares in base 15             
12378da5b6ec94=4240c58² ...                      
ed4c93285671ba=ee25e4a²                
   stretch 16
740 penholodigital squares in base 16                 
123da7f85bce964=11156eb6² ...                        
fec81b69573da24=3fd8f786²                                      
   NB. this is getting to be obnoxiously long in terms of time...

jq

Adapted from Python

Works with: jq

Also works with gojq, the Go implementation of jq, and with fq

Note that the definition of `_nwise/1` may be omitted if using jq.

General Utilities

# This def may be omitted if using jq
def _nwise($n):
  def nw: if length <= $n then . else .[0:$n] , (.[$n:] | nw) end;
  nw;

# Evaluate SIGMA $x^k * $p[k] for k=0...
def evalpoly($x; $p):
  reduce range(0;p|length) as $i ({power: 1, sum:0};
      .sum += .power * $p[$i]
      | .power *= $x)
  | .sum;      

# Convert the input integer to a string in the specified base (2 to 36 inclusive)
def convert(base):
  def stream:
    recurse(if . > 0 then ./base|floor else empty end) | . % base ;
  if . == 0 then "0"
  else  [stream] | reverse | .[1:]
  | if   base <  10 then map(tostring) | join("")
    elif base <= 36 then map(if . < 10 then 48 + . else . + 87 end) | implode
    else error("base too large")
    end
  end;

# If $j is 0, then an error condition is raised;
# otherwise, assuming infinite-precision integer arithmetic,
# if the input and $j are integers, then the result will be an integer.
def idivide($j):
  . as $i
  | ($i % $j) as $mod
  | ($i - $mod) / $j ;

# input should be a non-negative integer for accuracy
# but may be any non-negative finite number
def isqrt:
  def irt:
  . as $x
    | 1 | until(. > $x; . * 4) as $q
    | {$q, $x, r: 0}
    | until( .q <= 1;
        .q |= idivide(4)
        | .t = .x - .r - .q
        | .r |= idivide(2)
        | if .t >= 0
          then .x = .t
          | .r += .q
          else .
          end)
    | .r ;
  if type == "number" and (isinfinite|not) and (isnan|not) and . >= 0
  then irt
  else "isqrt requires a non-negative integer for accuracy" | error
  end ;

# Input: an integer base 10
# Output: an array of the digits (characters) if . were printed in base $base
def digits($base):
  convert($base) | tostring | [explode[] | [.] | implode];

The Task

# emit an array of [$n,$sq] values where $n is a penholodigital square in the given base
# and $n and $sq are integers expressed in that base
def penholodigital($base):
  { hi: (evalpoly($base; [range(1;$base)])|isqrt),
    lo: (evalpoly($base; [range(base-1; 0; -1)]) | isqrt)  # evalpoly(base, base-1:-1:1)
  }
  | reduce range(.lo; .hi+1) as $n (null;
       ($n * $n) as $sq
       | ($sq | digits($base)) as $digits
       | if "0" | IN($digits[]) then .
         elif (($digits | length) == $base - 1) and (($digits | unique | length) == $base-1)
         then . + [[($n | convert(base)), ($sq | convert(base))]]
         else .
         end );

def task(a;b):
  range(a;b) as $base
  | penholodigital($base)
  | "\n\nThere are \(length) penholodigital squares in base \($base):",
    (_nwise(3)
     | map("\(.[0])² = \(.[1])" )
     | join("  "));
        
 task(9;13)

Output:

There are 10 penholodigital squares in base 9:
3825² = 16328547  3847² = 16523874  4617² = 23875614
4761² = 25487631  6561² = 47865231  6574² = 48162537
6844² = 53184267  7285² = 58624317  7821² = 68573241
8554² = 82314657


There are 30 penholodigital squares in base 10:
11826² = 139854276  12363² = 152843769  12543² = 157326849
14676² = 215384976  15681² = 245893761  15963² = 254817369
18072² = 326597184  19023² = 361874529  19377² = 375468129
19569² = 382945761  19629² = 385297641  20316² = 412739856
22887² = 523814769  23019² = 529874361  23178² = 537219684
23439² = 549386721  24237² = 587432169  24276² = 589324176
24441² = 597362481  24807² = 615387249  25059² = 627953481
25572² = 653927184  25941² = 672935481  26409² = 697435281
26733² = 714653289  27129² = 735982641  27273² = 743816529
29034² = 842973156  29106² = 847159236  30384² = 923187456


There are 20 penholodigital squares in base 11:
42045² = 165742a893  43152² = 173a652894  44926² = 18792a6453
47149² = 1a67395824  47257² = 1a76392485  52071² = 249a758631
54457² = 2719634a85  55979² = 286a795314  59597² = 314672a895
632a4² = 3671a89245  64069² = 376198a254  68335² = 41697528a3
71485² = 46928a7153  81196² = 5a79286413  83608² = 632a741859
86074² = 6713498a25  89468² = 7148563a29  91429² = 76315982a4
93319² = 795186a234  a3a39² = 983251a764


There are 23 penholodigital squares in base 12:
117789² = 135b7482a69  16357b² = 23a5b976481  16762b² = 24ab5379861
16906b² = 25386749ba1  173434² = 26b859a3714  178278² = 2835ba17694
1a1993² = 34a8125b769  1a3595² = 354a279b681  1b0451² = 3824b7569a1
1b7545² = 3a5b2487961  2084a9² = 42a1583b769  235273² = 5287ba13469
2528b5² = 5b23a879641  25b564² = 62937b5a814  262174² = 63a8527b194
285a44² = 73b615a8294  29a977² = 7b9284a5361  2a7617² = 83ab5479261
2b0144² = 8617b35a294  307381² = 93825a67b41  310828² = 96528ab7314
319488² = 9ab65823714  319a37² = 9b2573468a1

Julia

""" rosettacode.org task Penholodigital_squares """


function penholodigital(base)
    penholodigitals = Int[]
    hi, lo = isqrt(evalpoly(base, 1:base-1)), isqrt(evalpoly(base, base-1:-1:1))
    for n in lo:hi
        dig = digits(n * n; base)
        0 in dig && continue
        if all(i -> count(==(i), dig) == 1, 1:base-1)
            push!(penholodigitals, n * n)
        end
    end
    return penholodigitals
end

for j in 9:16
    allpen = penholodigital(j)
    println("\n\nThere is a total of $(length(allpen)) penholodigital squares in base $j:")
    for (i, n) in (j < 14 ? enumerate(allpen) : enumerate([allpen[begin], allpen[end]]))
        print(string(isqrt(n), base=j), "² = ", string(n, base=j), i %3 == 0 ? "\n" :  "  ")
    end
end

Output:

There is a total of 10 penholodigital squares in base 9:
3825² = 16328547  3847² = 16523874  4617² = 23875614
4761² = 25487631  6561² = 47865231  6574² = 48162537
6844² = 53184267  7285² = 58624317  7821² = 68573241
8554² = 82314657

There is a total of 30 penholodigital squares in base 10:
11826² = 139854276  12363² = 152843769  12543² = 157326849
14676² = 215384976  15681² = 245893761  15963² = 254817369
18072² = 326597184  19023² = 361874529  19377² = 375468129
19569² = 382945761  19629² = 385297641  20316² = 412739856
22887² = 523814769  23019² = 529874361  23178² = 537219684
23439² = 549386721  24237² = 587432169  24276² = 589324176
24441² = 597362481  24807² = 615387249  25059² = 627953481
25572² = 653927184  25941² = 672935481  26409² = 697435281
26733² = 714653289  27129² = 735982641  27273² = 743816529
29034² = 842973156  29106² = 847159236  30384² = 923187456


There is a total of 20 penholodigital squares in base 11:
42045² = 165742a893  43152² = 173a652894  44926² = 18792a6453
47149² = 1a67395824  47257² = 1a76392485  52071² = 249a758631
54457² = 2719634a85  55979² = 286a795314  59597² = 314672a895
632a4² = 3671a89245  64069² = 376198a254  68335² = 41697528a3
71485² = 46928a7153  81196² = 5a79286413  83608² = 632a741859
86074² = 6713498a25  89468² = 7148563a29  91429² = 76315982a4
93319² = 795186a234  a3a39² = 983251a764

There is a total of 23 penholodigital squares in base 12:
117789² = 135b7482a69  16357b² = 23a5b976481  16762b² = 24ab5379861
16906b² = 25386749ba1  173434² = 26b859a3714  178278² = 2835ba17694
1a1993² = 34a8125b769  1a3595² = 354a279b681  1b0451² = 3824b7569a1
1b7545² = 3a5b2487961  2084a9² = 42a1583b769  235273² = 5287ba13469
2528b5² = 5b23a879641  25b564² = 62937b5a814  262174² = 63a8527b194
285a44² = 73b615a8294  29a977² = 7b9284a5361  2a7617² = 83ab5479261
2b0144² = 8617b35a294  307381² = 93825a67b41  310828² = 96528ab7314
319488² = 9ab65823714  319a37² = 9b2573468a1

There is a total of 0 penholodigital squares in base 13:


There is a total of 160 penholodigital squares in base 14:
1129535² = 126a84d79c53b  3a03226² = db3962a7541c8

There is a total of 419 penholodigital squares in base 15:
4240c58² = 12378da5b6ec94  ee25e4a² = ed4c93285671ba

There is a total of 740 penholodigital squares in base 16:
11156eb6² = 123da7f85bce964  3fd8f786² = fec81b69573da24

Pascal

Free Pascal

Nearly copy and paste of pandigital square numbers.
Now using the right step size and startvalue
I think base 16 is the limit. 1234...FG is to big for Uint64. GMP/ MPinteger is required.

program penholodigital;
//Find the smallest number n to base b, so that n*n includes all
//digits of base b without 0
{$IFDEF FPC}{$MODE DELPHI}{$Optimization ON,All}{$ENDIF}
{$IFDEF Windows}{$APPTYPE CONSOLE}{$ENDIF}
uses
  sysutils;
const
 charSet : array[0..16] of char ='0123456789ABCDEF';
type
  tNumtoBase = record
                 ntb_dgt : array[0..31-8] of byte;
                 ntb_cnt,
                 ntb_bas  : Int32;
               end;
var
  dgtSqrRoot : array[0..31-8] of byte;
  sl : array of string;
  s2Delta : array of Uint32;
  Num,
  sqr2B,
  deltaSqrNum  : tNumtoBase;

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;

function OutNum(const num:tNumtoBase):AnsiString;
var
  i,j : NativeInt;
Begin
  with num do
  Begin
    setlength(result,ntb_cnt);
    j := 1;
    For i := ntb_cnt-1 downto 0 do
    Begin
      result[j] := charSet[ntb_dgt[i]];
      inc(j);
    end;
  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,penHoloCnt : Uint64;
  b1,i,j,TestSet,CheckSet,dgtRoot,step,dNum : NativeInt;
Begin
  penHoloCnt := 0;
  b1 := Base-1;
  dgtRoot := ((Base*b1) DIV 2) MOD b1;  
  //number containing 1,2..,base-1  
  n := 0;
  For j := 1 to b1 do
  Begin
    n := n* base + j;
    dgtSqrRoot[j] := (j*j) MOD b1;
  end;
  n := trunc(sqrt(n));    

  // increment n til it fits (n*n) MOD b1 = dgtroot
  j := B1;
  repeat
    if (n*n) MOD b1 = dgtroot then
      BREAK;
    inc(n);  
    dec(j);
  until j = 0;
  
  Conv2num(sqr2B,n*n,base);
  Conv2num(Num,n,base);

// calc step size. i = occurences of same dgtroot.
  i := 0;
  For j := 1 to Base-1 do
    if dgtSqrRoot[j] = dgtRoot then
      inc(i);
  // if i = 0 then one more digit is needed -> so no penholodigital number
  if i <> 0 then
  Begin 
    step := b1 DIV i;  
    // calc delta of square numbers for incremnt n by step
    Conv2num(deltaSqrNum,2*step*n,base);  
    IncNumBig(deltaSqrNum,step*step);
    dNum := 2*step*step;

    //all digits without 0
    CheckSet := 0;
    For j := b1 downto 1 do
      CheckSet := CheckSet OR (1 shl j);
    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]);
      IF CheckSet=TestSet  then
      Begin
        // now correct number
        IncNumBig(num,i*step);
        s2delta[penHoloCnt] := i*step;
        sl[penHoloCnt] := Format('%s^2 = %s',[OutNum(Num),OutNum(sqr2B)]);
        inc(penHoloCnt);
        i := 0;
      end;
      //next square number
      AddNum(sqr2B,deltaSqrNum);
      IncNumBig(deltaSqrNum,dNum);// dnum maybe >= base
      inc(i);
    until sqr2B.ntb_cnt >= base;
  end;
  if i = 0 then
  Begin
    Writeln('Penholodigital squares in base: ',base:2,' are not possible');
    EXIT;
  end  
  else  
    Writeln('There are a total of ',penHoloCnt,' penholodigital squares in base: ',base:2);
  if (penHoloCnt > 0) AND (base < 11) then
  begin
    j := 0;
    while penHoloCnt-j > 3 do
    begin
      writeln(sl[j],',',sl[j+1],',',sl[j+2]);
      inc(j,3);
    end;
    write(sl[j]);
    For j := j+1 to penHoloCnt-1 do
      write(',',sl[j]);
    writeln;
  end
  else
    if penHoloCnt > 1 then
    begin
      writeln(sl[0],',',sl[penHoloCnt-1]);
    end;
end;

var
  T0: TDateTime;
  base :nativeInt;
begin
  T0 := now;
  setlength(sl,740);
  setlength(s2Delta,740);
  For base := 2 to 17 do
    Test(base);
  writeln('Total runtime in s ',(now-T0)*86400:10:3);
  {$IFDEF WINDOWS}readln;{$ENDIF}
end.

@TIO.RUN:

There are a total of 1 penholodigital squares in base:  2
1^2 = 1
There are a total of 0 penholodigital squares in base:  3
There are a total of 0 penholodigital squares in base:  4
Penholodigital squares in base:  5 are not possible
There are a total of 2 penholodigital squares in base:  6
122^2 = 15324,221^2 = 53241
There are a total of 1 penholodigital squares in base:  7
645^2 = 623514
There are a total of 1 penholodigital squares in base:  8
2453^2 = 6532471
There are a total of 10 penholodigital squares in base:  9
3825^2 = 16328547,3847^2 = 16523874,4617^2 = 23875614
4761^2 = 25487631,6561^2 = 47865231,6574^2 = 48162537
6844^2 = 53184267,7285^2 = 58624317,7821^2 = 68573241
8554^2 = 82314657
There are a total of 30 penholodigital squares in base: 10
11826^2 = 139854276,12363^2 = 152843769,12543^2 = 157326849
14676^2 = 215384976,15681^2 = 245893761,15963^2 = 254817369
18072^2 = 326597184,19023^2 = 361874529,19377^2 = 375468129
19569^2 = 382945761,19629^2 = 385297641,20316^2 = 412739856
22887^2 = 523814769,23019^2 = 529874361,23178^2 = 537219684
23439^2 = 549386721,24237^2 = 587432169,24276^2 = 589324176
24441^2 = 597362481,24807^2 = 615387249,25059^2 = 627953481
25572^2 = 653927184,25941^2 = 672935481,26409^2 = 697435281
26733^2 = 714653289,27129^2 = 735982641,27273^2 = 743816529
29034^2 = 842973156,29106^2 = 847159236,30384^2 = 923187456
There are a total of 20 penholodigital squares in base: 11
42045^2 = 165742A893,A3A39^2 = 983251A764
There are a total of 23 penholodigital squares in base: 12
117789^2 = 135B7482A69,319A37^2 = 9B2573468A1
Penholodigital squares in base: 13 are not possible
There are a total of 160 penholodigital squares in base: 14
1129535^2 = 126A84D79C53B,3A03226^2 = DB3962A7541C8
There are a total of 419 penholodigital squares in base: 15
4240C58^2 = 12378DA5B6EC94,EE25E4A^2 = ED4C93285671BA
There are a total of 740 penholodigital squares in base: 16
11156EB6^2 = 123DA7F85BCE964,3FD8F786^2 = FEC81B69573DA24
Penholodigital squares in base: 17 are not possible
Total runtime in s      7.159 @home 1.573 s 

Raku

(9 .. 12).map: -> $base {
    my $test = (1 ..^ $base)».base($base).join;
    my $start = $test     .parse-base($base).sqrt.Int;
    my $end   = $test.flip.parse-base($base).sqrt.Int;
    say "\nThere is a total of {+$_} penholodigital squares in base $base:\n" ~
        .map({"{.base($base)}² = {.².base($base)}"}).batch(3)».join(", ").join: "\n" given
        ($start .. $end).grep: *².base($base).comb.sort.join eq $test
}

(13 .. 16).hyper(:1batch).map: -> $base {
    my $test = (1 ..^ $base)».base($base).join;
    my $start = $test     .parse-base($base).sqrt.Int;
    my $end   = $test.flip.parse-base($base).sqrt.Int;
    my @penholo = ($start .. $end).grep: *².base($base).comb.sort.join eq $test;
    say "\nThere is a total of {+@penholo} penholodigital squares in base $base:";
    say @penholo[0,*-1].map({"{.base($base)}² = {.².base($base)}"}).batch(3)».join(", ").join: "\n" if +@penholo;
}

Output:

There is a total of 10 penholodigital squares in base 9:
3825² = 16328547, 3847² = 16523874, 4617² = 23875614
4761² = 25487631, 6561² = 47865231, 6574² = 48162537
6844² = 53184267, 7285² = 58624317, 7821² = 68573241
8554² = 82314657

There is a total of 30 penholodigital squares in base 10:
11826² = 139854276, 12363² = 152843769, 12543² = 157326849
14676² = 215384976, 15681² = 245893761, 15963² = 254817369
18072² = 326597184, 19023² = 361874529, 19377² = 375468129
19569² = 382945761, 19629² = 385297641, 20316² = 412739856
22887² = 523814769, 23019² = 529874361, 23178² = 537219684
23439² = 549386721, 24237² = 587432169, 24276² = 589324176
24441² = 597362481, 24807² = 615387249, 25059² = 627953481
25572² = 653927184, 25941² = 672935481, 26409² = 697435281
26733² = 714653289, 27129² = 735982641, 27273² = 743816529
29034² = 842973156, 29106² = 847159236, 30384² = 923187456

There is a total of 20 penholodigital squares in base 11:
42045² = 165742A893, 43152² = 173A652894, 44926² = 18792A6453
47149² = 1A67395824, 47257² = 1A76392485, 52071² = 249A758631
54457² = 2719634A85, 55979² = 286A795314, 59597² = 314672A895
632A4² = 3671A89245, 64069² = 376198A254, 68335² = 41697528A3
71485² = 46928A7153, 81196² = 5A79286413, 83608² = 632A741859
86074² = 6713498A25, 89468² = 7148563A29, 91429² = 76315982A4
93319² = 795186A234, A3A39² = 983251A764

There is a total of 23 penholodigital squares in base 12:
117789² = 135B7482A69, 16357B² = 23A5B976481, 16762B² = 24AB5379861
16906B² = 25386749BA1, 173434² = 26B859A3714, 178278² = 2835BA17694
1A1993² = 34A8125B769, 1A3595² = 354A279B681, 1B0451² = 3824B7569A1
1B7545² = 3A5B2487961, 2084A9² = 42A1583B769, 235273² = 5287BA13469
2528B5² = 5B23A879641, 25B564² = 62937B5A814, 262174² = 63A8527B194
285A44² = 73B615A8294, 29A977² = 7B9284A5361, 2A7617² = 83AB5479261
2B0144² = 8617B35A294, 307381² = 93825A67B41, 310828² = 96528AB7314
319488² = 9AB65823714, 319A37² = 9B2573468A1

There is a total of 0 penholodigital squares in base 13:

There is a total of 160 penholodigital squares in base 14:
1129535² = 126A84D79C53B, 3A03226² = DB3962A7541C8

There is a total of 419 penholodigital squares in base 15:
4240C58² = 12378DA5B6EC94, EE25E4A² = ED4C93285671BA

There is a total of 740 penholodigital squares in base 16:
11156EB6² = 123DA7F85BCE964, 3FD8F786² = FEC81B69573DA24

RPL

Works with: Halcyon Calc version 4.2.7

Code

Comments

"0123456789ABCDEF" 'Digits' STO ≪ → base ≪ "" SWAP WHILE DUP REPEAT DUP base MOD Digits OVER 1 + DUP SUB 4 ROLL + ROT ROT - base / RND END DROP ≫ ≫ 'D→BAS' STO ≪ → base ≪ 0 1 SIZE FOR j base * OVER j j SUB Digits SWAP POS 1 - + NEXT SWAP DROP ≫ ≫ 'BAS→D' STO ≪ → number base digits ≪ IF number "0" POS THEN 0 ELSE {} base + 0 CON 1 1 PUT 1 number SIZE FOR j Digits number j DUP SUB POS 1 PUT NEXT CNRM base == END ≫ ≫ 'PHD?' STO ≪ 0 0 → base first last ≪ 0 1 SF Digits 2 base SUB base BAS→D√ FLOOR "FEDCBA987654321" 17 base - 15 SUB base BAS→D√ CEIL FOR n n SQ base D→BAS IF base PHD? THEN 1 + n 'last' STO IF 1 FS?C THEN n 'first' STO END END NEXT IF first THEN first base D→BAS "^2 = " + first SQ base D→BAS + last base D→BAS "^2 = " + last SQ base D→BAS + END ≫ ≫ 'PHDSQ' STO

Constant ( n base -- "###" ) ( "###" base -- n ) ( "###" base -- boolean ) Initialize variables o/w an array of counters the sum of counters must equal base ( base -- #PHD "first PHD" "last PHD" ) start search with "123..b" end search with "b..321" Display detailed results

The following lines of command deliver what is required:

9 PHDSQ
10 PHDSQ
11 PHDSQ
12 PHDSQ

Output:

12: 10
11: "3825^2 = 16328547"
10: "8554^2 = 82314657"  
9: 30
8: "11826^2 = 139854276"
7: "30384^2 = 923187456"  
6: 20
5: "42045^2 = 165742A893"
4: "A3A39^2 = 983251A764"  
3: 23
2: "117789^2 = 135B7482A69"
1: "319A37^2 = 9B2573468A1"

Wren

Library: Wren-math

Library: Wren-fmt

This is limited to base 14 as base 15 would overflow Wren's safe integer limit of 2^53.

Although I'm not quite sure why, it appears that a necessary condition for a number to be a penholodigital square is for its square root to be exactly divisible by the highest prime factor of (base - 1).

import "./math" for Int
import "./fmt" for Conv, Fmt

var primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41]
var digits = "123456789ABCD"

for (b in 9..14) {
    var master = 1
    for (d in 1...b) master = master * primes[d-1]
    var phd = []
    var min = Conv.atoi(digits[0..(b-2)], b).sqrt.ceil
    var max = Conv.atoi(digits[(b-2)..0], b).sqrt.floor
    var div = Int.primeFactors(b-1)[-1]
    for (i in min..max) {
        if ((i % div) != 0) continue
        var sq = i * i
        var digs = Int.digits(sq, b)
        if (digs.contains(0)) continue
        var key = 1
        for (dig in digs) key = key * primes[dig-1]
        if (key == master) phd.add(i)
    }
    System.print("There is a total of %(phd.count) penholodigital squares in base %(b):")
    if (b > 13) phd = [phd[0], phd[-1]]
    for (i in 0...phd.count) {
        Fmt.write("$s² = $s  ", Conv.Itoa(phd[i], b), Conv.Itoa(phd[i] * phd[i], b))
        if ((i + 1) % 3 == 0) System.print()
    }
    if (phd.count % 3 != 0) System.print()
    System.print()
}

Output:

There is a total of 10 penholodigital squares in base 9:
3825² = 16328547  3847² = 16523874  4617² = 23875614  
4761² = 25487631  6561² = 47865231  6574² = 48162537  
6844² = 53184267  7285² = 58624317  7821² = 68573241  
8554² = 82314657  

There is a total of 30 penholodigital squares in base 10:
11826² = 139854276  12363² = 152843769  12543² = 157326849  
14676² = 215384976  15681² = 245893761  15963² = 254817369  
18072² = 326597184  19023² = 361874529  19377² = 375468129  
19569² = 382945761  19629² = 385297641  20316² = 412739856  
22887² = 523814769  23019² = 529874361  23178² = 537219684  
23439² = 549386721  24237² = 587432169  24276² = 589324176  
24441² = 597362481  24807² = 615387249  25059² = 627953481  
25572² = 653927184  25941² = 672935481  26409² = 697435281  
26733² = 714653289  27129² = 735982641  27273² = 743816529  
29034² = 842973156  29106² = 847159236  30384² = 923187456  

There is a total of 20 penholodigital squares in base 11:
42045² = 165742A893  43152² = 173A652894  44926² = 18792A6453  
47149² = 1A67395824  47257² = 1A76392485  52071² = 249A758631  
54457² = 2719634A85  55979² = 286A795314  59597² = 314672A895  
632A4² = 3671A89245  64069² = 376198A254  68335² = 41697528A3  
71485² = 46928A7153  81196² = 5A79286413  83608² = 632A741859  
86074² = 6713498A25  89468² = 7148563A29  91429² = 76315982A4  
93319² = 795186A234  A3A39² = 983251A764  

There is a total of 23 penholodigital squares in base 12:
117789² = 135B7482A69  16357B² = 23A5B976481  16762B² = 24AB5379861  
16906B² = 25386749BA1  173434² = 26B859A3714  178278² = 2835BA17694  
1A1993² = 34A8125B769  1A3595² = 354A279B681  1B0451² = 3824B7569A1  
1B7545² = 3A5B2487961  2084A9² = 42A1583B769  235273² = 5287BA13469  
2528B5² = 5B23A879641  25B564² = 62937B5A814  262174² = 63A8527B194  
285A44² = 73B615A8294  29A977² = 7B9284A5361  2A7617² = 83AB5479261  
2B0144² = 8617B35A294  307381² = 93825A67B41  310828² = 96528AB7314  
319488² = 9AB65823714  319A37² = 9B2573468A1  

There is a total of 0 penholodigital squares in base 13:

There is a total of 160 penholodigital squares in base 14:
1129535² = 126A84D79C53B  3A03226² = DB3962A7541C8